!****************** VERSION DATED 27/9/77 ****************************
!*
!*      * $VM$BN NOW WORKS IN ALL CASES - N  BLANK LINES NOW SENT TO
!*        OUTPUT FILE AFTER PAGE TURN CAUSED BY $V.
!*      * 'READ ATOM OR DIRECTIVE' REWRITTEN.  ESC GIVEN PRIORITY.
!*        SYMBOL PARAMETERS CANNOT BE LETTERS.
!*        CAP, CAPSH, UND, UNDSH CAN NOW BE COMBINED IN ANY ORDER, ALTHOUGH
!*        CAPSH IS STILL ONLY RECOGNISED IF THE FIRST SYMBOL READ OF THE
!*        ATOM.
!*      * THE UPDATED SOURCE IS NOT GENERATED IF NO FILE HAS BEEN GIVEN
!*        FOR IT.
%EXTERNAL %INTEGER %FN %SPEC EXIST(%STRING (63) S)
!*
!*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!*
!* ROUTINE REQUIRED TO DECODE AND SET STREAMS FOR EMAS.
!*
%EXTERNAL %ROUTINE %SPEC DEFINE(%STRING (63) S)
%EXTERNAL %ROUTINE %SPEC SETMARGINS(%INTEGER J,K,L)
%ROUTINE %SPEC PROCESSDOCUMENT
%EXTERNAL %ROUTINE LAYOUT(%STRING (63) S)
%EXTERNAL %INTEGER %FN %SPEC SSFAIL
%STRING (63) INFILE,OUTFILE,TIDYFILE
  %UNLESS S->INFILE.('/').OUTFILE %THEN %START
    SELECTOUTPUT(0)
    PRINTSTRING('FAULTY PARAMETERS');  NEWLINE
    %RETURN
  %FINISH
  %IF EXIST(INFILE)=0 %THEN %START
    PRINTSTRING(INFILE.' DOES NOT EXIST, OR NO ACCESS')
    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 %THEN %RETURN
  DEFINE('STREAM78,'.OUTFILE);          ! OUTPUT FILE
  %UNLESS SSFAIL=0 %THEN %RETURN
  DEFINE('STREAM79,'.TIDYFILE);         ! UPDATED SOURCE
  %UNLESS SSFAIL=0 %THEN %RETURN
!*
!* 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
  PROCESSDOCUMENT
%END
                                        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE PROCESSDOCUMENT
!*  DOCUMENT LAYOUT PROGRAM
!* SYMBOLIC CONSTANTS
%CONST %INTEGER SIN=77;                 !SOURCE INPUT STREAM
%CONST %INTEGER ERR=0,DOC=78,SOUT=79;   !OUTPUT STREAMS
%CONST %INTEGER LBOUND=200;             !LINE BUFF BOUND
%CONST %INTEGER ABOUND=200;             !ATOM BUFF BOUND
%CONST %INTEGER SBOUND=200;             !SOURCE LINE BUFF BOUND
%CONST %INTEGER TBOUND=25;              !TAB BOUND
%CONST %INTEGER ESCBIT=256,UNDBIT=128,CASEBIT=32
%CONST %INTEGER CHARMASK=255,BASICMASK=127,LETMASK=95
%CONST %INTEGER SENTSP=544;             !512+' '
                                        !LAYOUT PARAMETERS
%OWN %INTEGER TOP=2,BOTTOM=4,LEFT=0,PAGE=60,LINE=72
%OWN %INTEGER SLINE=80,NLS=1,SGAP=2,PGAP=3
%OWN %INTEGER INDENT=0,PAGENO=0,START=1,FINISH=99999
%OWN %INTEGER CAP='@',UND='_',CAPSH='.',UNDSH='%',INVERT=32
%OWN %INTEGER CAPO='@',UNDO='_',CAPSHO='.',UNDSHO='%',INVERTO=32
%OWN %INTEGER ASCII=1,JUST=0,MARK=0,ESCAPE='$'
%OWN %INTEGER IGNORE=0
%OWN %INTEGER %ARRAY TAB(0:25)=  %C
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
%OWN %INTEGER XLINES=0,LINECAPIND=0,LINEUNDIND=0,LINEMIDIND=0
%OWN %INTEGER INDENTIND=1,ERRIND=0,XPAGE=1
%OWN %INTEGER COLS=0;                   !COLUMNS USED ON CURRENT LINE
%OWN %INTEGER TEXTCOLS;                 !LAST COL OCCUPIED
%OWN %INTEGER LINES=0;                  !LINES PRINTED ON CURRENT PAGE
%OWN %INTEGER PAGES=0;                  !TOTAL PAGES PRINTED
%OWN %INTEGER FIXED=0;                  !FIXED COLUMNS
%OWN %INTEGER GAPS=0,SGAPS=0;           !TOTAL GAPS, SENTENCE GAPS
%OWN %INTEGER SIZE=0;                   !SIZE OF CURRENT ATOM
%OWN %INTEGER SMAX=0;                   !UPDATED SOURCE POINTER
%OWN %INTEGER INDENTCOL=1
%OWN %INTEGER NEXT=0
%INTEGER DIRECTIVE,RELIND,FREELIST,NUM
%INTEGER %ARRAY BUFF(1:LBOUND);         !LINE BUFFER
%INTEGER %ARRAY ABUFF(1:ABOUND);        !ATOM BUFFER
%INTEGER %ARRAY SBUFF(1:SBOUND);        ! SOURCE LINE (UPDATED)
%INTEGER %ARRAY LINK(1:57),HEAD,TAIL(1:500)
  %ROUTINE FAULT(%INTEGER N)
  %SWITCH S(1:11)
    SELECTOUTPUT(ERR)
    PRINTSYMBOL('*')
    ->S(N)
S(1):
    PRINTSTRING('FAULTY FORMAT AT ')
    PRINTSYMBOL(NEXT)
    ->A9
S(2):
    PRINTSTRING('INVALID ASSIGNMENT TO SYMBOL PARAMETER');  ->A9
S(3):
    PRINTSTRING('UNKNOWN NAME');  ->A9
S(4):
    PRINTSTRING('SCALAR/VECTOR MISMATCH');  ->A9
S(5):
    PRINTSTRING('UNKNOWN DIRECTIVE ');  ->A8
S(6):
    PRINTSTRING('SPURIOUS DIRECTIVE ');  ->A8
S(7):
    PRINTSTRING('OUT OF BOUNDS ');  ->A8
S(8):
    PRINTSTRING('OFF PAGE ');  ->A8
S(9):
    PRINTSTRING('OVER TEXT ');  ->A8
S(10):
    PRINTSTRING( %C
       'TOO MANY PARAMETER VALUES NESTED - RUN ABANDONED')
    ->A9
S(11):
    PRINTSTRING('NO VALUE STORED ');  ->A9
A8: PRINTSYMBOL(DIRECTIVE)
    PRINTSYMBOL(RELIND) %IF RELIND#0
A9: ERRIND=1
    NEWLINE
  %END
  %ROUTINE READATOMORDIRECTIVE
  %INTEGER K,C,U,ATOMCAPIND,ATOMUNDIND
    %IF NEXT=0 %THEN READCH(K) %ELSE K=NEXT %AND NEXT=0
    DIRECTIVE=0;  SIZE=0
    %IF IGNORE#0 %THEN %START
      %CYCLE
        READCH(K) %WHILE K#ESCAPE
        READCH(K)
        DIRECTIVE=K&LETMASK
        %IF DIRECTIVE='A' %OR DIRECTIVE='E' %C
           %THEN READCH(NEXT) %AND %RETURN
        READCH(K)
      %REPEAT
    %FINISH
    %IF K&ESCBIT#0 %THEN %START;        ! DIRECTIVE READ IN LAST CALL.
      DIRECTIVE=K&LETMASK
      READCH(NEXT)
      %RETURN
    %FINISH
    ATOMCAPIND=LINECAPIND;  ATOMUNDIND=LINEUNDIND
    ATOMCAPIND=CASEBIT %AND READCH(K) %IF K=CAPSH
    %CYCLE
      U=ATOMUNDIND;  C=ATOMCAPIND
BACK: %IF 'A'<=K&LETMASK<='Z' %THEN %START
                                        ! LETTER
        K=K!!INVERT
        K=K-C %IF K&BASICMASK>96;       ! LC LETTER -> UC IF REQUESTED.
        ->TOBUFF
      %FINISH
      %EXIT %IF (K=' ' %AND LINEUNDIND=0) %OR K=NL
      %IF K=ESCAPE %THEN %START
        READCH(K);  K=K+ESCBIT
        ->TOBUFF %UNLESS 'A'<=K&LETMASK<='Z'
        %EXIT %IF SIZE#0
!* I.E. IF ATOM ALREADY READ IN THIS CALL, DEAL WITH DIRECTIVE LATER.
        DIRECTIVE=K&LETMASK
        READCH(NEXT)
        %RETURN
      %FINISH
      %IF K=UNDSH %THEN %START
        ATOMUNDIND=UNDBIT
        U=UNDBIT;  READCH(K);  ->BACK
      %FINISH
      %IF K=UND %THEN %START
        U=UNDBIT
        READCH(K);  ->BACK %UNLESS K=' '
      %FINISH
      %IF K=CAP %THEN %START
        C=CASEBIT;  READCH(K);  ->BACK
      %FINISH
TOBUFF:
      SIZE=SIZE+1;  ABUFF(SIZE)=K!U
      READCH(K)
    %REPEAT
    NEXT=K
    %RETURN %IF ATOMUNDIND=0 %OR SIZE=0
!* REMOVES UNDERLINE FROM TERMINATING PUNCTUATION - BUT NOT IF SET BY UND
    K=ABUFF(SIZE)!!UNDBIT
    ABUFF(SIZE)=K %IF K='.' %OR K=',' %OR K=':' %OR K=';' %C
       %OR K=')' %OR K='!' %OR K='?'
  %END
  %ROUTINE PRINTSOURCELINE
  %INTEGER I
    %IF ERRIND#0 %START
      SELECTOUTPUT(ERR)
      I=0
      I=I+1 %AND PRINTCH(SBUFF(I)) %WHILE I#SMAX
      NEWLINE
      ERRIND=0
    %FINISH
    SMAX=0 %AND %RETURN %IF SOUT=0
    SELECTOUTPUT(SOUT)
    SETMARGINS(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 STORESOURCEATOM
!* IN GENERAL, THE UNDERLINE AND CAPITALISE OUTPUT PARAMETERS ARE USED
!* IF NOT DISABLED.  ALL LETTERS ARE SET TO LOWER CASE, WITH
!* APPROPRIATE SYMBOL PARAMETERS, AND THEN INVO IS APPLIED.  THIS
!* SWITCHES THEM BACK, IF INVO IS NON-ZERO, TO U.C.
!* IF AN OUTPUT DEVICE ACCEPTED THE 8TH BIT SET AS SIGNIFYING UNDERLINING,
!* SETTING UNDO AND UNDSHO TO 0 WOULD CAUSE THE 8TH BIT TO BE SET TO
!* SIGNIFY UNDERLINING.
  %INTEGER I,K,ATOMCAPIND,ATOMUNDIND
    %ROUTINE TRANSLATEUNDERLINE
    %INTEGER P,Q
      K=K-UNDBIT %AND %RETURN %IF LINEUNDIND#0
      ->ONE %IF K-UNDBIT=' '
      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 (Q#'.' %C
           %AND Q#',' %AND Q#':' %AND Q#';' %AND Q#')' %C
           %AND Q#'!' %AND Q#'?'))
      %REPEAT
      STORE(UNDSHO);  K=K-UNDBIT;  ATOMUNDIND=1
      %RETURN
ONE:  %RETURN %IF UNDO=0
      STORE(UNDO);  K=K-UNDBIT
    %END
    %IF SMAX#0 %AND XLINES=0 %START
      %IF SMAX+SIZE+1<=SLINE %THEN STORE(' ') %C
         %ELSE PRINTSOURCELINE
    %FINISH
    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=1 %IF 'A'<=K<='Z';   !UC
      %REPEAT
    %FINISH
    STORE(CAPSHO) %IF ATOMCAPIND#0
    %CYCLE I=1,1,SIZE
      K=ABUFF(I)
      TRANSLATEUNDERLINE %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 SETCOLUMN(%INTEGER M)
!* THIS MOVES TO COL M-1 SO THAT THE NEXT ATOM STARTS AT COL M.
!* FIXED IS SET TO SUPPRESS A SPACE BEING INSERTED BEFORE THAT ATOM, AND
!* TO INHIBIT JUSTIFICATION TO THE LEFT OF THIS POINT.
!* ON ENTRY, COLS GIVES THE LAST COLUMN USED.
    %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 MARKDOC
    %IF MARK=1 %START
      PRINTSYMBOL('=');  SPACES(LINE-2);  PRINTSYMBOL('=')
      NEWLINE
    %FINISH %ELSE %START
      NEWPAGE
    %FINISH
  %END
  %ROUTINE RESETDOCLINE
    %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
    SETCOLUMN(INDENTCOL) %IF INDENTIND#0
  %END
  %ROUTINE PRINTDOCLINE
  %CONST %INTEGER CR=13
  %INTEGER I,J,K,L,M,U,V
    LINES=LINES+NLS
    %IF PAGES+1>=START %START
      SELECTOUTPUT(DOC)
      SETMARGINS(DOC,1,132)
      %IF LINES=NLS %START
        MARKDOC %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)
                PRINTSYMBOL('_')
                M=J+1
              %FINISH
            %REPEAT
            PRINTCH(CR);  PRINTCH(CR)
            SPACES(L+I-1);  U=0
          %FINISH
          PRINTCH(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
    RESETDOCLINE
  %END
  %ROUTINE JUSTIFY
  %OWN %INTEGER FLIP=0
  %INTEGER I,J,K,L,MIN,COUNT,SCOUNT,AWAIT,SWAIT,AGAPS
    COUNT=LINE-COLS
    %RETURN %IF COUNT<=0 %OR GAPS=0
    AGAPS=GAPS-SGAPS;                   ! ATOM GAPS
    MIN=COUNT//GAPS;                    ! MIN NO OF SPACES TO BE ADDED TO EVERY GAP.
    COUNT=COUNT-MIN*GAPS;               ! SPACES TO BE ADDED AS WELL AS MIN AT EACH GAP
!* SENTENCE GAPS ARE FILLED IN PREFERENCE TO ATOM GAPS.
    SCOUNT=SGAPS;  SCOUNT=COUNT %IF COUNT<SGAPS
    COUNT=COUNT-SCOUNT;                 ! COUNT IS NOW NO OF SPACES FOR ATOM GAPS.
    FLIP=1-FLIP
    %IF FLIP#0 %START;                  ! EXTRA SPACES FROM RH END.
      AWAIT=0;  SWAIT=0
!* NOS OF ATOM AND SENTENCE GAPS TO BE PASSED BEFORE INSERTION BEGINS.
    %FINISH %ELSE %START
      AWAIT=AGAPS-COUNT;  SWAIT=SGAPS-SCOUNT
    %FINISH
    J=LINE;                             ! BUFF(J) TO BE OUTPUT TO.
    %CYCLE I=COLS,-1,1
      K=BUFF(I)
      %IF (K=SENTSP %OR K=' ') %AND BUFF(I-1)#K %START
!* SECOND TEST PREVENTS GAPS FROM BEING PADDED MORE THAN ONCE.
        L=J-MIN
        %IF K=SENTSP %START;            ! SENTENCE GAPS
          %IF SWAIT=0 %START
            L=L-1 %AND SCOUNT=SCOUNT-1 %IF SCOUNT#0
          %FINISH %ELSE SWAIT=SWAIT-1
        %FINISH %ELSE %START;           ! ATOM GAP
          %IF AWAIT=0 %START
            L=L-1 %AND COUNT=COUNT-1 %IF COUNT#0
          %FINISH %ELSE AWAIT=AWAIT-1
        %FINISH
        BUFF(J)=' ' %AND J=J-1 %WHILE J#L
                                        ! SPACES INSERTED
        COLS=LINE %AND %RETURN %IF J=I
      %FINISH
      BUFF(J)=K;  J=J-1
    %REPEAT
  %END
  %ROUTINE PLACEATOM
  %INTEGER I,L,S
    %IF COLS#FIXED %AND XLINES=0 %START
      L=COLS+1;  S=' '
      %IF (BUFF(COLS)='.' %OR BUFF(COLS)='?' %C
         %OR BUFF(COLS)='!') %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
        PRINTDOCLINE
        PRINTSOURCELINE %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 PROCESSDIRECTIVE
  %INTEGER C,T
  %SWITCH S('A':'Z')
  %ROUTINE %SPEC ASSIGN
    %ROUTINE SKIP
      SMAX=SMAX+1;  SBUFF(SMAX)=NEXT
      READCH(NEXT)
    %END
    %ROUTINE READNUM
      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
    %IF XLINES#0 %START
      FAULT(6) %IF XLINES>0 %OR TEXTCOLS#0
!* I.E. FAULT IF $L NOT FINISHED OR, WITH $L0, OFF LHM, WHEN
!*      DIRECTIVE ENCOUNTERED.
      XLINES=1;  RESETDOCLINE
    %FINISH
    %IF TEXTCOLS#0 %AND 'C'#DIRECTIVE#'T' %START
      JUSTIFY %IF JUST#0 %AND DIRECTIVE='J'
      PRINTDOCLINE
      PRINTSOURCELINE %IF SMAX#0
    %FINISH
    PRINTSOURCELINE %IF SMAX+5>SLINE
    STORE(' ') %IF SMAX#0
    STORE(ESCAPE);  STORE(DIRECTIVE)
    READNUM
    ->S(DIRECTIVE)
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)
    SETCOLUMN(INDENTCOL)
    ->S('N') %IF IGNORE#0
    %RETURN
S('B'):                                 !BLANKS
    %IF LINES#0 %OR XPAGE#0 %START;     ! NOTE XPAGE SET BY $N TO 1.
      NUM=NUM*NLS
      NUM=PAGE-LINES %IF PAGE-LINES<NUM
      PRINTDOCLINE %AND NUM=NUM-NLS %WHILE NUM>0
    %FINISH
    %RETURN
S('C'):                                 !COL
    NUM=COLS+1+NUM %IF RELIND#0
    SETCOLUMN(NUM)
    %RETURN
S('E'):                                 !END
    PRINTDOCLINE %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)
    SETCOLUMN(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
    PRINTDOCLINE %WHILE LINES#0
    XPAGE=1
    %RETURN
S('P'):                                 !PARAGRAPH
    %IF LINES#0 %START
      NUM=NUM*NLS
      NUM=PAGE-LINES %IF PAGE-LINES<NUM+2
      PRINTDOCLINE %AND NUM=NUM-NLS %WHILE NUM>0
    %FINISH
    SETCOLUMN(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
    SETCOLUMN(C)
    %RETURN
S('V'):                                 !VERIFY
    %IF PAGE-LINES<NUM*NLS %START
      PRINTDOCLINE %WHILE LINES#0
      XPAGE=1
    %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)
    %ROUTINE NEWCELL(%INTEGER H, %INTEGER %NAME T)
    %INTEGER P
      %IF FREELIST=0 %START
        FAULT(10)
        PRINTSOURCELINE
        %STOP
      %FINISH
      P=FREELIST;  FREELIST=HEAD(FREELIST)
      HEAD(P)=H;  TAIL(P)=T
      T=P
    %END
    %ROUTINE POP(%INTEGER %NAME L)
      HEAD(L)=FREELIST;  FREELIST=L
      L=TAIL(L)
    %END
    %ROUTINE ASSIGN
    %CONST %INTEGER NAMEMAX=32
    %INTEGER I,J,K
    %ROUTINE %SPEC READNAME(%INTEGER %NAME ORDINAL)
    %INTEGER %MAP %SPEC MAP(%INTEGER I)
      READNAME(I);  %RETURN %IF I=0
      SKIP %WHILE NEXT=' '
      %IF NEXT='<' %OR NEXT='>' %START
        J=I
        %CYCLE
          %IF NEXT='<' %START
            NEWCELL(MAP(J),LINK(J))
          %FINISH %ELSE %START
            FAULT(11) %AND %RETURN %IF LINK(J)=0
            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
                                        ! RHS ALSO PARAMETER.
          READNAME(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
            READNUM
            NUM=MAP(I)+NUM %IF RELIND#0
          %FINISH
        %FINISH
        FAULT(2) %AND %RETURN %IF 1<=I<=6 %C
           %AND ('A'<=MAP(J)&LETMASK<='Z' %OR MAP(J)=' ')
        %CYCLE
          MAP(I)=MAP(J);                ! N.B. MAP(0)==NUM.
          I=I+1;  J=J+1
          %EXIT %IF J<NAMEMAX
          %EXIT %IF I<NAMEMAX %OR I=57
        %REPEAT
        %EXIT %UNLESS NEXT=',' %AND I>NAMEMAX
      %REPEAT
      FAULT(1) %UNLESS NEXT=';' %OR NEXT=NL
      %ROUTINE GET(%INTEGER %NAME K)
        K=0 %AND %RETURN %UNLESS 'A'<=NEXT&LETMASK<='Z'
        K=NEXT&31;  SKIP
      %END;                             !GET
      %ROUTINE GETTRIO(%INTEGER %NAME T)
      %INTEGER A,B,C
        GET(A);  GET(B);  GET(C)
        T=(A<<5+B)<<5+C
      %END;                             !GET TRIO
      %ROUTINE READNAME(%INTEGER %NAME ORDINAL)
      %INTEGER N1,N2
      %CONST %INTEGER %ARRAY NAME1(1:32)=  %C
3120, 5731, 3120, 21956, 0, 21956,
14739, 19681, 16609, 9668, 20976, 2548, 12454,
16423, 12590, 19849, 9686, 3120, 21956, 3120, 21956, 9686,
1635, 10931, 13362, 20097, 6446, 16423, 9454, 0,
0, 20514
      %CONST %INTEGER %ARRAY NAME2(1:32)=  %C
19712, 1541, 0, 0, 0, 19712,
0, 16384, 16384, 5588, 0, 20973, 20480,
5120, 5120, 14496, 5716, 15360, 15360, 19727, 19727, 15360,
9504, 20480, 11264, 19072, 9832, 5583, 15941, 0,
0, 0
        SKIP %WHILE NEXT=' '
        GETTRIO(N1);  GETTRIO(N2)
        FAULT(1) %AND ORDINAL=0 %AND %RETURN %IF N1=0
        %CYCLE ORDINAL=1,1,NAMEMAX
          %RETURN %IF NAME1(ORDINAL)=N1 %AND NAME2(ORDINAL)=N2
        %REPEAT
        FAULT(3);  ORDINAL=0
      %END;                             !READ NAME
      %INTEGER %MAP MAP(%INTEGER I)
      %SWITCH S(0:30)
        %RESULT ==TAB(I-31) %IF I>=32
        ->S(I)
S(0):   %RESULT ==NUM
S(1):   %RESULT ==CAPSH
S(2):   %RESULT ==ESCAPE
S(3):   %RESULT ==CAP
S(4):   %RESULT ==UND
S(6):   %RESULT ==UNDSH
S(7):   %RESULT ==NLS
S(8):   %RESULT ==SGAP
S(9):   %RESULT ==PGAP
S(10):  %RESULT ==INDENT
S(11):  %RESULT ==TOP
S(12):  %RESULT ==BOTTOM
S(13):  %RESULT ==LEFT
S(14):  %RESULT ==PAGE
S(15):  %RESULT ==LINE
S(16):  %RESULT ==SLINE
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 ==PAGENO
S(29):  %RESULT ==IGNORE
      %END;                             !MAP
    %END;                               !ASSIGN
  %END;                                 !PROCESS DIRECTIVE
  SELECTINPUT(SIN)
  SETMARGINS(SIN,1,160)
  SELECTOUTPUT(SOUT)
  SETMARGINS(SOUT,1,132)
  %CYCLE FREELIST=1,1,57
    LINK(FREELIST)=0
  %REPEAT
  %CYCLE FREELIST=1,1,500
    HEAD(FREELIST)=FREELIST-1
  %REPEAT
  %WHILE PAGES<FINISH %CYCLE
    READATOMORDIRECTIVE
    %IF DIRECTIVE#0 %START
      PROCESSDIRECTIVE
    %FINISH %ELSE %START
      %IF SIZE#0 %START
        PLACEATOM
        STORESOURCEATOM
        NEXT=0 %IF NEXT=NL %AND XLINES=0
      %FINISH
      %IF XLINES#0 %START
        %IF NEXT=' ' %START
          STORE(NEXT)
          COLS=COLS+1;  BUFF(COLS)=' '
        %FINISH
        PRINTDOCLINE %IF NEXT=NL
      %FINISH
    %FINISH
    PRINTSOURCELINE %IF NEXT=NL
    NEXT=0 %IF NEXT=' ' %OR NEXT=NL
  %REPEAT
  PRINTDOCLINE
%END
%END %OF %FILE