%BEGIN
!*  DOCUMENT LAYOUT PROGRAM -- Version 1
!* SYMBOLIC CONSTANTS
%CONST %INTEGER SIN=1,LSIN=3;                 !SOURCE INPUT STREAM
%CONST %INTEGER ERR=0,DOC=1,SOUT=2,DIA=3;   !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 SUPBIT=2048,SUBBIT=1024
%CONST %INTEGER CHARMASK=255,BASICMASK=127,LETMASK=95
%CONST %INTEGER SENTSP=544;             !512+' '
%CONST %INTEGER JUSTBIT = 16_8000
                                        !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=9999
%OWN %INTEGER CAP='@',UND='_',CAPSH='.',UNDSH='%'
%own %integer SUB=0,SUP=0,INVERT=32
%OWN %INTEGER CAPO='@',UNDO='_',CAPSHO='.',UNDSHO='%'
%own %integer SUBO=0,SUPO=0,INVERTO=32
%OWN %INTEGER ASCII=1,JUST=0,MARK=0,ESCAPE='$'
%OWN %INTEGER IGNORE=0, SECTNO=0
%OWNINTEGER DLPI=6, DCPI=10, DPAGE=1700
%OWNINTEGER DLEFT=150, DTOP=250, DHOLD=1
%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
%OWNINTEGER DBUFFP=0
%OWN %INTEGER INDENTIND=1,ERRIND=0,XPAGE=1
%OWN %INTEGER COLS=0;                   !COLUMNS USED ON CURRENT LINE
%OWNINTEGER LHM=1
%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
!*dia %INTEGERARRAY DBUFF(1:LBOUND);          !DIABLO BUFFER
%INTEGER %ARRAY BUFF(1:LBOUND);         !LINE BUFFER
%INTEGER %ARRAY ABUFF(1:ABOUND);        !ATOM BUFFER
%INTEGER %ARRAY SBUFF(1:SBOUND);        ! SOURCE LINE (UPDATED)
%INTEGER %ARRAY TYPE(0:127);            ! FOR SYMBOL INPUT.
%INTEGER %ARRAY LINK(1:65),HEAD,TAIL(1:500)
   %routine setup files
   %string(255)s,i,o,f,a
     %routine zap(%string(255)%name s)
     %integer i
     %bytename b
       %for i = 1,1,length(s) %cycle
         b == charno(s,i)
         b = b!32 %if 'A'<=b<='Z'
       %repeat
     %end
     %onevent 3,4,9 %start
       selectoutput(err); printstring(event_message)
       newline; %stop
     %finish
     s = cliparam; zap(s)
     %if s -> f.(",").a %start
       selectoutput(err); printstring("I can't cope with commas")
       newline; %stop
     %finish
     i = s %and o = "" %unless s -> i.("/").o
     f = i
     i = i.".lay" %unless i -> f.(".").a
     o = f %if o=""
     o = o.".lis" %unless o -> f.(".").a
     %if i=o %start
       selectoutput(err); printstring("That would overwrite ".i)
       newline; %stop
     %finish
     openinput(sin,i)
     openoutput(doc,o)
   %end; setup files
   %ROUTINE READCH(%INTEGERNAME CH)
      %OWNINTEGER STREAM = 1, E = 0
       %on 9 %start; ! End of input
           -> EOF
       %finish
RETRY:
      READSYMBOL(CH)
      %RETURN
EOF:
      %IF STREAM#LSIN %START
         STREAM = STREAM+1; SELECTINPUT(STREAM)
      %finish %else %start
         E = NL %IF E='E'
         E = 'E' %IF E=ESCAPE
         E = ESCAPE %IF E=0
         CH = E; %RETURN
      %FINISH
   -> RETRY
   %END
  %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,B,P,ATOMCAPIND,ATOMUNDIND
  %INTEGER STATOM
  %SWITCH SW(0:10)
    %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;  STATOM=0
    U=ATOMUNDIND;  C=ATOMCAPIND;  B=0;  P=0
    %CYCLE
      ->SW(TYPE(K&BASICMASK)&15)
SW(1):                                  ! CAPSH.  RECOGNISED AT START OF ATOM O


      ->TOBUFF %UNLESS STATOM=0;  STATOM=1
      ATOMCAPIND=CASEBIT;  C=CASEBIT
      ->LOOP
SW(2):                                  ! ESCAPE
      READCH(K);  K=K+ESCBIT
      ->TOBUFF %UNLESS 'A'<=K&LETMASK<='Z'
      %EXIT %IF SIZE#0
      DIRECTIVE=K&LETMASK
      READCH(NEXT)
      %RETURN
SW(3):                                  ! CAP
      C=CASEBIT;  STATOM=1
      ->LOOP
SW(4):                                  ! UND
      U=UNDBIT;  STATOM=1
      READCH(K);  ->TOBUFF %IF K&BASICMASK=' '
      ->SW(TYPE(K&BASICMASK)&15)
SW(6):                                  ! UNDSH
      STATOM=1
      ATOMUNDIND=UNDBIT
      U=UNDBIT
      ->LOOP
SW(9):                                  ! SUB
      STATOM=1
      B=SUBBIT
      ->LOOP
SW(10):                                 ! SUP
      STATOM=1
      P=SUPBIT
      ->LOOP
SW(7):                                  ! SPACE OR NEWLINE
      %EXIT %IF K=NL %OR K!LINEUNDIND=' ';  ->TOBUFF
SW(8):                                  ! LETTERS
      K=K!!INVERT
      K=K-C %IF 'a'<=K&BASICMASK<='z'
!* NOTE THAT HERE 'a' AND 'z' ARE LOWER CASE.
SW(0):                                  ! EVERYTHING ELSE
TOBUFF:
      STATOM=1;  SIZE=SIZE+1;  ABUFF(SIZE)=K!U!B!P
      U=ATOMUNDIND;  C=ATOMCAPIND;  B=0;  P=0
LOOP: 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 printsymbol(SBUFF(I)) %WHILE I#SMAX
      NEWLINE
      ERRIND=0
    %FINISH
    SMAX=0 %AND %RETURN %IF SOUT=0
    SELECTOUTPUT(SOUT)
    I=0
    I=I+1 %AND printsymbol(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
      %for I=1,1,SIZE %cycle
        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
    %for I=1,1,SIZE %cycle
      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(SUBO) %IF K&SUBBIT#0
      STORE(SUPO) %IF K&SUPBIT#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
        LHM = COLS+1 %IF COLS<LHM
      %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
      PRINTSYMBOL(12)
    %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
   LHM = 1
    TEXTCOLS=0;  COLS=0;  FIXED=0;  XPAGE=0
    SETCOLUMN(INDENTCOL) %IF INDENTIND#0
  %END
  %ROUTINE PRINTLPLINE
  %CONST %INTEGER CR=13
  %INTEGER I,J,K,L,M,U,V
    LINES=LINES+NLS
    %IF PAGES+1>=START %START
      SELECTOUTPUT(DOC)
      %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
        %for I=1,1,COLS %cycle
          K=BUFF(I)
          %IF K&U#0 %START
            M=I
            %for J=I,1,COLS %cycle
              %IF BUFF(J)&UNDBIT#0 %START
                SPACES(J-M)
                PRINTSYMBOL('_')
                M=J+1
              %FINISH
            %REPEAT
            printsymbol(CR);  printsymbol(CR)
            SPACES(L+I-1);  U=0
          %FINISH
          printsymbol(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)
         %IF SECTNO#0 %START
            WRITE(SECTNO,1); WRITE(-PAGENO,1)
         %FINISHELSE 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
!*dia   %ROUTINE PRINTDIABLOLINE
!*dia     %INTEGER LI,L,K,I,J,DIR,P,PLAST
!*dia     %OWNINTEGER VDIFF=0, HDIFF=0, VPOS=0, HPOS=0, OLDCOL=0, SHIFT=0
!*dia    %CONSTINTEGER HOLD = 240; ! 128+64+48
!*dia    %CONSTINTEGER MLEFT= 212; ! 128+64+16+4
!*dia    %CONSTINTEGER MRIGHT=208; ! 128+64+16
!*dia    %CONSTINTEGER DOWN= 224; ! 128+64+32
!*dia    %CONSTINTEGER UP= 228; ! 128+64+32+4
!*dia    %ROUTINE MOVE
!*dia       %INTEGER DIR
!*dia       %IF HDIFF#0 %START
!*dia          HPOS = HPOS+HDIFF
!*dia          DIR = MRIGHT
!*dia          DIR = MLEFT %AND HDIFF = -HDIFF %IF HDIFF<0
!*dia          DIR = DIR+(HDIFF&1)<<3; HDIFF = HDIFF>>1
!*dia          printsymbol(DIR+HDIFF>>8); printsymbol(HDIFF&255)
!*dia          HDIFF = 0
!*dia       %FINISH
!*dia       %IF VDIFF#0 %START
!*dia          VPOS = VPOS+VDIFF
!*dia          DIR = DOWN
!*dia          DIR = UP %AND VDIFF=-VDIFF %IF VDIFF<0
!*dia          printsymbol(DIR+VDIFF>>8); printsymbol(VDIFF&255)
!*dia          VDIFF = 0
!*dia       %FINISH
!*dia    %END
!*dia !   %ROUTINE DRESET
!*dia !      printsymbol(MRIGHT); printsymbol(0)
!*dia !      printsymbol(DOWN); printsymbol(0)
!*dia !   %END
!*dia    %ROUTINE DSPACES(%INTEGER N)
!*dia       HDIFF = HDIFF+(120//DCPI)*N
!*dia    %END
!*dia    %ROUTINE DNEWLINES(%INTEGER N)
!*dia       VDIFF = VDIFF+N*(48//DLPI)
!*dia    %END
!*dia    %ROUTINE DCR
!*dia       HDIFF = -HPOS
!*dia    %END
!*dia    %ROUTINE DNEWPAGE
!*dia       HDIFF = -HPOS
!*dia       VDIFF = (DPAGE*12)//25-VPOS
!*dia       VDIFF = 0 %IF VDIFF<0
!*dia       MOVE
!*dia       VPOS = 0
!*dia       printsymbol(HOLD) %IF PAGES#FINISH %AND DHOLD#0
!*dia    %END
!*dia    %ROUTINE DINCSP(%INTEGER N)
!*dia       HDIFF = HDIFF+N
!*dia       HDIFF = HDIFF-N-N %IF DIR<0
!*dia    %END
!*dia    %ROUTINE Dprintsymbol(%INTEGER C)
!*dia       %IF DIR<0 %THEN HDIFF = HDIFF-120//DCPI
!*dia       %IF C#' ' %START
!*dia          VDIFF=VDIFF+3 %AND SHIFT=SHIFT-1 %WHILE C&SUBBIT#0 %AND SHIFT>-1
!*dia          VDIFF=VDIFF-3 %AND SHIFT=SHIFT+1 %WHILE C&SUPBIT#0 %AND SHIFT<1
!*dia          VDIFF=VDIFF+3*SHIFT %AND SHIFT=0 %IF C&(SUBBIT!SUPBIT)=0#SHIFT
!*dia          MOVE; printsymbol('_') %IF C&UNDBIT#0
!*dia          C = C&127
!*dia          printsymbol(C) %IF C#' '
!*dia       %FINISH
!*dia       %IF DIR>0 %THEN HDIFF = HDIFF+120//DCPI
!*dia    %END
!*dia    %ROUTINE DWRITE(%INTEGER N)
!*dia       %INTEGER M
!*dia       M = N//10; N = N-M*10
!*dia       DWRITE(M) %IF M#0; Dprintsymbol('0'+N)
!*dia    %END
!*dia 
!*dia    LI = LINES+NLS; DIR = 1
!*dia    %IF PAGES+1>=START %START
!*dia       SELECTOUTPUT(DIA)
!*dia       %IF LI=NLS %START
!*dia          DNEWPAGE %IF PAGES#0
!*dia !         DRESET
!*dia          OLDCOL = 0
!*dia          VDIFF = (DTOP*48)//100
!*dia          DNEWLINES(TOP)
!*dia       %FINISH
!*dia       %IF TEXTCOLS#0 %START
!*dia          DCR; HDIFF = HDIFF+(DLEFT*12)//10
!*dia          L = LEFT
!*dia          %IF LINEMIDIND#0 %START
!*dia             L = LINE-COLS
!*dia             DINCSP(60//DCPI) %IF L&1#0
!*dia             L = LEFT+L//2
!*dia          %FINISH
!*dia          DSPACES(L)
!*dia          %IF LHM-OLDCOL>OLDCOL-COLS %START
!*dia             DIR = 1; P = LHM; PLAST = DBUFFP+1
!*dia             DSPACES(LHM-1)
!*dia             %IF PLAST=1 %THEN PLAST = COLS+1
!*dia          %finish %else %start
!*dia             DIR = -1; P = DBUFFP; PLAST = LHM-1
!*dia             %IF P=0 %THEN P = COLS %AND DSPACES(P) %C
!*dia             %ELSE DSPACES(LINE)
!*dia          %FINISH
!*dia          %WHILE P#PLAST %CYCLE
!*dia             %IF DBUFFP=0 %THEN K = BUFF(P) %ELSE K = DBUFF(P)
!*dia             OLDCOL = P
!*dia             P = P+DIR
!*dia             %IF K&JUSTBIT#0 %THEN DINCSP(K-JUSTBIT) %C
!*dia             %ELSE Dprintsymbol(K&3583);    ! SUPBIT, SUBBIT, UNDBIT & CHAR
!*dia          %REPEAT
!*dia       %FINISH
!*dia       DNEWLINES(NLS)
!*dia       DIR = 1
!*dia       %IF LI>=PAGE %AND BOTTOM#0 %START
!*dia          %IF PAGENO#0 %START
!*dia             DNEWLINES(BOTTOM//2); DCR; HDIFF = HDIFF+(DLEFT*12)//10
!*dia             I = 1; I = 2 %IF PAGENO>=10
!*dia             I = 3 %IF PAGENO>=100; I = 4 %IF PAGENO>=1000
!*dia             I = I+2 %IF SECTNO#0; I = I+1 %IF SECTNO>=10
!*dia             DSPACES(LEFT); DSPACES((LINE-I)//2)
!*dia             DINCSP(60//DCPI) %IF I&1#0
!*dia             %IF SECTNO#0 %START
!*dia                DWRITE(SECTNO); Dprintsymbol('-')
!*dia             %FINISH
!*dia             DWRITE(PAGENO)
!*dia          %FINISH
!*dia       %FINISH
!*dia    %FINISH
!*dia    DBUFFP = 0
!*dia %END
  %ROUTINE PRINTDOCLINE
!*dia      PRINT DIABLO LINE
     PRINT LP LINE
  %END
  %ROUTINE JUSTIFY
  %OWN %INTEGER FLIP=0
  %INTEGER I,J,K,L,MIN,COUNT,SCOUNT,AWAIT,SWAIT,AGAPS
  %INTEGER DX1,DX2,DX3
    COUNT=LINE-COLS
    %RETURN %IF COUNT<=0 %OR GAPS=0
!*dia ! JUSTIFY FOR DIABLO
!*dia     SCOUNT = COUNT*(120//DCPI);        !EXTRA SIXTIETHS
!*dia     DX1 = SCOUNT//GAPS;               !EXTRA PER GAP
!*dia     DX2 = SCOUNT-DX1*GAPS;            !REMAINDER
!*dia     DX3 = 0
!*dia     %IF DX2>SGAPS %START;             !CANT FIT REST IN SGAPS
!*dia        DX3 = DX2-SGAPS; DX2 = SGAPS
!*dia     %FINISH
!*dia     AGAPS = GAPS
!*dia     %for I = COLS,-1,1 %cycle
!*dia        K = BUFF(I)
!*dia        %IF AGAPS>0 %START
!*dia           %IF K=SENTSP %OR K=' ' %START
!*dia              AGAPS = AGAPS-1
!*dia              J = JUSTBIT+DX1+120//DCPI
!*dia              %IF K=SENTSP %AND DX2>0 %START
!*dia                 DX2 = DX2-1; J = J+1
!*dia              %FINISH
!*dia              %IF DX3>0 %START
!*dia                 DX3 = DX3-1; J = J+1
!*dia              %FINISH
!*dia              K = J
!*dia           %FINISH
!*dia        %FINISH
!*dia        DBUFF(I) = K
!*dia     %REPEAT
!*dia     DBUFFP = COLS
    AGAPS=GAPS-SGAPS;                   ! ATOM GAPS
    MIN=COUNT//GAPS;                    ! MIN NO OF SPACES TO BE ADDED TO EVERY


    COUNT=COUNT-MIN*GAPS;               ! SPACES TO BE ADDED AS WELL AS MIN AT 


!* 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 GA


    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.
    %for I=COLS,-1,1 %cycle
      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,F
  %SWITCH S('A':'Z')
  %ROUTINESPEC 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
RETRY:
    %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' %C
      %AND 'H'#DIRECTIVE#'R' %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
    LHM=1 %AND COLS=0 %AND FIXED=0 %IF INDENTIND=0
    %RETURN
S('N'):                                 !NEWPAGE
S('S'):
    %RETURN %IF PAGE>=999
    PRINTDOCLINE %WHILE LINES#0
    XPAGE=1
    %IF DIRECTIVE='S' %AND SECTNO#0 %START
      SECTNO = SECTNO+1; PAGENO=1
    %FINISH
    %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('H'):S('R'):
      %RETURN %IF DIRECTIVE='H' %AND NUM=0
      F = DIRECTIVE
      NEXT = 0 %IF NEXT=' '
      READATOMORDIRECTIVE
      %IF DIRECTIVE#0 %START
         !DIRECTIVE FOLLOWS INSTEAD OF ATOM
         FAULT(6)
         -> RETRY
      %FINISH
      DIRECTIVE = F
      FAULT(6) %IF SIZE=0
      %RETURN
S('D'):
S('F'):
S('G'):
S('K'):
S('M'):
S('O'):
S('Q'):
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=45
    %INTEGER I,J,K
    %ROUTINESPEC READNAME(%INTEGER %NAME ORDINAL)
    %INTEGER %MAPSPEC 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
            %IF (1<=J<=6 %OR 41<=J<=42) %AND TYPE(MAP(J))&15=(J&15) %START
              K=MAP(J)
              %CYCLE
                TYPE(K)=TYPE(K)>>4
                %EXIT %IF TYPE(K)=0 %OR MAP(TYPE(K)&15)=K
              %REPEAT
            %FINISH
            MAP(J)=HEAD(LINK(J))
            TYPE(MAP(J))=TYPE(MAP(J))<<4!(J&15) %IF 1<=J<=6 %OR 41<=J<=42
            POP(LINK(J))
          %FINISH
          J=J+1
          %EXIT %IF J<NAMEMAX %OR J>=65
        %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
        %IF (1<=I<=6 %OR 41<=I<=42) %AND TYPE(MAP(I))&15=(I&15) %START
          K=MAP(I)
!* MAP(I) IS CURRENTLY ACTIVE, I.E. ITS ENTRY IN TYPE REFERS TO IT.
          %CYCLE
            TYPE(K)=TYPE(K)>>4
            %EXIT %IF TYPE(K)=0 %OR MAP(TYPE(K)&15)=K
          %REPEAT
        %FINISH
        %CYCLE
          MAP(I)=MAP(J);                ! N.B. MAP(0)==NUM.
          TYPE(MAP(I))=TYPE(MAP(I))<<4!(I&15) %IF 1<=I<=6 %OR 41<=I<=42
          I=I+1;  J=J+1
          %EXIT %IF J<NAMEMAX
          %EXIT %IF I<NAMEMAX %OR I=65
        %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
      %OWN %INTEGER %ARRAY NAME1(1:NAMEMAX)=  %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, 19619,
4496, 4208, 4485, 4609, 4751, 0, 0, 0, 4367, 0,
20130, 20144, 20130, 20144,
20514;                                         ! **** TAB ****
      %OWN %INTEGER %ARRAY NAME2(1:NAMEMAX)=  %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, 20943,
9216, 9216, 6784, 7328, 16384, 0, 0, 0, 12416, 0,
0, 0, 15360, 15360, 0

        SKIP %WHILE NEXT=' '
        GETTRIO(N1);  GETTRIO(N2)
        FAULT(1) %AND ORDINAL=0 %AND %RETURN %IF N1=0
        %for ORDINAL=1,1,NAMEMAX %cycle
          %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:NAMEMAX)
        %RESULT ==TAB(I-NAMEMAX+1) %IF I>=NAMEMAX
        ->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
S(30):  %RESULT ==SECTNO
S(31):  %RESULT == DLPI
S(32):  %RESULT == DCPI
S(33):  %RESULT == DLEFT
S(34):  %RESULT == DPAGE
S(35):  %RESULT == DTOP
S(39):  %RESULT == DHOLD
S(41):  %RESULT == SUB;          ! 41&15=9
S(42):  %RESULT == SUP;          ! 42&15=10
S(43):  %RESULT == SUBO
S(44):  %RESULT == SUPO
      %END;                             !MAP
    %END;                               !ASSIGN
  %END;                                 !PROCESS DIRECTIVE
  %for NUM=0,1,127 %cycle;  TYPE(NUM)=0
  %REPEAT
  %for NUM='A',1,'Z' %cycle;  TYPE(NUM)=8
  %REPEAT
  %for NUM='A'!32,1,'Z'!32 %cycle;  TYPE(NUM)=8
  %REPEAT
  TYPE(CAPSH)=1;  TYPE(ESCAPE)=2;  TYPE(CAP)=3
  TYPE(UND)=4;  TYPE(UNDSH)=6
  TYPE(' ')=7;  TYPE(NL)=7
 TYPE(SUB)=9;  TYPE(SUP)=10
  SELECTINPUT(SIN)
  SELECTOUTPUT(SOUT)
  %for FREELIST=1,1,65 %cycle
    LINK(FREELIST)=0
  %REPEAT
  %for FREELIST=1,1,500 %cycle
    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
!*dia   PRINTDIABLOLINE
%ENDOFPROGRAM
