!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! ROUTINE REQUIRED TO DECODE AND SET STREAMS FOR EMAS.
!
%EXTERNALROUTINESPEC DEFINE (%STRING (63) S)
%EXTERNALROUTINESPEC SET MARGINS (%INTEGER J,K,L)
%ROUTINESPEC PROCESS DOCUMENT
%EXTERNALROUTINE LAYOUT (%STRING (63) S)
%EXTERNALINTEGERFNSPEC SSFAIL
%STRING (63) INFILE,OUTFILE,TIDYFILE
     %UNLESS S->INFILE.('/').OUTFILE %THENSTART
        SELECT OUTPUT (0)
        PRINTSTRING ('FAULTY PARAMETERS')  ;  NEWLINE
        %RETURN
     %FINISH
     %UNLESS OUTFILE->OUTFILE.(',').TIDYFILE %THEN TIDYFILE='.NULL'
!
! IF NO FILE NAME IS GIVEN FOR THE UPDATED SOURCE
! TAKE THE NULL FILE AS THE DEFAULT.
!
     DEFINE ('STREAM77,'.INFILE)  ;  ! INPUT FILE
     %UNLESS SSFAIL=0 %THENRETURN
     DEFINE ('STREAM78,'.OUTFILE)  ;  ! OUTPUT FILE
     %UNLESS SSFAIL=0 %THENRETURN
     DEFINE ('STREAM79,'.TIDYFILE)  ;  ! UPDATED SOURCE
     %UNLESS SSFAIL=0 %THENRETURN
!
! CHECK THAT DEFINE SUCCEEDS, AND CONTINUE ONLY IF THEY ALL DO.
! THIS ENSURES THAT THE FILE NAMES ARE VALID,
! BUT NOT THAT THEY EXIST.
!
! NOW INVOKE LAYOUT PROGRAM
!
     PROCESS DOCUMENT
%END
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
%ROUTINE PROCESS DOCUMENT
  !DOCUMENT LAYOUT PROGRAM
!SYMBOLIC CONSTANTS
%CONSTINTEGER SIN=77;  !SOURCE INPUT STREAM
%CONSTINTEGER ERR=0, DOC=78, SOUT=79;  !OUTPUT STREAMS
%CONSTINTEGER LBOUND=200;  !LINE BUFF BOUND
%CONSTINTEGER ABOUND=200;  !ATOM BUFF BOUND
%CONSTINTEGER SBOUND=200;  !SOURCE LINE BUFF BOUND
%CONSTINTEGER TBOUND=25;  !TAB BOUND
%CONSTINTEGER ESCBIT=256, UNDBIT=128, CASEBIT=32
%CONSTINTEGER CHARMASK=255, BASICMASK=127, LETMASK=95
%CONSTINTEGER SENTSP=544;  !512+' '
!LAYOUT PARAMETERS
%OWNINTEGER TOP=2, BOTTOM=4, LEFT=0, PAGE=60, LINE=72
%OWNINTEGER SLINE=80, NLS=1, SGAP=2, PGAP=3
%OWNINTEGER INDENT=0, SECTNO=0, PAGENO=0, START=1, FINISH=99999
%OWNINTEGER CAP='@', UND='_', CAPSH='.', UNDSH='%', INVERT=32
%OWNINTEGER CAPO='@', UNDO='_', CAPSHO='.', UNDSHO='%', INVERTO=32
%OWNINTEGER ASCII=1, JUST=0, MARK=0, ESCAPE='$'
%OWNINTEGERARRAY TAB(0:77) = 1,9,17,25,33,41,49,57,65,73,81,
    89,97,105,113,121,129,137,145,153,161,169,177,185,193,201, 0(52)

%OWNINTEGER XLINES=0, LINECAPIND=0, LINEUNDIND=0, LINEMIDIND=0
%OWNINTEGER INDENTIND=1, ERRIND=0, XPAGE=1
%OWNINTEGER COLS=0;  !COLUMNS USED ON CURRENT LINE
%OWNINTEGER TEXTCOLS;  !LAST COL OCCUPIED
%OWNINTEGER LINES=0;  !LINES PRINTED ON CURRENT PAGE
%OWNINTEGER PAGES=0;  !TOTAL PAGES PRINTED
%OWNINTEGER FIXED=0;  !FIXED COLUMNS
%OWNINTEGER GAPS=0, SGAPS=0;  !TOTAL GAPS, SENTENCE GAPS
%OWNINTEGER SIZE=0;  !SIZE OF CURRENT ATOM
%OWNINTEGER SMAX=0;  !UPDATED SOURCE POINTER
%OWNINTEGER INDENTCOL=1
%OWNINTEGER NEXT=0
%INTEGER DIRECTIVE,RELIND,FREELIST,NUM
%INTEGERARRAY BUFF(1:LBOUND);  !LINE BUFFER
%INTEGERARRAY ABUFF(1:ABOUND);  !ATOM BUFFER
%INTEGERARRAY SBUFF(1:SBOUND);  !SOURCE LINE (UPDATED)
%INTEGERARRAY LINK(1:108), HEAD,TAIL(1:500)

%ROUTINE FAULT(%INTEGER N)
%SWITCH S(1:9)
    SELECT OUTPUT(ERR)
    PRINT SYMBOL('*')
    ->S(N)
S(1): %PRINTTEXT 'FAULTY FORMAT AT '
    PRINT SYMBOL(NEXT)
    ->9
S(3): %PRINTTEXT 'UNKNOWN NAME';  ->9
S(4): %PRINTTEXT 'SCALAR/VECTOR MISMATCH';  ->9
S(5): %PRINTTEXT 'UNKNOWN DIRECTIVE ';  ->8
S(6): %PRINTTEXT 'SPURIOUS DIRECTIVE ';  ->8
S(7): %PRINTTEXT 'OUT OF BOUNDS ';  ->8
S(8): %PRINTTEXT 'OFF PAGE ';  ->8
S(9): %PRINTTEXT 'OVER TEXT '
8:  PRINT SYMBOL(DIRECTIVE)
    PRINT SYMBOL(RELIND) %IF RELIND # 0
9:  ERRIND = 1
    NEWLINE
%END

%ROUTINE READ ATOM OR DIRECTIVE
%INTEGER K,C,U,ATOMCAPIND,ATOMUNDIND
    %IF NEXT = 0 %THEN READCH(K) %ELSE K = NEXT %AND NEXT = 0
    DIRECTIVE = 0;  SIZE = 0
    ATOMCAPIND = LINECAPIND;  ATOMUNDIND = 0
    ATOMCAPIND = CASEBIT %AND READCH(K) %IF K = CAPSH
    %CYCLE
       READCH(K) %AND K = K+ESCBIT %IF K = ESCAPE
       ATOMUNDIND = UNDBIT %AND READCH(K) %IF K = UNDSH
       U = LINEUNDIND
       U  =  U!ATOMUNDIND %UNLESS K=' '
       U = UNDBIT %AND READCH(K) %IF K = UND
       C = ATOMCAPIND
       C = CASEBIT %AND READCH(K) %IF K = CAP
       K = K!!INVERT %IF 'A' <= K&LETMASK <= 'Z';  !LET
       K = K-C %IF 'A' <= K&BASICMASK-CASEBIT <= 'Z';  !LC LET
       %EXIT %IF K = NL
       K = K!U
       %EXIT %IF K = ' '
       %IF K&ESCBIT # 0 %AND 'A' <= K&LETMASK <= 'Z' %START
          %EXIT %IF SIZE # 0
          DIRECTIVE = K&LETMASK;  READ CH(NEXT)
          %RETURN
       %FINISH
       SIZE = SIZE+1;  ABUFF(SIZE) = K
       READ CH(K)
    %REPEAT
    NEXT = K
    %RETURN %IF ATOMUNDIND = 0 %OR SIZE = 0
    K = ABUFF(SIZE)!!UNDBIT
    ABUFF(SIZE) = K %IF K = '.' %OR K = ',' %OR K = ':' %C
     %OR K = ';' %OR K = ')'
%END

%ROUTINE PRINT SOURCE LINE
%INTEGER I
    %IF ERRIND # 0 %START
       SELECT OUTPUT(ERR)
       I = 0
       I = I+1 %AND PRINTCH(SBUFF(I)) %WHILE I # SMAX
       NEWLINE
       ERRIND = 0
    %FINISH
    SELECT OUTPUT(SOUT)
    SET MARGINS (SOUT,1,132)
    I = 0
    I = I+1 %AND PRINTCH(SBUFF(I)) %WHILE I # SMAX
    NEWLINE;  SMAX = 0
%END

%ROUTINE STORE(%INTEGER K)
    SMAX = SMAX+1;  SBUFF(SMAX) = K
%END

%ROUTINE STORE SOURCE ATOM
%INTEGER I,K,ATOMCAPIND,ATOMUNDIND

%ROUTINE TRANSLATE UNDERLINE
%INTEGER P,Q
    K = K-UNDBIT %AND %RETURN %IF LINEUNDIND # 0
    ->ONE %IF K&BASICMASK = ' '
    K = K-UNDBIT %AND %RETURN %IF ATOMUNDIND # 0
    ->ONE %IF UNDSHO = 0
    P = I
    %WHILE P # SIZE %CYCLE
       P = P+1;  Q = ABUFF(P)
       ->ONE %IF Q&UNDBIT = 0 %AND (P # SIZE %OR %C
        (Q # '.' %AND Q # ',' %AND Q # ':' %AND Q # ';' %AND Q # ')'))
    %REPEAT
    STORE(UNDSHO);  K = K-UNDBIT;  ATOMUNDIND = 1
    %RETURN
ONE:%RETURN %IF UNDO = 0
    STORE(UNDO);  K = K-UNDBIT
%END

    ATOMCAPIND = 0;  ATOMUNDIND = 0
    %IF LINECAPIND = 0 %AND CAPSHO # 0 %AND SIZE >= 2 %START
       %CYCLE I = 1,1,SIZE
          K = ABUFF(I)&BASICMASK
          ATOMCAPIND = 0 %AND %EXIT %IF 'A' <= K-CASEBIT <= 'Z';  !LC
          ATOMCAPIND = ATOMCAPIND+1 %IF 'A' <= K <= 'Z';  !UC
       %REPEAT
    %FINISH
    %IF SMAX # 0 %AND XLINES = 0 %START
       %IF SMAX+SIZE+1 <= SLINE %THEN STORE(' ') %C
       %ELSE PRINT SOURCE LINE
    %FINISH
    STORE(CAPSHO) %IF ATOMCAPIND # 0
    %CYCLE I = 1,1,SIZE
       K = ABUFF(I)
       TRANSLATE UNDERLINE %IF K&UNDBIT # 0
       K = K+CASEBIT %IF 'A' <= K <= 'Z' %AND (LINECAPIND # 0 %C
                            %OR ATOMCAPIND # 0)
       STORE(CAPO) %AND K = K+CASEBIT %IF 'A' <= K <= 'Z' %AND CAPO # 0
       K = K!!INVERTO %IF 'A' <= K&LETMASK <= 'Z'
       STORE(ESCAPE) %IF K&ESCBIT # 0
       STORE(K&CHARMASK)
    %REPEAT
%END

%ROUTINE SET COLUMN(%INTEGER M)
    %IF 1 <= M <= LINE %START
       M = M-1
       %IF M > COLS %START
          COLS = COLS+1 %AND BUFF(COLS) = ' ' %UNTIL COLS = M
       %FINISH %ELSE %START
          %WHILE COLS # M %CYCLE
             FAULT(9) %AND %EXIT %IF BUFF(COLS) # ' '
             COLS = COLS-1
          %REPEAT
       %FINISH
    %FINISH %ELSE %START
       FAULT(8);  INDENTCOL = 1 %IF INDENTCOL = M
    %FINISH
    FIXED = COLS;  GAPS = 0;  SGAPS = 0
%END

%ROUTINE MARK DOC
    %IF MARK = 1 %START
       PRINT SYMBOL('=');  SPACES(LINE-2);  PRINT SYMBOL('=')
       NEWLINE
    %FINISH %ELSE %START
       NEWPAGE
    %FINISH
%END

%ROUTINE RESET DOC LINE
    %IF XLINES # 0 %START
       XLINES = XLINES-1
       %IF XLINES = 0 %START
          LINECAPIND = 0;  LINEUNDIND = 0
          LINEMIDIND = 0;  INDENTIND = 1
       %FINISH
    %FINISH
    TEXTCOLS = 0;  COLS = 0;  FIXED = 0;  XPAGE = 0
    SET COLUMN(INDENTCOL) %IF INDENTIND # 0
%END

%ROUTINE PRINT DOC LINE
%CONSTINTEGER CR=13
%INTEGER I,J,K,L,M,U,V
    LINES = LINES+NLS
    %IF PAGES+1 >= START %START
       SELECT OUTPUT(DOC)
       SET MARGINS (DOC,1,132)
       %IF LINES = NLS %START
          MARK DOC %IF MARK # 0
          NEWLINES(TOP)
       %FINISH
       %IF TEXTCOLS # 0 %START
          L = LEFT
          L = L+(LINE-COLS)//2 %IF LINEMIDIND # 0
          SPACES(L)
          U = UNDBIT;  V = BASICMASK
          U = 0 %AND V = CHARMASK %IF ASCII = 0
          %CYCLE I = 1,1,COLS
             K = BUFF(I)
             %IF K&U # 0 %START
                M = I
                %CYCLE J = I,1,COLS
                   %IF BUFF(J)&UNDBIT # 0 %START
                      SPACES(J-M)
                      PRINT SYMBOL('_')
                      M = J+1
                   %FINISH
                %REPEAT
                PRINT CH(CR);  PRINT CH(CR)
!
! EMAS DOES NOT LIKE PRINTSYMBOL (CR)
!
                SPACES(L+I-1);  U = 0
             %FINISH
             PRINT SYMBOL(K&V)
          %REPEAT
       %FINISH
       NEWLINES(NLS)
       %IF LINES >= PAGE %AND BOTTOM # 0 %START
          %IF PAGENO = 0 %START
             NEWLINES(BOTTOM)
          %FINISH %ELSE %START
             I = BOTTOM//2
             NEWLINES(I)
             SPACES(LEFT+LINE//2-4);  WRITE(PAGENO,1)
             NEWLINES(BOTTOM-I)
          %FINISH
       %FINISH
    %FINISH
    %IF LINES >= PAGE %START
       LINES = 0;  PAGES = PAGES+1
       PAGENO = PAGENO+1 %IF PAGENO # 0
    %FINISH
    RESET DOC LINE
%END

%ROUTINE JUSTIFY
%OWNINTEGER FLIP=0
%INTEGER I,J,K,L,MIN,COUNT,SCOUNT,WAIT,SWAIT
    COUNT = LINE-COLS
    %RETURN %IF COUNT <= 0 %OR GAPS = 0
    MIN = COUNT//GAPS
    COUNT = COUNT-MIN*GAPS
    SCOUNT = SGAPS;  SCOUNT = COUNT %IF COUNT < SGAPS
    COUNT = COUNT-SCOUNT
    FLIP = 1-FLIP
    %IF FLIP # 0 %START
       WAIT = 0;  SWAIT = 0
    %FINISH %ELSE %START
       WAIT = GAPS-COUNT;  SWAIT = SGAPS-SCOUNT
    %FINISH
    J = LINE
    %CYCLE I = COLS,-1,1
       K = BUFF(I)
       %IF (K = SENTSP %OR K = ' ') %AND BUFF(I-1) # K %START
          L = J-MIN
          %IF WAIT = 0 %START
             L = L-1 %AND COUNT = COUNT-1 %IF COUNT # 0
          %FINISH %ELSE WAIT = WAIT-1
          %IF K = SENTSP %START
             %IF SWAIT = 0 %START
                L = L-1 %AND SCOUNT = SCOUNT-1 %IF SCOUNT # 0
             %FINISH %ELSE SWAIT = SWAIT-1
          %FINISH
          BUFF(J) = ' ' %AND J = J-1 %WHILE J # L
          COLS = LINE %AND %RETURN %IF J = I
       %FINISH
       BUFF(J) = K;  J = J-1
    %REPEAT
    %STOP
%END

%ROUTINE PLACE ATOM
%INTEGER I,L,S
    %IF COLS # FIXED %AND XLINES = 0 %START
       L = COLS+1;  S = ' '
       %IF (BUFF(COLS) = '.' %OR BUFF(COLS) = '?') %C
        %AND 'A' <= ABUFF(1) <= 'Z' %START
          L = COLS+SGAP;  S = SENTSP
       %FINISH
       %IF L+SIZE <= LINE %START
          COLS = COLS+1 %AND BUFF(COLS) = S %WHILE COLS # L
          GAPS = GAPS+1;  SGAPS = SGAPS+1 %IF S = SENTSP
       %FINISH %ELSE %START
          JUSTIFY %IF JUST # 0
          PRINT DOC LINE
          PRINT SOURCE LINE %IF SMAX # 0
       %FINISH
    %FINISH
    I = 0
    %WHILE I # SIZE %CYCLE
       COLS = COLS+1;  I = I+1
       BUFF(COLS) = ABUFF(I)
    %REPEAT
    TEXTCOLS = COLS
%END

%ROUTINE PROCESS DIRECTIVE
%INTEGER D,C,T
%SWITCH S('A':'Z')
%ROUTINESPEC ASSIGN

%ROUTINE SKIP
    SMAX = SMAX+1;  SBUFF(SMAX) = NEXT
    READ CH(NEXT)
%END

%ROUTINE READ NUM
    RELIND = 0;  NUM = 1
    RELIND = NEXT %AND SKIP %IF NEXT = '+' %OR NEXT = '-'
    %IF '0' <= NEXT <= '9' %START
       NUM = NEXT-'0';  SKIP
       NUM = 10*NUM-'0'+NEXT %AND SKIP %WHILE '0' <= NEXT <= '9'
    %FINISH
    NUM = -NUM %IF RELIND = '-'
%END

    D = DIRECTIVE&LETMASK
    %IF XLINES # 0 %START
       FAULT(6) %IF XLINES > 0 %OR TEXTCOLS # 0
       XLINES = 1;  RESET DOC LINE
    %FINISH
    %IF TEXTCOLS # 0 %AND 'C' # D # 'T' %START
       JUSTIFY %IF JUST # 0 %AND D = 'J'
       PRINT DOC LINE
       PRINT SOURCE LINE %IF SMAX # 0
    %FINISH
    PRINT SOURCE LINE %IF SMAX+5 > SLINE
    STORE(' ') %IF SMAX # 0
    STORE(ESCAPE);  STORE(DIRECTIVE)
    READ NUM
    ->S(D)

S('A'):  !ASSIGN
    %CYCLE
       ASSIGN
       SKIP %WHILE NEXT # ';' %AND NEXT # NL
       %EXIT %IF NEXT = NL
       SKIP
    %REPEAT
    INVERT = 32 %IF INVERT # 0;  INVERTO = 32 %IF INVERTO # 0
    PAGE = 9999 %IF PAGE <= 0
    FAULT(7) %AND INDENT = 0 %UNLESS 0 <= INDENT <= TBOUND
    INDENTCOL = TAB(INDENT)
    SET COLUMN(INDENTCOL)
    %RETURN
S('B'):  !BLANKS
    %IF LINES # 0 %OR XPAGE # 0 %START
       NUM = NUM*NLS
       NUM = PAGE-LINES %IF PAGE-LINES < NUM
       PRINT DOC LINE %AND NUM = NUM-NLS %WHILE NUM > 0
    %FINISH
    %RETURN
S('C'):  !COL
    NUM = COLS+1+NUM %IF RELIND # 0
    SET COLUMN(NUM)
    %RETURN
S('E'): !END
    PRINT DOC LINE %WHILE LINES # 0 %AND PAGE < 999
    FINISH = PAGES;  NEXT = NL
    %RETURN
S('I'):  !INDENT
    NUM = INDENT+NUM %IF RELIND # 0
    FAULT(7) %AND NUM = 0 %UNLESS 0 <= NUM <= TBOUND
    NUM = TAB(NUM)
    SET COLUMN(NUM)
    %RETURN
S('J'):  !JUSTIFY (DONE)
    %RETURN
S('L'):  !LINES
    XLINES = NUM;  XLINES = -1 %IF XLINES = 0
    INDENTIND = 0
    %WHILE NEXT # NL %CYCLE
       LINECAPIND = CASEBIT %IF NEXT&LETMASK = 'C'
       LINEUNDIND = UNDBIT %IF NEXT&LETMASK = 'U'
       LINEMIDIND = 1 %IF NEXT&LETMASK = 'M'
       INDENTIND = 1 %IF NEXT&LETMASK = 'I'
       SKIP
    %REPEAT
    COLS = 0 %AND FIXED = 0 %IF INDENTIND = 0
    %RETURN
S('N'):  !NEWPAGE
    %RETURN %IF PAGE >= 999
    PRINT DOC LINE %WHILE LINES # 0
    XPAGE = 1
    %RETURN
S('P'):  !PARAGRAPH
    %IF LINES # 0 %START
       NUM = NUM*NLS
       NUM = PAGE-LINES %IF PAGE-LINES < NUM+2
       PRINT DOC LINE %AND NUM = NUM-NLS %WHILE NUM > 0
    %FINISH
    SET COLUMN(COLS+1+PGAP)
    %RETURN
S('T'):  !TAB
    %IF RELIND # 0 %START
       T = 0;  C = COLS+1
       %IF RELIND = '+' %START
          %WHILE NUM > 0 %CYCLE
             T = T+1 %UNTIL T > TBOUND %OR TAB(T) > C
             FAULT(7) %AND %RETURN %IF T > TBOUND
             C = TAB(T)
             NUM = NUM-1
          %REPEAT
       %FINISH %ELSE %START
          T = T+1 %UNTIL T > TBOUND %OR TAB(T) >= C
          %WHILE NUM < 0 %CYCLE
             T = T-1 %UNTIL T < 0 %OR TAB(T) < C
             FAULT(7) %AND %RETURN %IF T < 0
             C = TAB(T)
             NUM = NUM+1
          %REPEAT
       %FINISH
    %FINISH %ELSE %START
       FAULT(7) %AND %RETURN %UNLESS 0 <= NUM <= TBOUND
       C = TAB(NUM)
    %FINISH
    SET COLUMN(C)
    %RETURN
S('V'):  !VERIFY
    %IF PAGE-LINES < NUM*NLS %START
       PRINT DOC LINE %WHILE LINES # 0
    %FINISH
    %RETURN
S('D'): S('F'): S('G'): S('H'):
S('K'): S('M'): S('O'): S('Q'): S('R'):
S('S'): S('U'): S('W'): S('X'): S('Y'): 
S('Z'):
    FAULT(5)
    %RETURN


%INTEGERFN NEWCELL(%INTEGER H,T)
%INTEGER P
    %MONITOR 10 %IF FREELIST = 0
    P = FREELIST;  FREELIST = HEAD(FREELIST)
    HEAD(P) = H;  TAIL(P) = T
    %RESULT = P
%END

%ROUTINE POP(%INTEGERNAME L)
    HEAD(L) = FREELIST;  FREELIST = L
    L = TAIL(L)
%END

%ROUTINE ASSIGN
%CONSTINTEGER NAMEMAX=32
%INTEGER I,J,K
%ROUTINESPEC READ NAME(%INTEGERNAME ORDINAL)
%INTEGERMAPSPEC MAP(%INTEGER I)

    READ NAME(I);  %RETURN %IF I = 0
    SKIP %WHILE NEXT = ' '
    %IF NEXT = '<' %OR NEXT = '>' %START
       J = I
       %CYCLE
          %IF NEXT = '<' %START
             LINK(J) = NEWCELL(MAP(J),LINK(J))
          %FINISH %ELSE %START
             MAP(J) = HEAD(LINK(J))
             POP(LINK(J))
          %FINISH
          J = J+1
          %EXIT %IF J < NAMEMAX %OR J >= 57
       %REPEAT
       SKIP %UNTIL NEXT # ' '
      %RETURN %IF NEXT = ';' %OR NEXT = NL
    %FINISH
    FAULT(1) %AND %RETURN %IF NEXT # '='
    %CYCLE
       SKIP %UNTIL NEXT # ' '
       %IF 'A' <= NEXT&LETMASK <= 'Z' %START
          READ NAME(J);  %RETURN %IF J = 0
       %FINISH %ELSE %START
          J = 0
          %IF NEXT = '''' %START
             SKIP;  !QUOTEMARK
             NUM = NEXT;  SKIP;  !QUOTED SYMBOL
             SKIP;  !QUOTEMARK (PRESUMABLY)
          %FINISH %ELSE %START
             READ NUM
             NUM = MAP(I)+NUM %IF RELIND # 0
          %FINISH
       %FINISH
       %CYCLE
          MAP(I) = MAP(J)
          I = I+1;  J = J+1
          %EXIT %IF J < NAMEMAX
          %EXIT %IF I < NAMEMAX %OR I = 57 %OR I = 83 %OR I = 109
       %REPEAT
       %EXIT %UNLESS NEXT = ',' %AND I > NAMEMAX
    %REPEAT
    FAULT(1) %UNLESS NEXT = ';' %OR NEXT = NL

%ROUTINE GET(%INTEGERNAME K)
    K = 0 %AND %RETURN %UNLESS 'A' <= NEXT&LETMASK <= 'Z'
    K = NEXT&31;  SKIP
%END;  !GET

%ROUTINE GET TRIO(%INTEGERNAME T)
%INTEGER A,B,C
    GET(A);  GET(B);  GET(C)
    T = (A<<5+B)<<5+C
%END;  !GET TRIO

%ROUTINE READ NAME(%INTEGERNAME ORDINAL)
%INTEGER N1,N2
%OWNINTEGERARRAY NAME1(1:32) = 20976, 2548, 12454, 16423, 12590,
    19849, 14739, 19681, 16609, 9668, 19619, 16423, 3120,
    21956, 3120, 21956, 9686, 3120, 21956, 3120, 21956, 9686,
    1635, 10931, 13362, 20097, 6446, 5731, 0, 0,
    -1, 20514
%OWNINTEGERARRAY NAME2(1:32) = 0, 20973, 20480, 5120, 5120,
    14496, 0, 16384, 16384, 5588, 20943, 5583, 0,
    0, 19712, 19712, 5716, 15360, 15360, 19727, 19727, 15360,
    9504, 20480, 11264, 19072, 9832, 1541, 0, 0,
    -1, 0

    SKIP %WHILE NEXT = ' '
    GET TRIO(N1);  GET TRIO(N2)
    FAULT(1) %AND ORDINAL = 0 %AND %RETURN %IF N1 = 0
    %IF N1 = 20653 %START;  !'TEM' (TEMP)
       ORDINAL = 58
       ORDINAL = 84 %IF N2 = 16448;  !'PB'
       %RETURN
    %FINISH
    %CYCLE ORDINAL = 1,1,NAMEMAX
       %RETURN %IF NAME1(ORDINAL) = N1 %AND NAME2(ORDINAL) = N2
    %REPEAT
    FAULT(3);  ORDINAL = 0
%END;  !READ NAME

%INTEGERMAP MAP(%INTEGER I)
%SWITCH S(0:30)
    %RESULT  == TAB(I-31) %IF I >= 32
    ->S(I)
S(0):  %RESULT  == NUM
S(1):  %RESULT  == TOP
S(2):  %RESULT  == BOTTOM
S(3):  %RESULT  == LEFT
S(4):  %RESULT  == PAGE
S(5):  %RESULT  == LINE
S(6):  %RESULT  == SLINE
S(7):  %RESULT  == NLS
S(8):  %RESULT  == SGAP
S(9):  %RESULT  == PGAP
S(10): %RESULT  == INDENT
S(11): %RESULT  == SECTNO
S(12): %RESULT  == PAGENO
S(13): %RESULT  == CAP
S(14): %RESULT  == UND
S(15): %RESULT  == CAPSH
S(16): %RESULT  == UNDSH
S(17): %RESULT  == INVERT
S(18): %RESULT  == CAPO
S(19): %RESULT  == UNDO
S(20): %RESULT  == CAPSHO
S(21): %RESULT  == UNDSHO
S(22): %RESULT  == INVERTO
S(23): %RESULT  == ASCII
S(24): %RESULT  == JUST
S(25): %RESULT  == MARK
S(26): %RESULT  == START
S(27): %RESULT  == FINISH
S(28): %RESULT  == ESCAPE
%END;  !MAP

%END;  !ASSIGN

%END;  !PROCESS DIRECTIVE

    SELECT INPUT(SIN)
    SET MARGINS (SIN,1,160)
    SELECT OUTPUT(SOUT)
    SET MARGINS (SOUT,1,132)
    %CYCLE FREELIST = 1,1,108
       LINK(FREELIST) = 0
    %REPEAT
    %CYCLE FREELIST = 1,1,500
       HEAD(FREELIST) = FREELIST-1
    %REPEAT
    %WHILE PAGES < FINISH %CYCLE
       READ ATOM OR DIRECTIVE
       %IF DIRECTIVE # 0 %START
          PROCESS DIRECTIVE
       %FINISH %ELSE %START
          %IF SIZE # 0 %START
             PLACE ATOM
             STORE SOURCE ATOM
             NEXT = 0 %IF NEXT = NL %AND XLINES = 0
          %FINISH
          %IF XLINES # 0 %START
             %IF NEXT = ' ' %START
                STORE(NEXT)
                COLS = COLS+1;  BUFF(COLS) = ' '
             %FINISH
             PRINT DOC LINE %IF NEXT = NL
          %FINISH
       %FINISH
       PRINT SOURCE LINE %IF NEXT = NL
       NEXT = 0 %IF NEXT = ' ' %OR NEXT = NL
    %REPEAT
    PRINT DOC LINE
%END
%ENDOFFILE