!!!!! 12/1/77
! HAMISH DEWAR'S LAYOUT PROGRAM MODIFIED FOR 7/32 IMP COMPILER
! AND TO IMPLEMENT SECTION NOS.
!%EXTERNALROUTINESPEC SET STREAMS {move to perms}
BEGIN; !LAYOUT: DOCUMENT LAYOUT PROGRAM
!SYMBOLIC CONSTANTS
CONSTINTEGER SIN=1, REQUEST=0; !SOURCE INPUT STREAMS
CONSTINTEGER ERR=0, DOC=1, SOUT=2; !OUTPUT STREAMS
CONSTINTEGER LBOUND=200; !LINE BUFF BOUND
CONSTINTEGER ABOUND=200; !ATOM BUFF BOUND
CONSTINTEGER SBOUND=200; !SOURCE LINE BUFF BOUND
CONSTINTEGER VBOUND=25; !VECTOR (EG TAB) BOUND
CONSTINTEGER ESCBIT=256, UNDBIT=128, CASEBIT=32
CONSTINTEGER CHARMASK=255, BASICMASK=127, LETMASK=95
CONSTINTEGER SENTSP=544; !512+' '
!LAYOUT PARAMETERS
OWNINTEGER CHOOSE = -1; ! NO USER REQUEST
OWNINTEGER NEW PAGE=0, NEW SECT = 0
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=0, FINISH=9999
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): PRINT STRING("FAULTY FORMAT AT ")
PRINT SYMBOL(NEXT)
->L9
S(3): PRINT STRING("UNKNOWN NAME"); ->L9
S(4): PRINT STRING("SCALAR/VECTOR MISMATCH"); ->L9
S(5): PRINT STRING("UNKNOWN DIRECTIVE "); ->L8
S(6): PRINT STRING("SPURIOUS DIRECTIVE "); ->L8
S(7): PRINT STRING("OUT OF BOUNDS "); ->L8
S(8): PRINT STRING("OFF PAGE "); ->L8
S(9): PRINT STRING("OVER TEXT ")
L8: PRINT SYMBOL(DIRECTIVE)
PRINT SYMBOL(RELIND) IF RELIND # 0
L9: ERRIND = 1
NEWLINE
END
ROUTINE READ ATOM OR DIRECTIVE
INTEGER K,C,U,ATOMCAPIND,ATOMUNDIND
IF NEXT = 0 THEN READ SYMBOL(K) ELSE K = NEXT AND NEXT = 0
DIRECTIVE = 0; SIZE = 0
ATOMCAPIND = 0; ATOMUNDIND = 0
ATOMCAPIND = CASEBIT AND READ SYMBOL(K) IF K = CAPSH
CYCLE
READ SYMBOL(K) AND K = K+ESCBIT IF K = ESCAPE
ATOMUNDIND = UNDBIT AND READ SYMBOL(K) IF K = UNDSH
C = LINECAPIND!ATOMCAPIND
U = LINEUNDIND
U = U!ATOMUNDIND UNLESS K = ' '
U = UNDBIT AND READ SYMBOL(K) IF K = UND
C = CASEBIT AND READ SYMBOL(K) IF K = CAP
TWIT: 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' C
OR K&LETMASK = NL) START
EXIT IF SIZE # 0
DIRECTIVE = K&LETMASK; READ SYMBOL(NEXT)
RETURN
FINISH
SIZE = SIZE+1; ABUFF(SIZE) = K
READ SYMBOL(K)
REPEAT
NEXT = K
RETURN IF ATOMUNDIND = 0 OR SIZE = 0
K = ABUFF(SIZE)!!UNDBIT
ABUFF(SIZE) = K IF K = '.' OR K = ',' OR K = ':' OR K = ';' OR K = ')'
END
ROUTINE PRINT SOURCE LINE
INTEGER I
IF ERRIND # 0 START
SELECT OUTPUT(ERR)
I = 0
I = I+1 AND PRINT SYMBOL(SBUFF(I)) WHILE I # SMAX
NEWLINE
ERRIND = 0
FINISH
SELECT OUTPUT(SOUT)
I = 0
I = I+1 AND PRINT SYMBOL(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,J,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
PRINT SYMBOL(12); !FORM FEED
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 TURN PAGE
ROUTINE GET
SELECTOUTPUT(0)
PRINTSTRING("SECTION:"); PRINTSYMBOL(4)
SELECTOUTPUT(DOC)
CYCLE
EXIT IF '0' <= NEXTSYMBOL <= '9'
SKIPSYMBOL
REPEAT
READ(NEW SECT)
NEW PAGE = 0
RETURN UNLESS NEXTSYMBOL = '-'
SKIPSYMBOL
RETURN UNLESS '0' <= NEXTSYMBOL <= '9'
READ(NEW PAGE)
END
RETURN IF CHOOSE < 0
IF START = 0 START
START = 9999
ELSE
IF START = 9999 START
START = START-1
SELECTINPUT(REQUEST)
CYCLE
GET
EXIT IF NEWSECT > SECTNO
EXIT IF NEWSECT=SECTNO AND (NEW PAGE=0 OR NEWPAGE>=PAGENO)
REPEAT
SELECTINPUT(SIN)
FINISH
FINISH
START=0 IF NEWSECT=SECTNO AND C
(NEWPAGE=0 OR NEWPAGE=PAGENO)
END
ROUTINE PRINT DOC LINE
OWNINTEGER CR = 13
INTEGER I,J,K,L,M,U
LINES = LINES+NLS
IF PAGES+1 >= START START
SELECT OUTPUT(DOC)
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
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 SYMBOL(CR); PRINT SYMBOL(CR)
SPACES(L+I-1); U = 0
FINISH
PRINT SYMBOL(K&BASICMASK)
REPEAT
FINISH
NEWLINES(NLS)
IF LINES >= PAGE AND BOTTOM # 0 START
IF PAGENO = 0 START
FINISH ELSE START
I = BOTTOM//2
NEWLINES(I)
SPACES(LEFT+LINE//2-7)
IF SECTNO = 0 START
SPACES(2); WRITE(PAGENO,1)
ELSE
WRITE(SECTNO,2); WRITE(-PAGENO,1)
FINISH
FINISH
FINISH
FINISH
IF LINES >= PAGE START
LINES = 0; PAGES = PAGES+1
PAGENO = PAGENO+1 IF PAGENO # 0
TURN PAGE
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 SYMBOL(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
IF D = NL START
STORE(' ') IF SMAX # 0; STORE(ESCAPE)
FINISH
JUSTIFY IF JUST # 0 AND D = 'J'
PRINT DOC LINE
PRINT SOURCE LINE IF SMAX # 0
FINISH
PRINT SOURCE LINE IF SMAX+5 > SLINE
RETURN IF D = NL
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
PAGE = 999 IF PAGE <= 0
INVERT = 32 IF INVERT # 0; INVERTO = 32 IF INVERTO # 0
FAULT(7) AND INDENT = 0 UNLESS 0 <= INDENT <= VBOUND
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 <= VBOUND
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('S'): !NEW SECTION
S('N'): !NEWPAGE
RETURN IF PAGE >= 999
PRINT DOC LINE WHILE LINES # 0
XPAGE = 1
IF D = 'S' AND SECTNO # 0 START
SECTNO = SECTNO + 1; PAGENO = 1
TURN PAGE
FINISH
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 > VBOUND OR TAB(T) > C
FAULT(7) AND RETURN IF T > VBOUND
C = TAB(T)
NUM = NUM-1
REPEAT
FINISH ELSE START
T = T+1 UNTIL T > VBOUND 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 <= VBOUND
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('U'): S('W'): S('X'): S('Y'): S('Z'):
FAULT(5)
RETURN
INTEGERFN NEWCELL(INTEGER H,T)
INTEGER P
STOP 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
OWNINTEGER 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 = '<' THEN LINK(J) = NEWCELL(MAP(J),LINK(J)) C
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 OR 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 READ NAME(INTEGERNAME ORDINAL)
INTEGER N1,N2
CONSTSHORTINTEGERARRAY 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
CONSTSHORTINTEGERARRAY 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
ROUTINE GET(INTEGERNAME K); ! ...USED BY 'GET TRIO'
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
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
SET STREAMS; !OPEN FILES
SELECTINPUT(REQUEST)
PRINTSTRING("Sections? (Y or CR) ")
IF NEXTSYMBOL='Y' OR NEXTSYMBOL='y' THEN CHOOSE=0 ELSE CHOOSE=-1
SKIPSYMBOL
TURN PAGE
SELECT INPUT(SIN)
SELECT OUTPUT(SOUT)
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
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
MARK DOC IF MARK # 0
ENDOFPROGRAM