BEGIN; !DOCUMENT LAYOUT PROGRAM
!SYMBOLIC CONSTANTS
OWNINTEGER HALF=1
OWNINTEGER LINEEXP=0
OWNINTEGER EXPIND=0
OWNINTEGER EXPBIT=1024
OWNINTEGER EXPSH=0
OWNINTEGER LINESUB=0
OWNINTEGER SUBIND=0
OWNINTEGER SUBBIT=2048
OWNINTEGER SUBSHB=0
OWNINTEGER SUBSHE=0
! PARA HACER LO DE LAS FIGURAS
OWNINTEGER FIGURA=0
OWNINTEGER SIN=1; !SOURCE INPUT STREAM
OWNINTEGER ERR=0, DOC=2, SOUT=3; !OUTPUT STREAMS
OWNINTEGER LBOUND=200; !LINE BUFF BOUND
OWNINTEGER ABOUND=200; !ATOM BUFF BOUND
OWNINTEGER SBOUND=200; !SOURCE LINE BUFF BOUND
OWNINTEGER VBOUND=25; !VECTOR (EG TAB) BOUND
OWNINTEGER ESCBIT=256, UNDBIT=128, CASEBIT=32
OWNINTEGER CHARMASK=255, BASICMASK=127, LETMASK=95
OWNINTEGER SENTSP=544; !512+' '
!LAYOUT PARAMETERS
OWNINTEGER TOP=5, BOTTOM=9, LEFT=0, PAGE=57, LINE=69
OWNINTEGER SLINE=69, NLS=2, SGAP=2, PGAP=3
OWNINTEGER INDENT=0, SECTNO=0, PAGENO=1, START=1
OWNINTEGER ESCAPE='$', CAP='@', UND='_', CAPSH='.', UNDSH='%'
OWNINTEGER CAPO='@', UNDO='_', CAPSHO='.', UNDSHO='%'
OWNINTEGER INVERT=32, ASCII=1, JUST=1, MARK=1
OWNINTEGERARRAY TAB(0:25) = 1,7,13,19,25,31,37,43,49,55,61,
89,97,105,113,121,129,137,145,153,161,169,177,185,193,201
OWNINTEGERARRAY TEMPA(0:25) = 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
OWNINTEGERARRAY TEMPB(0:25) = 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
OWNINTEGER XLINES=0, LINECAPIND=0, LINEUNDIND=0, LINEMIDIND=0
OWNINTEGER INDENTIND=1, TEXTIND=0, ERRIND=0, ENDIND=0
OWNINTEGER COLS=0; !COLUMNS USED ON CURRENT LINE
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
INTEGER NEXT,DIRECTIVE,RELIND
INTEGERARRAY HBUFF(1:LBOUND) ; !HELP (SUB & SUP) BUFF
INTEGERARRAY BUFF(1:LBOUND); !LINE BUFFER
INTEGERARRAY ABUFF(1:ABOUND); !ATOM BUFFER
INTEGERARRAY SBUFF(1:SBOUND); !SOURCE LINE (UPDATED)
ROUTINE FAULT(INTEGER N)
SWITCH S(1:9)
SELECT OUTPUT(ERR)
PRINT SYMBOL('*')
->S(N)
S(1): PRINTTEXT 'FAULTY FORMAT AT '
PRINT CH(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 CH(DIRECTIVE)
PRINT CH(RELIND) IF RELIND # 0
9: ERRIND = 1
NEWLINE
END
!!!!!!!!!!!!
INTEGERARRAY INBUFF(1:200) ; ! INPUT BUFFER
OWNINTEGER INP=0
OWNINTEGER INMAX=0
ROUTINE CONSTRUCT
INTEGER K
INMAX=0
UNTIL K=NL CYCLE
READ CH(K)
INMAX=INMAX+1
INBUFF(INMAX)=K
REPEAT
END ; !* ----=============
ROUTINE READONE(INTEGERNAME K)
INP=INP+1
IF INP>INMAX THEN INP=1 AND CONSTRUCT
K=INBUFF(INP)
END ; !*-------------------------------
!!!!!!!!!!!!!
ROUTINE READ ATOM OR DIRECTIVE
INTEGER K,C,U,ATOMCAPIND,ATOMUNDIND
INTEGER PARTEXPIND,PARTSUBIND
IF NEXT = 0 THEN READ ONE(K) ELSE K=NEXT AND NEXT=0
PARTEXPIND=0 ; PARTSUBIND=0
DIRECTIVE = 0; SIZE = 0
ATOMCAPIND = 0; ATOMUNDIND = 0
ATOMCAPIND = CASEBIT AND READ ONE(K) IF K = CAPSH
CYCLE
ATOMUNDIND=UNDBIT AND READ ONE(K) IF K = UNDSH
U=LINEUNDIND
!!!!!!!
!!! %IF K=EXPSH %THEN %START
!!! PARTEXPIND=PARTEXPIND!!EXPBIT
!!! READ ONE(K)
!!! EXPIND=EXPIND!1
!!! %IF PARTSUBIND#0 %THEN %START
!!! %PRINTTEXT '** EXP AND SUB **'
!!! NEWLINE
!!! %FINISH
!!! %FINISH
!!! %IF K=SUBSHB %THEN %START
!!! %IF PARTEXPIND#0 %THEN %START
!!! %PRINTTEXT'** SUB AND EXP'
!!! NEWLINE
!!! %FINISH
!!! PARTSUBIND=SUBBIT
!!! READ ONE(K)
!!! SUBIND=1
!!! %FINISH
!!! %IF K=SUBSHE %THEN PARTSUBIND=0 %AND READ ONE(K)
!!!!
C = LINECAPIND!ATOMCAPIND
U=U!UNDBIT AND READ ONE(K) IF K=UND
U=U!PARTSUBIND
U=U!PARTEXPIND
U = U!ATOMUNDIND UNLESS K=' '
C=CASEBIT AND READ ONE(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
READ ONE(K) AND K=K+ESCBIT IF K=ESCAPE
K = K!U
EXIT IF K = ' '
IF K&ESCBIT # 0 AND 'A' <= K&LETMASK <= 'Z' START
EXIT IF SIZE # 0
DIRECTIVE = K&LETMASK; READ ONE(NEXT)
RETURN
FINISH
SIZE = SIZE+1; ABUFF(SIZE) = K
READ ONE(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 PRINTCH(SBUFF(I)) WHILE I # SMAX
NEWLINE
ERRIND = 0
FINISH
SELECT OUTPUT(SOUT)
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,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!!INVERT 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 COLS < M 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 PRINT DOC LINE
OWNINTEGER CR=13
INTEGER I,J,K,L,M,U
ROUTINE PRINTIT(INTEGERARRAYNAME BUFF)
END; !* ------------------------------------- PRINTIT
ROUTINE PUT SUP OR SUB(INTEGER MSK)
CYCLE I=1,1,COLS
K=BUFF(I)
IF K&MSK#0 THEN START
HBUFF(I)=K!!MSK
BUFF(I)=' '
FINISH ELSE HBUFF(I)=' '
REPEAT
END; !* ---------------------------- PUT SUP OR SUB
ROUTINE WAIT
SELECTINPUT(0)
READ CH(I)
SPACES(3) ; NEWLINE
PRINTCH(CR) ; PRINTCH(CR)
SELECTINPUT(SIN)
END; !* ------------------------------ WAIT
LINES = LINES+NLS
!!! %IF LINEEXP#0 %THEN HALF=HALF!!1 %AND LINES=LINES+HALF
!!! %IF LINESUB#0 %THEN HALF=HALF!!1 %AND LINES=LINES+HALF
IF PAGES+1 >= START START
SELECT OUTPUT(DOC)
IF LINES = NLS START
IF MARK # 0 START
IF MARK=1 THEN START
PRINT SYMBOL('='); SPACES(LINE-2); PRINT SYMBOL('=')
FINISH ELSE START
PRINTCH(12) ;! FORM FEED
FINISH
NEWLINE
FINISH
NEWLINES(TOP)
FINISH
IF TEXTIND # 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 CH(CR); PRINT CH(CR)
SPACES(L+I-1); U = 0
FINISH
PRINT CH(K&BASICMASK)
REPEAT
!
!
!!! %IF LINEEXP#0 %THEN %START
!!! PUT SUP OR SUB(EXPBIT)
!!! !LEFT=LEFT-1
!!! PRINTIT(HBUFF)
!!! WAIT
!!! !LEFT=LEFT+1
!!! %FINISH
!!! %IF LINESUB#0 %THEN %START
!!! PUT SUP OR SUB(SUBBIT)
!!! !LEFT=LEFT-1
!!! PRINTIT(BUFF)
!!! WAIT
!!! !LEFT=LEFT+1
!!! PRINTIT(HBUFF)
!!! %FINISH %ELSE PRINTIT(BUFF)
FINISH
NEWLINES(NLS)
IF LINES >= PAGE START
IF PAGENO = 0 START
NEWLINES(BOTTOM)
FINISH ELSE START
NEWLINES(2)
SPACES(LEFT+LINE//2-4); WRITE(PAGENO,1)
NEWLINES((BOTTOM-2))
FINISH
FINISH
FINISH
LINEEXP=0
LINESUB=0
IF LINES >= PAGE START
LINES = 0; PAGES = PAGES+1
PAGENO = PAGENO+1 IF PAGENO # 0
!LO DE LA FIGURA
IF FIGURA=1 THEN FIGURA=0 AND PAGENO=PAGENO+1
!SE ACABO
FINISH
IF XLINES # 0 START
XLINES = XLINES-1
IF XLINES = 0 START
LINECAPIND = 0; LINEUNDIND = 0
LINEMIDIND = 0; INDENTIND = 1
FINISH
FINISH
TEXTIND = 0
COLS = 0; FIXED = 0
SET COLUMN(INDENTCOL) IF INDENTIND # 0
END
ROUTINE JUSTIFY
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
IF LINES&1 = 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) = '.' 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 ; ! L+SIZE IS > LINE PRINT
JUSTIFY IF JUST # 0
PRINT DOC LINE
PRINT SOURCE LINE IF SMAX # 0
FINISH
FINISH
I = 0
LINEEXP=LINEEXP!EXPIND
LINESUB=LINESUB!SUBIND
WHILE I # SIZE CYCLE
COLS = COLS+1; I = I+1
BUFF(COLS) = ABUFF(I)
REPEAT
EXPIND=0
SUBIND=0
TEXTIND = 1
END
ROUTINE PROCESS DIRECTIVE
INTEGER NUM,C,T
SWITCH S('A':'Z')
ROUTINESPEC ASSIGN
ROUTINE SKIP
SMAX = SMAX+1; SBUFF(SMAX) = NEXT
READ ONE(NEXT)
END
IF XLINES # 0 START
FAULT(6); XLINES = 1
PRINT DOC LINE
FINISH
IF TEXTIND # 0 AND 'C' # DIRECTIVE&LETMASK # 'T' START
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)
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 = '-'
->S(DIRECTIVE&LETMASK)
S('A'): !ASSIGN
CYCLE
ASSIGN
SKIP WHILE NEXT # ';' AND NEXT # NL
EXIT IF NEXT = NL
SKIP
REPEAT
FAULT(7) AND INDENT=0 UNLESS 0 <= INDENT <= VBOUND
INDENTCOL = TAB(INDENT)
SET COLUMN(INDENTCOL)
RETURN
S('B'): !BLANKS
NUM = PAGE-LINES IF PAGE-LINES < NUM
PRINT DOC LINE AND NUM=NUM-1 WHILE NUM > 0
RETURN
S('C'): !COL
NUM = COLS+1+NUM IF RELIND # 0
SET COLUMN(NUM)
RETURN
S('E'): !END
ENDIND = 1; NEXT = NL
PRINT DOC LINE WHILE LINES # 0
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('L'): !LINES
XLINES = NUM; 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
PRINT DOC LINE WHILE LINES # 0
RETURN
S('P'): !PARAGRAPH
IF LINES # 0 START
NUM = PAGE-LINES IF PAGE-LINES < NUM+2
PRINT DOC LINE AND NUM=NUM-1 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
! PARA HACER LO DE LA FIGURA
IF NUM=0 THEN FIGURA=1
! SE ACABO
IF PAGE-LINES < NUM START
PRINT DOC LINE WHILE LINES # 0
FINISH
RETURN
S('D'): S('F'): S('G'): S('H'): S('J'):
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
ROUTINE ASSIGN
OWNINTEGER SCALARMAX=30, PARMAX=34
INTEGER I,J,K
ROUTINESPEC READ VALUE(INTEGERNAME J)
ROUTINESPEC READ NAME(INTEGERNAME ORDINAL)
INTEGERMAPSPEC MAP(INTEGER I)
INTEGERMAPSPEC VMAP(INTEGER I,J)
READ NAME(I); RETURN IF I = 0
FAULT(1) AND RETURN IF NEXT # '='
SKIP UNTIL NEXT # ' '
IF I <= SCALARMAX START
IF 'A' <= NEXT&LETMASK <= 'Z' START
READ NAME(J); RETURN IF J = 0
FAULT(4) AND RETURN IF J > SCALARMAX
MAP(I) = MAP(J)
FINISH ELSE START
READ VALUE(J)
MAP(I) = J
FINISH
FINISH ELSE START
IF 'A' <= NEXT&LETMASK <= 'Z' START
READ NAME(J); RETURN IF J = 0
FAULT(4) AND RETURN IF J <= SCALARMAX
CYCLE K = 1,1,VBOUND
VMAP(I,K) = VMAP(J,K)
REPEAT
FINISH ELSE START
CYCLE K = 1,1,VBOUND
READ VALUE(J)
VMAP(I,K) = J
EXIT IF NEXT # ','
SKIP UNTIL NEXT # ' '
REPEAT
FINISH
FINISH
FAULT(1) UNLESS NEXT = ';' OR NEXT = NL
ROUTINE READ VALUE(INTEGERNAME V)
IF NEXT # '''' START
V = 0
V = 10*V-'0'+NEXT AND SKIP WHILE '0'<=NEXT<='9'
FINISH ELSE START
SKIP; !QUOTE-MARK
V = NEXT; SKIP; !QUOTED SYMBOL
SKIP; !QUOTE-MARK (PRESUMABLY)
FINISH
END; !READ VALUE
ROUTINE READ NAME(INTEGERNAME ORDINAL)
INTEGER N1,N2
OWNINTEGERARRAY NAME1(1:34) = 20976, 2548, 12454, 16423, 12590,
19849, 14739, 19681, 16609, 9668, 19619, 16423, 5731, 3120,
21956, 3120, 21956, 3120, 21956, 3120, 21956, 9686, 1635,
10931, 13362, 20097, 5904, 20130, 20130, 0,
16434, 20514, 20653, 20653
OWNINTEGERARRAY NAME2(1:34) = 0, 20973, 20480, 5120, 5120,
14496, 0, 16384, 16384, 5588, 20943, 5583, 1541, 0,
0, 19712, 19712, 15360, 15360, 19727, 19727, 5716, 9504,
20480, 11264, 19072, 19712, 19714, 19717, 0,
19456, 0, 16416, 16448
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
SKIP WHILE NEXT = ' '
GET TRIO(N1); GET TRIO(N2)
FAULT(1) AND ORDINAL=0 AND RETURN IF N1 = 0
CYCLE ORDINAL = 1,1,PARMAX
RETURN IF NAME1(ORDINAL) = N1 AND NAME2(ORDINAL) = N2
REPEAT
FAULT(3); ORDINAL = 0
END; !READ NAME
INTEGERMAP MAP(INTEGER I)
SWITCH S(1:30)
->S(I)
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 == ESCAPE
S(14): RESULT == CAP
S(15): RESULT == UND
S(16): RESULT == CAPSH
S(17): RESULT == UNDSH
S(18): RESULT == CAPO
S(19): RESULT == UNDO
S(20): RESULT == CAPSHO
S(21): RESULT == UNDSHO
S(22): RESULT == INVERT
S(23): RESULT == ASCII
S(24): RESULT == JUST
S(25): RESULT == MARK
S(26): RESULT == START
S(27): RESULT == EXPSH
S(28): RESULT == SUBSHB
S(29): RESULT == SUBSHE
END; !MAP
INTEGERMAP VMAP(INTEGER I,J)
SWITCH S(31:35)
->S(I)
S(31): RESULT == MAP(J)
S(32): RESULT == TAB(J)
S(33): RESULT == TEMPA(J)
S(34): RESULT == TEMPB(J)
END; !VMAP
END; !ASSIGN
END; !PROCESS DIRECTIVE
SELECT INPUT(SIN)
SELECT OUTPUT(SOUT)
NEXT=0
UNTIL ENDIND # 0 CYCLE
READ ATOM OR DIRECTIVE
IF DIRECTIVE # 0 START
PROCESS DIRECTIVE
PRINT SOURCE LINE IF NEXT = NL
FINISH ELSE START
IF XLINES = 0 START
IF SIZE # 0 START
PLACE ATOM
STORE SOURCE ATOM
FINISH ELSE START
PRINT SOURCE LINE IF NEXT = NL
FINISH
FINISH ELSE START
IF SIZE # 0 START
PLACE ATOM
STORE SOURCE ATOM
FINISH
IF NEXT = ' ' START
STORE(NEXT)
COLS = COLS+1; BUFF(COLS) = ' '
FINISH
IF NEXT = NL START
PRINT DOC LINE
PRINT SOURCE LINE
FINISH
FINISH
FINISH
NEXT = 0 IF NEXT = ' ' OR NEXT = NL
REPEAT
ENDOFPROGRAM