BEGIN; !IMP15 COMPILER 30/10/78 resurrected Sept 2002
!OUTPUT STREAMS
CONSTINTEGER ERR=0, OBJ=1, MAP=2
!input streams
!constinteger prim=2, prog=1; !(tag limit reached)
!PRIMITIVE ROUTINE TAGS
CONSTINTEGER MONI=4; !MONITOR
CONSTINTEGER NST=5; !NEST
CONSTINTEGER LE=6; !TEST LESS-THAN OR EQUAL
CONSTINTEGER GE=7; !TEST GREATER-THAN OR EQUAL
CONSTINTEGER AR=8; !ARRAY REFERENCE
CONSTINTEGER ADEC=9; !ARRAY DECLARATION
CONSTINTEGER SH=10; !SHIFT
CONSTINTEGER ENT=16; !PROCEDURE ENTRY/EXIT
CONSTINTEGER FLT=17; !FAULT TRAP
CONSTINTEGER BAR=20; !BYTE ARRAY-REF
CONSTINTEGER BGET=21; !BYTE FETCH
CONSTINTEGER BPUT=22; !BYTE STORE
CONSTINTEGER ADR=28; !ADDR
CONSTINTEGER INT=29; !INTEGER
CONSTINTEGER PTXT=38; !PRINT TEXT
!DECLARATION CODES
CONSTINTEGER BEG=108; !BEGIN
CONSTINTEGER EXT=128, OWN=64, BODY=64
CONSTINTEGER REF=32, ARRAY=8, PROC=4
OWNINTEGER LINE=1; !LINE NUMBER
OWNINTEGER LINES=0; !LINE COUNT
OWNINTEGER ICOUNT=0; !INSTRUCTION COUNT
OWNINTEGER SYM=0; !CURRENT INPUT SYMBOL
OWNINTEGER SYMTYPE=0; !-2:LET, -1:DIG, 0:TERM
! 1:OTHER, 2:KEYLET
OWNINTEGER DECL=0; !DECLARATOR TYPE
OWNINTEGER SSTYPE=1; !STATEMENT TYPE
OWNINTEGER SECTION=0; !0:INSTR, 1:DATA
OWNINTEGER OWNC=0; !OWN COUNT
OWNINTEGER FAULTY=0; !FAULT INDICATOR
!CURRENT INPUT LINE
OWNINTEGER POS1=0; !START-OF-ATOM POSITION
OWNINTEGER POS=0; !CURRENT CHAR POSITION
INTEGERARRAY CHAR(1:73)
!NAME DICTIONARY
OWNINTEGER DMAX=0; !NAME DICT MAX
CONSTINTEGER DBOUND=500; !UPPER BOUND (CHANGED FROM 350)
INTEGERARRAY DICT(1:DBOUND)
!TAG INFO
OWNINTEGER GLOBAL=0; !ZERO OR ENDOFPRIM TAG
OWNINTEGER TMAX=0; !TAG MAX
INTEGER X; !CURRENT TAG (WHEN RELEVANT)
OWNINTEGER LMIN=253; !COMP LAB MIN
INTEGERNAME TT0,TTX; !==TAGTYPE(0),TAGTYPE(X)
INTEGERARRAY TAGTYPE,INDEX(0:223)
! SIGNIFICANCE OF TAGTYPE VALUES:
! VAL256+ VAL128 VAL64 VAL32 VAL0:15
! 0 0 SET 0 0 0 0 0 LABEL
! 0 EXT OWN REF 0 0 0 1 INTEGER (EXT+OWN=CONST)
! 0 0 OWN REF 0 0 1 0 BYTE
! GRAM AD SAFE/EXT BODY REF 0 1 0 0 PRED
! GRAM AD SAFE/EXT BODY REF 0 1 T T FN
! 0 0 0 0 0 1 1 1 STRING
! BOUNDS AD 0 1 0 1 0 0 0 SWITCH
! 0 0 OWN REF 1 0 T T ARRAY
! GRAM AD SAFE/EXT BODY REF 1 1 0 0 ROUTINE
! GRAM AD SAFE/EXT BODY REF 1 1 T T MAP
! 0 0 1 1 1 1 0 0 BEGIN
! NEVER STORED IN TAGTYPE
! 0 0 0 1 0 1 0 0 SPEC
!ANALYSIS RECORD
INTEGER SS; !START OF SS
CONSTINTEGER NODEBOUND=70
INTEGERARRAY REFCO,SUB(1:NODEBOUND)
!* GRAMMAR AND KEYDICT GENERATED BY TAKEON PROGRAM
OWNINTEGER GMAX1= 196
OWNINTEGER GMAX= 196
OWNINTEGERARRAY PHRASE(112:127) = C
194, 69, 72, 77, 81, 115, 125, 147,
153, 156, 159, 168, 173, 176, 188, 0
OWNINTEGERARRAY ATOMIC(80:111) = C
64, 70, 72, 77, 68, 69, 73, 67,
73, 73, 74, 77, 76, 77, 78, 78,
65, 65, 66, 66, 74, 78, 74, 12,
18, 15, 15, 65, 10, 15, 9, 42
OWNINTEGERARRAY INITIAL(1:79) = C
36225, 35842, 33923, 3332, 68741, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, -118767, 0, 0, 3604, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, -131041,
0, 0, -117854, -117981, 3876, -117595, -117722, 0,
2088, 4009, 0, 0, 0, 0, 33838, 33071,
0, 0, 1842, 1075, 1460, 3765, 0, 66615,
99384, 33849, 33850, 98363, 0, 0, 0, 0,
35664, -118944, -118429, 0, 0, 0, 0, 0,
35794, -118058, -118044, 0, -118196, -118061, -118043, 0
OWNINTEGERARRAY GRAM(0:255) = C
0, 756, -129612, -129999, 1140, -94156, -94155, -129132,
9, -126846, 4996, 1653, -128746, 1073, -131063, 33918,
-129978, 1095, -129999, 2676, -130640, 9, 10, 5134,
1137, 5329, 5745, 6129, 6526, 6517, 39367, 33913,
33909, 4465, -126452, 110, 37625, -126739, 110, 6726,
40441, 5376, -123378, 9, 38642, -127729, 9, 39027,
-127601, 9, 1074, 7825, 39667, -124020, 110, -123127,
7417, -123923, 110, 2832, 8070, 1088, 7040, 8262,
-122481, -123002, 1040, -122810, 8070, 9030, -122225, 0,
9358, 9594, 9610, 9850, 16, 9998, 10233, 10348,
9849, -118944, -118767, -118196, -118058, -118061, -131041, -117981,
-117854, -118429, -118044, -118043, -117722, 13477, -117492, 46494,
-131008, 46664, -117492, 46750, 46960, 47216, 32890, 32887,
46915, 32839, 46970, 79735, 65648, 79736, -116497, 0,
80231, 116, 112506, -115978, 15482, -82774, -82645, 0,
32768, 15862, 15222, -82774, 0, -114546, -114004, -113852,
16890, -121227, 17402, -112979, 32768, 118, 32880, 17424,
-112870, -112741, -112612, -112979, 32768, 51450, 50301, 50428,
50555, -117971, 0, -111775, -113832, 17243, -78819, 0,
65658, -111774, -113818, 17247, -117608, -117607, 32839, -110439,
-109800, 53629, -110438, -109669, -109796, 0, 53883, 53756,
54525, -109542, -109029, 0, 54652, 55165, -108902, 0,
-131007, -131001, -131006, -113847, -113851, -113843, -113846, -113842,
-121458, 23826, 24061, 104, 24299, 24332, 57338, 24681,
57594, 13162, 24974, 25210, 16, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0
OWNINTEGERARRAY KDICT(32: 425) = C
0, 387, 131, 403, 131, 131, 407, 131,
411, 415, 419, 431, 447, 451, 131, 475,
129, 129, 129, 129, 129, 129, 129, 129,
129, 129, 487, 490, 495, 523, 539, 131,
131, 556, 628, 656, 708, 752, 904, 128,
128, 972, 1152, 128, 1188, 1232, 1248, 1256,
1284, 128, 1348, 1440, 1552, 1604, 128, 1636,
1648, 128, 128, 131, 1695, 131, 131, 131,
-118367, -64814, 66268, 66204, 106541, 65947, 65550, 65552,
-117462, 66331, 66522, -116949, -65448, 65628, 66013, 65551,
-116051, -116162, -65384, 65692, 65553, 66077, -115665, 66459,
66395, 65546, 65545, -114500, -114627, -114754, 69677, 65818,
77869, 65818, -113987, -57332, 73773, 66142, -113347, -113474,
110637, 65882, 102445, -112188, 8782, -112349, -112470, -60760,
65578, 71336, 68265, -111039, -111676, 82, 70696, -111197,
-111318, 70056, 71080, 68009, 71592, -110395, 10841, 69,
65728, 9415, 78, 65591, -108534, -109361, 8665, 8908,
65586, -108851, 10702, 84, 77827, 8909, 10830, 65547,
65536, -107711, 9946, -107862, 69864, 70888, -107325, 68,
71528, -107094, 69736, 70760, -102452, -105010, 88, -105271,
84, -105659, 9426, 10702, 8649, 73731, 10066, 9793,
73728, 84, 66847, 68, -104625, 65592, 70, -102842,
80, -103099, 82, -103351, 9167, 8402, 77, 65595,
77, 65593, 9938, 65594, 9801, 69, 65595, 8915,
-65489, 65584, -100671, -101559, 10575, 65556, 9422, 9299,
-101051, 65582, 10700, 69, 65583, -100148, 9813, 84,
65572, 8915, 66719, -94266, -98738, -98993, 11603, -99158,
70248, 71272, 84, 70568, 8916, 8903, 82, -95295,
-96186, -97075, -97586, -65470, 65606, 9921, 69, -63422,
67654, 10305, -96557, -60603, 70470, 8912, 67, 66373,
78, -95661, -61115, 69958, 8912, 67, 65861, 10578,
11457, -94770, 66116, 9921, 69, -62910, 68166, 66356,
77, -93360, 83, -93526, 69800, 70824, -93142, 70440,
71464, -92607, 10825, 67817, -92221, 68, 71656, -91741,
-91862, 69928, 70952, 67881, 10063, 10825, 10575, 65573,
10831, 65580, -90160, -90286, 10071, 69635, 65579, 82,
70632, 82, -89019, 10057, 10836, 11333, 84, 65574,
9412, 8387, 8916, -88237, -61179, 69894, 8912, 67,
65797, -86587, 10959, 9428, 8910, -86957, -60667, 70406,
8912, 67, 66309, -85296, -85933, 10964, 10066, 66591,
9813, 7892, -85443, 65571, 65570, 8389, 84, 65587,
-82111, -82488, -82736, -83884, 9431, 8660, 72, 70145,
-83007, -83249, 9426, 9166, 65990, 80, 66783, 10834,
65585, 8645, 67845, 10575, 84, 65536, 68, -81501,
-81622, 70376, 71400, 68329, -80447, -80696, 10962, 69,
66655, 10053, 65558, 68, -79837, -79958, 70120, 71144,
68073, 78, -79028, 9428, 76, 67061, 10693, 83,
66484, 9416, 8908, 66869, -77373, 10575, -77533, -77654,
69992, 71016, 67945, 84, -77014, 70184, 71208, -76611,
65753, 106541
!!END OF GENERATED SECTION
INTEGERNAME APP; !== PHRASE(112)
INTEGER BAPP; !BASIC APP IE LB EXP RB
INTEGERNAME MREF; !== MAP RESULT REF
ROUTINESPEC COMPILE BLOCK(INTEGER LEVEL, BTAG INTEGERNAME BTYPE,GD)
selectinput(2); !prim/perm specs
APP == PHRASE(112); BAPP = APP
TT0 == TAGTYPE(0); TT0 = BEG
MREF == GRAM(INITIAL(34)>>7&255)
COMPILE BLOCK(-3,0,TT0,TT0)
NEWLINE
MONITOR 192 IF FAULTY # 0
ROUTINE COMPILE BLOCK(INTEGER LEVEL,BTAG INTEGERNAME BTYPE,GD)
ROUTINESPEC PRINT SS(INTEGER S)
INTEGERFNSPEC GAPP
ROUTINESPEC FAULT(INTEGER N)
ROUTINESPEC ANALYSE
ROUTINESPEC COMPILE
OWNINTEGER AC=¬255, ACLIT=0
INTEGER TBASE,DBASE,LSTACK,ESTACK,PMAX,ATAG,DANGER,ACCESS,EXTIND,IBASE
TBASE = TMAX; DBASE = DMAX
LSTACK = 3; ESTACK = 0
IF BTYPE # BEG START; !PROCEDURE (NOT BEGIN)
ANALYSE; !FORMAL PARAMETERS
X = GAPP<<8
IF BTYPE&(¬255) # 0 START
FAULT(18) IF BTYPE&(¬255) # X AND GLOBAL # 0
FINISH ELSE START
BTYPE = BTYPE+X
FINISH
->FIN IF BTYPE&BODY = 0; !SPEC ->
FINISH
PRINT SS(MAP+8) IF BTAG # 0
ACCESS = BTAG; !NON-ZERO EXCEPT AT OUTSET
EXTIND = BTYPE&EXT; BTYPE = BTYPE!!EXTIND
ATAG = 0; IBASE = ICOUNT
DANGER = 0; PMAX = TMAX
AC=¬PMAX AND ACLIT=0 IF PMAX-1=TBASE AND TAGTYPE(PMAX)&62=0
CYCLE
LINE = LINE+LINES
NEWLINES(LINES) unless global=0; !LINE-END CODE
LINES = 0
ANALYSE; COMPILE IF SS # 0
IF SSTYPE < 0 START; !START OR END OF BLOCK
AC = ¬255
EXIT IF SSTYPE<<1 # 0; !END
COMPILE BLOCK(LEVEL+3,X,TAGTYPE(X),DANGER)
FINISH
REPEAT
PRINT SS(MAP)
FIN:TMAX = TBASE; DMAX = DBASE
RETURN
ROUTINE PRINT SS(INTEGER S)
INTEGER K,P
SELECT OUTPUT(S&7)
WRITE(LINE,3); SPACE; SPACE
SPACES(LEVEL) AND POS1=0 IF S # ERR
P = 1
CYCLE
PRINT SYMBOL('^') IF P = POS1
EXIT IF P = POS
K = CHAR(P); P = P+1
EXIT IF K = NL OR (K = '%' AND P = POS)
PRINT SYMBOL(K)
REPEAT
WRITE(ICOUNT-IBASE,5) IF S = MAP
NEWLINE
SELECT OUTPUT(OBJ)
END
ROUTINE PRINT IDENT
INTEGER I,J,K,L
I = INDEX(X); J = I>>9
PRINT SYMBOL(J>>3+32)
I = I&511; J = J&7
WHILE J # 0 CYCLE
J = J-1
CYCLE L = 12,-6,0
K = DICT(I-J)>>L&63
PRINT SYMBOL(K+32) IF K # 0
REPEAT
REPEAT
END
INTEGERFN GAPP; !GRAMMAR FOR APP
CONSTINTEGER COMMA=15, LB=14
INTEGER I,L
INTEGERFN CLASS(INTEGER K)
RESULT = K&15+80 IF K&(ARRAY+PROC) # 0; !PROC AND ARRAY PARAMS
RESULT = 122 IF K&REF = 0; !INTEGER->EXP(122)
RESULT = 119 IF K&2 = 0; !INTEGERNAME->REF(119)
RESULT = 120; !BYTEINTEGERNAME->BREF(120)
END
ROUTINE SET GCELL(INTEGER C)
C = L<<7+C; !LINK + CLASS
WHILE L # GMAX CYCLE
L = L+1; RETURN IF GRAM(L) = C
REPEAT
GMAX = GMAX+1; L = GMAX; GRAM(L) = C
END
I = TMAX
RESULT = 255 IF I = TBASE; !NULL APP (FOR NOW)
L = GMAX1; !')' CELL
CYCLE
SET GCELL(CLASS(TAGTYPE(I)))
I = I-1
EXIT IF I = TBASE
SET GCELL(COMMA); !',' CELL
REPEAT
SET GCELL(LB); !'(' CELL
RESULT = L
END
ROUTINE FAULT(INTEGER N)
SWITCH S(0:18)
POS1 = 0 IF N > 2
PRINT SS(ERR) IF POS # 0
SELECT OUTPUT(ERR)
PRINT SYMBOL('*')
->S(N)
S(0): PRINTTEXT 'FORM'; ->F
S(1): PRINTTEXT 'ATOM'; ->F
S(2): PRINTTEXT 'NAME'; ->F
S(3): PRINTTEXT 'SIZE'; ->F
S(4): PRINTTEXT 'DUPLICATE'; ->F
S(5): PRINTTEXT '%BEGIN'; ->M
S(6): PRINTTEXT '%CYCLE'; ->M
S(7): PRINTTEXT '%START'; ->M
S(8): PRINTTEXT '%END'; ->M
S(9): PRINTTEXT '%REPEAT'; ->M
S(10): PRINTTEXT '%FINISH'; ->M
S(11): PRINTTEXT '%RESULT'; ->M
S(12): PRINT SYMBOL('''')
PRINT IDENT
PRINT SYMBOL('''')
M: PRINTTEXT ' MISSING'; ->F
S(13): PRINTTEXT 'BOUNDS'; ->F
S(14): PRINTTEXT 'INDEX'; ->F
S(15): PRINTTEXT 'CONTEXT'; ->E
S(16): PRINTTEXT 'ACCESS'; ->A
S(17): PRINTTEXT 'ORDER'; ->F
S(18): PRINTTEXT 'MATCH'
F: FAULTY = 1
A: ACCESS = -1
E: NEWLINE; SELECT OUTPUT(OBJ)
POS = 0 IF SYMTYPE = 0
END
ROUTINE ANALYSE
CONSTINTEGER COMMA=15
INTEGER ATOM1,ATOM2,SUBATOM,LAST,HEAD,MAX,DUP,TEXT,LIM,INDEX0
INTEGER K,N,S,G,CLASS,NMIN,NMAX
INTEGERNAME Z
OWNINTEGER QUOTE=0, KEY=0, GG=0
ROUTINE READ SYM
->2 UNLESS SYM = NL
POS = 0; POS1 = 0
1: SYMTYPE = 1
2: READ SYMBOL(SYM)
POS = POS+1 UNLESS POS = 73
CHAR(POS) = SYM
IF SYM # NL START
RETURN IF QUOTE # 0
->1 IF SYM = ' '
SYMTYPE=2 AND ->2 IF SYM = '%'
!KDICT(33:95) := LINK<9>:CODE<2>
SYM = SYM-32 IF SYM >= 96
KEY = KDICT(SYM)
SYMTYPE = KEY&3-2 UNLESS KEY&3=0 AND SYMTYPE=2
FINISH ELSE START
LINES = LINES+1; SYMTYPE = QUOTE; !0,>0
FINISH
END; !READ SYM
ROUTINE CODE ATOM(INTEGER TARGET)
!TARGET (IF SPECIFIED) IS FIRST ATOM CLASS FROM GRAMMAR
INTEGER I,J,K
1: POS1 = POS
ATOM1 = 9; ATOM2 = 0; SUBATOM = 0
RETURN IF SYMTYPE = 0; !NL OR SEMI-COLON
->NAME IF SYMTYPE = -2; !LETTER ->
->NUMBER IF SYMTYPE < 0; !DIGIT ->
->QUOTED IF QUOTE # 0; !QUOTED SYMBOL ->
->QUOTEMARK IF SYM = ''''
->STRING IF SYM = '"'
!LOCATE ATOM IN FIXED DICT
!KDICT(96:KMAX) := MORE<1>:0<1>:LINK<9>:SYM<7>
! OR MORE<1>:1<1>:SUBCLASS<10>:CLASS<6>
I = KEY>>2; READ SYM
CYCLE
J = KDICT(I)
EXIT IF J&65536 # 0
IF J&127 # SYM OR SYMTYPE < 0 START
->ERR UNLESS J < 0
I = I+1
FINISH ELSE START
K = J>>7&511; READ SYM
IF J > 0 START
IF K # 0 START
->ERR IF K # SYM OR SYMTYPE < 0
READ SYM
FINISH
K = I+1
FINISH
I = K
FINISH
REPEAT
ATOM1 = J&63; !ATOM CLASS
SUBATOM = J>>6&1023
->1 IF ATOM1 = 0 AND SUBATOM = 0; !% C NL, (SHORT)
ATOM2 = KDICT(I+1)&63 IF J < 0; !VARIANT ATOM CLASS
RETURN UNLESS ATOM1 < 8; !DECLARATOR
DECL = 0 UNLESS LAST < 8
!CUMULATE SUBATOM INFO IN DECL (FOR MULTI-WORD KEYWORDS)
DECL = DECL!!SUBATOM
!ADJUST PROCEDURE-TYPE PARAMETERS
DECL = DECL-BODY+REF IF LAST # 0 AND DECL&PROC # 0; !PROC PAR
RETURN UNLESS ATOM1 = 0
!EXTERNAL, BYTE
->1 IF SYMTYPE > 0
ERR:ATOM1 = -1
RETURN
QUOTED:
ATOM1 = COMMA AND RETURN IF LAST # COMMA; !INFILTRATE COMMA
QUOTEMARK:
->STRING IF LAST = 38; !PRINTTEXT
QUOTE = SYM; READ SYM
ATOM1 = 71; SUBATOM = SYM; !SCONST
READ SYM IF SYM = QUOTE AND NEXT SYMBOL = QUOTE
RETURN IF NEXT SYMBOL # QUOTE
READ SYM
->ENDQUOTE
STRING:
QUOTE = SYM; READ SYM
ATOM1 = 67; SUBATOM = TEXT; !STRING
J = 0
WHILE SYM # QUOTE OR NEXTSYMBOL = QUOTE CYCLE
READ SYM IF SYM = QUOTE
IF J&(¬127) # 0 START
DICT(TEXT) = J; TEXT = TEXT-1
IF TEXT = DMAX START; !TOO LONG
ATOM1 = -3; TEXT = TEXT+1
FINISH
J = 0
FINISH
J = J<<7+SYM
READ SYM
REPEAT
DICT(TEXT) = J-131072; TEXT = TEXT-1
ENDQUOTE:
QUOTE = 0; READ SYM
RETURN
NUMBER:
->NAME IF LAST=17 OR (LAST=0 AND SECTION=0); !JUMP OR LAB
ATOM1 = 71; !SCONST
I = 10; !DECIMAL
CYCLE
SUBATOM = 0
CYCLE
IF SYMTYPE=-1 THEN K=SYM-'0' ELSE K=SYM-'A'+10
->ERR IF K >= I
SUBATOM = SUBATOM+K
READ SYM
EXIT IF SYMTYPE >= 0
J = I; K = SUBATOM; SUBATOM = 0; !MULTIPLY BY RADIX
WHILE J # 0 CYCLE
SUBATOM = SUBATOM+K IF J&1 # 0
K = K<<1; J = J>>1
REPEAT
REPEAT
RETURN IF SYM # '_'
I = SUBATOM
READ SYM; ->ERR IF SYMTYPE >= 0
REPEAT
ROUTINE LOOKUP(INTEGER D)
OWNINTEGER I; !OWN FOR OPTIMISATION
INTEGER J,K,L,M
I = INDEX0+TMAX+1; L = INDEX0+LIM
REP:I = I-1
->NEW IF I = L
->REP UNLESS INTEGER(I)&(¬511) = HEAD
J = INTEGER(I)&511; K = MAX
WHILE K # DMAX CYCLE
M = DICT(K)
->REP IF DICT(J) # M
J = J-1; K = K-1
REPEAT
SUBATOM = I-INDEX0
TTX == TAGTYPE(SUBATOM); ATOM1 = TTX&15+64
!SET UP GRAM FOR PARAMETERS
IF TTX&PROC # 0 THEN APP=TTX>>8 ELSE APP=BAPP
!NON-DECLARATIVE CONTEXT
RETURN IF D&255 = 0
!SPEC FOR PROC PARAMETER
RETURN IF D = 36 AND APP = 0
!LABEL AFTER JUMP, PROC AFTER SPEC
TTX=TTX+BODY AND RETURN IF TTX&255+BODY = D
DUP = 1
NEW:RETURN IF D = 0
TMAX = TMAX+1; SUBATOM = TMAX
TTX == TAGTYPE(SUBATOM); TTX = D; ATOM1 = TTX&15+64
INDEX(TMAX) = HEAD+MAX; DMAX = MAX
END; !LOOKUP
NAME:
HEAD = (SYM-32)<<12; MAX = DMAX
CYCLE
READ SYM; ->25 IF SYMTYPE >= 0
HEAD = HEAD+512; MAX = MAX+1
J = SYM-32
READ SYM; EXIT IF SYMTYPE >= 0
J = J<<6+SYM-32
READ SYM; EXIT IF SYMTYPE >= 0
J = J<<6+SYM-32; DICT(MAX) = J
REPEAT
DICT(MAX) = J
25: ATOM1 = -2; ATOM2 = 70; !IDENT
LIM = TBASE; !LOCAL
LOOKUP(64) AND RETURN IF LAST = 0 AND SYM = ':'; !LABEL
LOOKUP(256) AND RETURN IF LAST = 17; !JUMP
LOOKUP(DECL) AND RETURN IF TARGET = 70 AND DECL # 0; !IDENT
LIM = GLOBAL
IF LAST = 40 THEN LOOKUP(256) ELSE LOOKUP(0); !MCODE,NORMAL
RETURN UNLESS ATOM1 = 65 AND TTX&(¬255) # 0
ATOM1 = 71; SUBATOM = DICT(TTX>>8); !CONSTINTEGER
END; !CODE ATOM
! GRAM LAYOUT: MORE<1> ORDER<2> LINK<8> CLASS<7>
SS = 0; SSTYPE = 1; DECL = 0
ATOM1 = 0; LAST = 0; DUP = 0
TEXT = DBOUND; INDEX0 = ADDR(INDEX(0))
MREF = MREF&(¬127)+119; MREF = MREF+1 IF BTYPE&2 # 0
NMAX = 0; NMIN = NODEBOUND+1; N = 0
IF GG = 0 OR SECTION # 0 START
READ SYM IF SYMTYPE = 0
->SKP IF SYMTYPE = 0 OR SYM = '!'
CODE ATOM(0); ->SKP IF ATOM1 = 11; !COMMENT
FINISH
->L4 IF GG # 0
->91 IF ATOM1 <= 0
GG = INITIAL(ATOM1)
->91 IF GG = 0
SSTYPE = GG<<1&8_600000
IF GG < 0 START; !INIT ATOM FOR IMP
NMAX = 1; REFCO(NMAX) = 0; SUB(NMAX) = 1
FINISH
L1: LAST = ATOM1; ATOM1 = 0
S = SUBATOM
L2: CLASS = GG&127
IF CLASS >= 24 START; !NOT TRANSPARENT
NMIN = NMIN-1; ->90 IF NMIN = NMAX
SUB(NMIN) = S
L3: Z == N
CYCLE; !INSERT CELL IN ORDER
K = Z&127
EXIT IF K = 0 OR GG&98304 = 0
GG = GG-32768; Z == REFCO(K)
REPEAT
REFCO(NMIN) = CLASS<<7+K; Z = Z!!K+NMIN
FINISH
L4: G = GG>>7&255
CYCLE
GG = GRAM(G); CLASS = GG&127
EXIT IF CLASS = 0
IF CLASS < 112 START
CLASS = ATOMIC(CLASS) IF CLASS >= 80
CODE ATOM(CLASS) IF ATOM1 = 0
->L1 IF CLASS = ATOM1 OR CLASS = ATOM2
->91 IF GG >= 0
G = G+1
FINISH ELSE START
NMAX = NMAX+1; ->90 IF NMAX = NMIN
REFCO(NMAX) = N; SUB(NMAX) = G
N = 0
G = PHRASE(CLASS)
FINISH
REPEAT
S = 0
WHILE N # 0 CYCLE; !REVERSE LINKS
Z == REFCO(N)
K = Z&127; Z = Z!!K+S
S = N; N = K
REPEAT
->L5 IF NMAX = 0
N = REFCO(NMAX); G = SUB(NMAX)
NMAX = NMAX-1
K = GG; !EXIT-POINT CODE
CYCLE
GG = GRAM(G)
EXIT IF K = 0
->91 IF GG >= 0
K = K-32768; G = G+1
REPEAT
->L2 UNLESS S # 0 AND Z&127 = 0; !SINGLETON
CLASS = Z>>7; !DON'T BOTHER WITH NEW NODE
->L3
L5: SS = S
FAULT(4) IF DUP # 0
RETURN
!ERROR
90: ATOM1 = -3
91: READ SYM WHILE SYM # NL
IF ATOM1 < 0 THEN FAULT(-ATOM1) ELSE FAULT(0)
QUOTE = 0; SYMTYPE = 0; DECL = 0; SECTION = 0
GG = 0
RETURN
SKP:READ SYM WHILE SYMTYPE # 0
END; !ANALYSE
ROUTINE COMPILE
CONSTINTEGER LAC=68,LAD=95,TAD=71,ADA=64,DAC=65,DAD=93; !ada was 94
INTEGER I,J,K,NEXT,LINK,CLASS,REFDEST,BOWN
INTEGER PEND,PEND1,PENDOPR,LABCODE,ELSE,MAIN,LTAG,LNEST,FINAL
INTEGER CONTROL,INC,END,ILIT,ELIT
OWNINTEGER LIT=0,LIT1=0
SWITCH C(1:112)
ROUTINE PR(INTEGER X)
INTEGER I
I = !X!
WHILE I # 0 CYCLE
PRINT SYMBOL(I&15+'0'); !'HEX' DIGIT
I = I>>4
REPEAT
PRINT SYMBOL('-') IF X < 0
END
ROUTINE PLANT NAME(INTEGER X); !PROCEDURES, EXT SPECS
INTEGER I,J
ROUTINE NEXT
SPACE
J = J-1 AND PR(DICT(I-J)) IF J # 0
END
I = INDEX(X); J = I>>9&7
PR(I&(¬511)+TAGTYPE(X)&15); !SYM1+LENGTH+TYPE
I = I&511
NEXT; NEXT
SPACE
END
ROUTINE SWOP; !SWITCH SECTIONS
OWNINTEGER T
IF LEVEL < 0 START
IF SECTION = 0 START
PRINT SYMBOL('('); T = X
FINISH ELSE START
PR(T); PRINT SYMBOL(')')
IF GLOBAL # 0 START; !EXTERNAL NOT PERM
PLANT NAME(T); PR(T); PRINT SYMBOL('!')
FINISH
FINISH
FINISH ELSE PRINT SYMBOL('/')
SECTION = SECTION!!1
END
ROUTINE DEF(INTEGER T); !DEFINE TAG
PR(T); PRINT SYMBOL('.')
RETURN IF SECTION # 0
ACCESS = 1; AC = ¬255
END
ROUTINE OP(INTEGER OP); !OUTPUT OP-CODE
PRINT SYMBOL(OP); ICOUNT = ICOUNT+1
END
ROUTINE PLANT(INTEGER V); !PLANT VALUE
PR(V); OP('#')
END
ROUTINE PRINT(INTEGER X)
IF PENDOPR >= 0 START
FINAL = 0 UNLESS NEXT = LINK
PENDOPR = PENDOPR!!FINAL; !INVERT SKIP IF FINAL
IF PENDOPR # 0 START
PR(PENDOPR); OP(79); !OPR
FINISH
IF FINAL = 0 START
LABCODE = MAIN; PR(LMIN); OP(76); !JMP
FINISH
DEF(LTAG-1) IF LNEST&1 # 0
PENDOPR = -1; ACCESS = 1
FINISH
PR(X)
END
ROUTINE NEST
PRINT(NST); OP(66); AC = ¬AC; !JMS NST (PRESERVES AC)
END
ROUTINE POP
OP(84); AC = 255; !LAC* T0
END
ROUTINE EXPEND; !DISCHARGE PENDING LAC
INTEGER C
RETURN IF PEND < 0
NEST IF AC >= 0
UNLESS ¬AC = PEND START
IF PEND = 0 START; !CONSTANT
PRINT(LIT); OP(36); !LAC #LIT (PSEUDO-OP)
FINISH ELSE START
C = LAC; C = LAD IF PEND&256 # 0
IF LIT # 0 START
PRINT(LIT); OP(36)
C = TAD; C = ADA IF PEND&256 # 0
FINISH
PRINT(PEND&255); OP(C)
FINISH
FINISH ELSE START
IF ACLIT # LIT START
IF PEND = 0 START
PRINT(LIT); OP(36)
FINISH ELSE START
PRINT(LIT-ACLIT); OP(39); !TAD #
FINISH
FINISH
FINISH
AC = PEND; ACLIT = LIT; PEND = -1
END
ROUTINE LOAD(INTEGER T); !LOAD AC
EXPEND; PEND = T; LIT = 0
END
ROUTINE DO(INTEGER C); !(ADD),TAD,AND,XOR,SAD
IF PEND >= 0 START
IF PEND = 0 START; !CONSTANT
PRINT(LIT); OP(C-32); !PSEUDO-OP
FINISH ELSE START
IF LIT # 0 START
IF C = TAD START
PRINT(LIT); OP(39); !TAD #LIT (PSEUDO-OP)
FINISH ELSE START
EXPEND; ->1
FINISH
FINISH
PRINT(PEND); OP(C)
FINISH
FINISH ELSE START
1: OP(C+16); !<OP>* T0
FINISH
PEND = -1; AC = 255 UNLESS C = 75; !SAD
END
ROUTINE STORE(INTEGER T); !DEPOSIT AC
CONSTINTEGER DZM=67, ISZ=73
IF PEND = 0 AND LIT = 0 START
PEND = -1; AC = ¬255 IF ¬AC = T
FINAL = 512; PRINT(T); OP(DZM)
FINISH ELSE START
IF PEND = T AND LIT = 1 AND ¬AC # T START
PEND = -1
FINAL = 512; PRINT(T); OP(ISZ)
OP(79); !NOP
FINISH ELSE START
EXPEND
AC=T AND ACLIT=0 IF PENDOPR < 0; AC = ¬AC; !??
FINAL = 512; PRINT(T); OP(DAC)
FINISH
FINISH
END
ROUTINE OPR(INTEGER X); !OPERATE-GROUP
EXPEND; PRINT(X); OP(79)
AC = 255 IF X&4125 # 0
END
ROUTINE NOT; !COMPLEMENT AC
IF PEND # 0 THEN OPR(1) ELSE LIT=¬LIT
END
ROUTINE NEG; !NEGATE
IF PEND < 0 START
PRINT(-1); OP(39);
FINISH ELSE LIT = LIT-1
NOT
END
ROUTINE CALL(INTEGER T); !SUBROUTINE JUMP
EXPEND; PRINT(T); OP(66); AC = 255; !JMS T
END
ROUTINE JMSX(INTEGER T); !SPECIAL JMS
IF PEND >= 0 START; !SECOND PARAM SIMPLE
PRINT(2); OP(DAC); AC = ¬AC
FINISH ELSE START
STORE(1); POP; STORE(2); LOAD(1)
FINISH
CALL(T)
END
ROUTINE JUMP(INTEGER T); !JUMP
PRINT(T); OP(76)
END
ROUTINE MON(INTEGER N); !MONITOR
PRINT(MONI); OP(82); PLANT(N&255+256);!JMS* MONI: FLTNUM
AC = ¬255; ACCESS = 0
END
ROUTINE AREF; !ARRAY REF
CALL(AR); PRINT(X); OP(LAD)
END
ROUTINE BAREF
CALL(BAR); PRINT(X); OP(LAD)
END
ROUTINE PLANT OWN
OWNC = OWNC-1
IF OWNC&BOWN = 0 START
LIT = LIT<<9+LIT1 IF BOWN # 0
PLANT(LIT)
FINISH ELSE LIT1 = LIT
END
ROUTINE COMPILE END
INTEGER I,J,K
WHILE LSTACK # 3 CYCLE
FAULT(LSTACK&1+9)
LMIN = LMIN+2; LSTACK = LSTACK>>2
REPEAT
X = TMAX
SWOP; !SELECT DATA SECTION
PLANT(0) IF DANGER # 0
I = -1
WHILE X # TBASE CYCLE
TTX == TT0++X; K = TTX&255
IF K = OWN+ARRAY START; !SWITCH
J = TTX>>8
IF J # 0 START
SWOP; DEF(X); PLANT(DICT(J-1))
J = DICT(J); PLANT(J)
OP(79) AND J=J-1 WHILE J > 0; !NOP (JMP SET BY LOAD)
SWOP
FINISH
FINISH
IF K&(EXT+OWN) = 0 START
IF K = 0 OR K&(PROC+REF) = PROC THEN FAULT(12) ELSE START
IF K&(REF+ARRAY+PROC) = 0 AND DANGER = 0 START
DEF(X); !DEFINE TAG DIRECT
FINISH ELSE START
DEF(-X); !DEFINE TAG INDIRECT
FINISH
IF K&(REF+ARRAY+PROC) = 0 AND DANGER # 0 START
PLANT(-1); !POINTER SLOT
FINISH ELSE START
PLANT(0)
FINISH
I = I-1
FINISH
FINISH
X = X-1
REPEAT
IF BTAG # 0 START
DEF(BTAG); PLANT(0); !ENTRY POINT
IF DANGER = 0 START
IF PMAX # TBASE START
CYCLE
PRINT(PMAX); OP(DAD)
PMAX = PMAX-1
EXIT IF PMAX = TBASE
POP
REPEAT
FINISH
FINISH ELSE START
J = PMAX-TBASE; J = J-1 IF J # 0
CALL(ENT); !JMS ENTRY/EXIT
PLANT(I); PLANT(I+J-1); !-SLOTS:-NEST
FINISH
IF BTAG#DANGER>0 THEN GD=BTAG ELSE BTYPE=BTYPE+EXT
FINISH
SWOP; !REVERT TO INSTR SECTION
END
!PROCESS ANALYSIS RECORD
ROUTINE GET NEXT
INTEGER I
IF NEXT = 0 START
NEXT = REFCO(LINK)&127; LINK = SUB(LINK)
FINISH
CYCLE
X = SUB(NEXT); TTX == TT0++X
I = REFCO(NEXT); CLASS = I>>7
EXIT IF CLASS < 112 OR X = 0; !ATOM OR NULL PHRASE
IF I&127 # 0 START
SUB(NEXT) = LINK; LINK = NEXT
FINISH
NEXT = X
REPEAT
NEXT = I&127
END
PEND = -1; LIT = 0
LABCODE = 0; ELSE = 0; PENDOPR = -1
STOP IF AC >= 0
NEXT = SS; LINK = 0
FAULT(16) IF SSTYPE = 0 AND ACCESS = 0
1: GET NEXT
2: ->C(X) IF CLASS <= 31; !OPERATORS,SIMP
->C(CLASS)
9: ->1 IF NEXT # LINK
10: RETURN IF LABCODE = 0
11: JUMP(-(LMIN+1)) AND ACCESS=0 IF LABCODE&1=0; !JUMP BACK FOR LOOPS
RETURN IF LABCODE = 0
DEF(LMIN) UNLESS LABCODE = 3
DEF(LMIN+1) IF ELSE # 0; !PICKUP POINT FOR ELSE
RETURN
!COMPILE DECLARATIONS
INTEGERFN SIZE
INTEGER I
I = LIT-LIT1+1
IF I <= 0 OR I > 4095 START
FAULT(13); I = 200
FINISH
RESULT = I
END
ROUTINE SAVE(INTEGER V)
DMAX = DMAX+1; DICT(DMAX) = V
END
C(70): !IDENT
IF TTX&OWN = 0 START
->811 IF TTX&EXT # 0
->9 IF TTX&(REF+ARRAY) # ARRAY; !SCALAR
IF TTX&2 # 0 START; !BYTE
PRINT(3); OP(67); !DZM T3 (AS INDIC)
FINISH
IF AC >= 0 START; !FIRST IN GROUP
FAULT(17) IF LSTACK # 3
JMSX(ADEC); !JMS ADEC
FINISH ELSE START; !BOUNDS ALREADY SET
LOAD(1); CALL(ADEC); !LAC T1:JMS ADEC
FINISH
ATAG = X; PRINT(ATAG); OP(DAD)
AC = ¬255
->9
FINISH
OWNC = 0; PEND = -1
IF TTX&3 = 0 START; !SWITCH
SAVE(-LIT)
SAVE(SIZE)
701: TTX = DMAX<<8+TTX
->9
FINISH
IF TTX&EXT # 0 START; !CONST
SAVE(LIT)
->701
FINISH
SWOP IF SECTION = 0
X = -X IF TTX&REF # 0
DEF(X)
IF TTX&(REF+ARRAY) # ARRAY START
PLANT(LIT)
SWOP IF LEVEL < 0
->9
FINISH
PLANT(-LIT)
OWNC = SIZE; PLANT(OWNC)
LIT = 0; BOWN = 0
->9 IF TTX&2 = 0
BOWN = 1; OWNC = OWNC&1+OWNC
->9
C(108): !CONST BOUND SEP (COLON)
LIT1 = LIT; PEND = -1
->9
C(109): !OWNSEP (COMMA)
PLANT OWN IF OWNC > 0
LIT = 0; PEND = -1
->9
C(110): !OWNT (T)
PLANT OWN AND LIT = 0 WHILE OWNC > 0
SWOP IF SECTION # 0; !REVERT TO INSTR SECTION
RETURN
C(81): !PROCEDURE IDENT
IF TTX&(EXT+BODY) = 0 START; !INTERNAL SPEC
TTX = TTX+EXT IF GLOBAL = 0; !PERM
RETURN
FINISH
811:PRINT SYMBOL('('); !BODY OR EXT SPEC
->9 IF TTX&BODY # 0; !BODY
PLANT NAME(X)
PRINT(X); PRINT SYMBOL(',')
PRINT SYMBOL(')')
->9
!COMPILE BEGIN,END
C(57): !ENDOFPRIM
TBASE = TMAX
RETURN
C(58): !ENDOFPERM
GLOBAL = TBASE; TBASE = TMAX
LINE = 1; LINES = 0; ICOUNT = 0
selectinput(1); !switch to prog file
RETURN
C(55): !BEGIN
IF LEVEL < 0 START; !MAIN BEGIN
SSTYPE = 0; ACCESS = 1; LEVEL = 0
PRINT SYMBOL('!'); !ENTRY-POINT
FINISH ELSE START
TMAX = TMAX+1; X = TMAX; !TREAT AS ROUTINE
TAGTYPE(X) = BEG; INDEX(X) = 0
CALL(X); AC = ¬255
PRINT SYMBOL('(')
FINISH
RETURN
C(56): !END
IF BTAG = 0 START; !MAIN PROGRAM
FAULT(5); SSTYPE = 0
RETURN
FINISH
IF ACCESS # 0 START
FAULT(11) IF ACCESS > 0 AND BTYPE&15 # 12 AND GLOBAL # 0
PRINT(BTAG); OP(92); !JMP* BTAG
FINISH
DANGER = -ATAG IF DANGER = 0
COMPILE END
PLANT NAME(TBASE) IF GLOBAL # 0; !NAME UNLESS PERM
PRINT(TBASE); PRINT SYMBOL(')')
RETURN IF EXTIND = 0
FAULT(15) UNLESS LEVEL = 0
PLANT NAME(TBASE); PR(TBASE); PRINT SYMBOL('!')
RETURN
C(59): !ENDOFPROGRAM, ENDOFFILE
MON(0) IF ACCESS # 0
DANGER = 0
COMPILE END UNLESS LEVEL < 0
PRINT SYMBOL(')'); !END OF BLOCK
RETURN IF BTAG = 0
FAULT(8); !MISSING END
MONITOR 192
!COMPILE LOOPS AND CONDITIONS
!LSTACK, ESTACK AND LNEST ARE SINGLE-WORD NESTS
!LSTACK (2 BITS) KEEPS TRACK OF STATEMENT BRACKETS
!ESTACK (1 BIT) KEEPS TRACK OF ELSE JUMPS
!LNEST (3 BITS) DEALS WITH INTERNAL STRUCTURE OF COND STATEMENTS
!SIGNIFICANCE OF LSTACK VALUES:
! 00 CYCLE
! 01 IF,UNLESS
! 10 FOR,WHILE,UNTIL
! 11 ELSE
!SIGNIFICANCE OF LNEST VALUES:
! 000 AND AFTER AND,IF
! 001 AS ABOVE + DISCONTINUITY
! 010 OR AFTER OR,UNLESS
! 011 AS ABOVE + DISCONTINUITY
! 100 IF / WHILE / AND AFTER OR,UNLESS
! 101 AS ABOVE + DISCONTINUITY
! 110 UNLESS / OR AFTER AND,IF
! 111 UNTIL / AS ABOVE + DISCONTINUITY
ROUTINE POP LABEL(INTEGER IND)
FAULT(IND+6) AND RETURN IF LSTACK=3 OR LSTACK&1 # IND
LABCODE = LSTACK&3; ELSE = ESTACK&1
LSTACK = LSTACK>>2; ESTACK = ESTACK>>1
LMIN = LMIN+2
END
!COMPILE FOR LOOP
! ORDER = (START) CONTROL (INC) CSEP1 (END) CSEP2 (CYCLE,IMP)
C(107): !CONTROL VARIABLE
CONTROL = X
PEND1 = PEND; LIT1 = LIT; !START VALUE
PEND = -1
->9
ROUTINE SET(INTEGERNAME W)
IF PEND # 0 START
TMAX = TMAX+1; W = TMAX
TAGTYPE(W) = 1; INDEX(W) = 0; !DECLARE WL (INTEGER=1)
STORE(W); LIT = 0
FINISH ELSE START
W = 0; PEND = -1
FINISH
END
C(105): !CSEP1
SET(INC); ILIT = LIT
->9
C(106): !CSEP2
SET(END); ELIT = LIT; !END VALUE
LOAD(INC); LIT = ILIT; !LAC INC
NEG
IF PEND1 < 0 START
POP IF AC < 0; DO(TAD)
FINISH ELSE START
IF PEND # 0 START
LOAD(PEND1); LIT = LIT1; DO(TAD)
FINISH ELSE START
PEND = PEND1; LIT = LIT+LIT1
FINISH
FINISH
STORE(CONTROL); != START-INC
DEF(LMIN+1); !LAB FOR JUMP BACK
LOAD(CONTROL); !LAC CONTROL
LOAD(END); LIT = ELIT; DO(75); !SAD END
JUMP(LMIN); !JMP (NEXT INSTR)
LOAD(INC); LIT = ILIT; DO(TAD); !TAD INC
STORE(CONTROL); !DAC CONTROL
LABCODE = 2
->9
C(51): !REPEAT
POP LABEL(0)
->11
!COMPILE CONDITIONS
!STAT ORDER = CWORD COND IMP, CWORD COND START'
! CWORD COND IMP ELSE IMP, CWORD COND IMP ELSE START
!COND ORDER = AND C1 C2, OR C1 C2, NOT C1
!SCOND ORDER = EXP1 EXP2 COP, EXP1 EXP2 COP EXP3 COP
C(53):!LWORD: WHILE(20), UNTIL(23)
JUMP(LMIN-1) IF X&1 # 0; !UNTIL - JUMP OVER TEST
DEF(LMIN+1); !LABEL FOR LOOPING
C(52): !CWORD: IF(12), UNLESS(14)
LABCODE = 0; MAIN = X>>3; LNEST = X&7
LTAG = LMIN
->9
ROUTINE PUSH(INTEGER ANDOR)
IF LNEST&2 # ANDOR START
ANDOR = ANDOR+4; LNEST = LNEST!1
FINISH
LTAG = LTAG-1 IF LNEST&1 # 0
LNEST = LNEST<<3+ANDOR
END
C(42): !AND
PUSH(0)
->9
C(43): !OR
PUSH(2)
->9
C(44): !NOT
LNEST = LNEST!!2
->9
C(45): !COP: <(64), =(128), <=(192), >=(576), #(640), >(704)
PUSH(0) IF NEXT # 0; !DOUBLE-SIDED
IF PEND = 0 AND LIT = 0 START; !COMPARISON WITH ZERO
PEND = -1
X = X+4096 IF NEXT # 0; !+CLA IF DOUBLE
FINISH ELSE START
K = PEND
IF X&64 # 0 START; !<,<=,>=,>
IF PEND=0 AND LIT>0 AND NEXT=0 START
PRINT(64); OP(79); !SMA
NEG; DO(TAD)
FINISH ELSE START
IF X&128 # 0 START; !<=,>
JMSX(LE); X = X!!448; !SZL,SNL
FINISH ELSE START
JMSX(GE); X = X!!832; !SZL,SNL
FINISH
AC = K IF K >= 0; !ACLIT STILL SET
FINISH
FINISH ELSE START; !=,#
DO(75); !SAD
IF X = 640 START; !#
IF K >= 0 AND NEXT # 0 START
PEND = K; AC = ¬255
FINISH
X = 0
FINISH ELSE X = 512; !SKP
FINISH
FINISH
CONDSKIP:
X = X!!512 IF LNEST&2 # 0; !INVERT
IF LNEST&(¬7) # 0 OR MAIN = 2 START
OPR(X) UNLESS X = 0
AC = ¬AC UNLESS NEXT # 0
I = LTAG; J = LNEST
WHILE J&4 = 0 CYCLE
J = J>>3; I = J&1+I
REPEAT
JUMP(I); LABCODE = MAIN IF I = LMIN
DEF(LTAG-1) IF LNEST&1 # 0
LNEST = LNEST>>3
LTAG = LNEST&1+LTAG
FINISH ELSE START
PENDOPR = X; FINAL = 0
AC = ¬AC; AC = ¬255 IF LNEST&1 # 0
FINISH
->9
!COMPILE START, FINISH, ELSE, EXIT
C(49):C(50): !START, CYCLE
PRINT(0) IF PENDOPR >= 0; !DISCHARGE PENDING SKIP
DEF(LMIN+1) IF LABCODE = 0; !INDEFINITE CYCLE
MONITOR 21 IF LSTACK < 0
LSTACK = LSTACK<<2+LABCODE
ESTACK = ESTACK<<1+ELSE
LMIN = LMIN-2
RETURN
C(46): !FINISH
POP LABEL(1)
->9
C(47): !FINISH ELSE
POP LABEL(1)
FAULT(15) IF LABCODE = 3
C(48): !ELSE
IF ACCESS # 0 START
JUMP(LMIN+1); ELSE = 1
FINISH
LABCODE = 3; DEF(LMIN)
->9
C(20): !EXIT
J = LMIN+2; K = 1
J = J+2 AND K = K<<2 WHILE K&LSTACK # 0
FAULT(15) AND K=0 IF (-K)&LSTACK = 0
ACCESS = 0; FINAL = 512
JUMP(J); LSTACK = K<<1!LSTACK
->9
!COMPILE LABELS AND JUMPS
C(80): !LAB
FAULT(17) IF X < ATAG
DEF(X)
RETURN
C(64): !L
ACCESS = 0; FINAL = 512; JUMP(X)
->9
C(82): !SLAB
I = TTX>>8; RETURN IF I = 0; !POINTER TO BOUNDS
LIT = DICT(I-1)+LIT; !INDEX - UPPER
IF LIT <= 0 START
LIT = DICT(I)+LIT; !+ NUMBER
IF LIT > 0 START
PRINT(LIT+1); SPACE; DEF(X)
RETURN
FINISH
FINISH
FAULT(14)
RETURN
C(72): !SNAME
AREF
PRINT(3); OP(88); MON(135); !XCT* T3:MON 7+128
->10
!COMPILE PROCEDURE EXITS
C(16): !RETURN
I = 12; !SHOULD BE ROUTINE
PEX:FAULT(15) IF BTYPE&15 # I
ACCESS = 0; FINAL = 512
PRINT(BTAG); OP(92); !JMP* BTAG
->9
C(17): !TRUE
OPR(2050); !STL
171:I = 4; !SHOULD BE PRED
->PEX
C(18): !FALSE
OPR(2048); !CLL
->171
C(35): !FRESULT
I = BTYPE&3+4; !SHOULD BE FN
J = AC; K = ACLIT; EXPEND
AC = J; AC = ¬255 IF AC >= 0; ACLIT = K
->PEX
C(34): !MRESULT
I = BTYPE&3+12; !SHOULD BE MAP
STORE(3)
->PEX
!COMPILE STOP, FAULT, MONITOR, ETC
C(19): !STOP
MON(64)
->9
C(36): !FAULT
FAULT(15) IF BTAG # 0; !SHOULD BE MAIN PROG
CALL(FLT); PLANT(1); !JMS FLT: SLOT FOR NP
AC = ¬255
GET NEXT
JUMP(X)
->9
C(37): !MONITOR
PEND = -1; MON(LIT)
->9
C(40): !MCODE (OPERAND AFTER)
LIT = SUB(NEXT)
C(41): !LMCODE (CONST BEFORE)
PRINT(LIT); OP(X)
AC = ¬255
RETURN
C(67): C(87): !STRING (PRINTTEXT)
CALL(PTXT); !PTEXT SR (TEXT FOLLOWS)
UNTIL I < 0 CYCLE
I = DICT(X); PLANT(I); X = X-1
REPEAT
AC = ¬255
GET NEXT; !IGNORE CALL
->9
!COMPILE OPERANDS
ROUTINE PCALL
!PROCEDURE CALL
CALL(X)
RETURN IF DANGER # 0 AND DANGER # BTAG
DANGER = X IF TTX&EXT=0 AND X<=PMAX; !NOT SAFE
END
ROUTINE MCALL
!MAP CALL
IF X=INT AND PEND>0 AND LIT=0 AND TAGTYPE(PEND)&(OWN+REF)=OWN START
I = PEND; PEND = -1
FINISH ELSE START
PCALL; I = 3
FINISH
END
ROUTINE RESTORE
IF PEND1 >= 0 START
PEND = PEND1; LIT = LIT1
AC = ¬255; EXPEND
FINISH ELSE START
POP
FINISH
END
C(71): !SCONST
I = X
GET NEXT
IF PEND >= 0 AND CLASS = 28 AND X <= 2 START
!EXP +- LIST
I = -I IF X # 1; LIT = LIT+I
->9
FINISH
LOAD(0); LIT = I
->2
C(103): !ASSA: = (EXP = APP (A,M))
PEND1 = PEND; LIT1 = LIT; PEND = -1
->9
C(65): !V
LOAD(X)
->9
C(73): !ARRAY ELEMENT (VAL)
AREF; I = 3
VG: PRINT(I); OP(84); !LAC*
->9
C(77): !MAP ELEMENT (VAL)
MCALL
->VG IF I = 3
NEST IF AC >= 0; AC = 255
->VG
C(66): !BV
LOAD(256+X)
BG: CALL(BGET)
->9
C(74): !BYTE ARRAY ELEMENT (VAL)
BAREF
->BG
C(78): !BYTE MAP ELEMENT (VAL)
PCALL
->BG
C(96): !VDEST: V
STORE(X)
->9
C(86): !ARRAY ELEMENT (DEST)
AREF; I = 3
VP: RESTORE
VP1:PRINT(I); OP(81); !DAC*
AC = ¬AC
->9
C(83): !MAP ELEMENT (DEST)
MCALL
->VP IF I = 3 OR AC < 0
->VP1
C(99): !BVDEST: BV
CALL(BPUT); PRINT(X); OP(LAD)
AC = ¬255
->9
C(100): !BADEST: BA
BAREF
BP: RESTORE
CALL(BPUT); PRINT(3); OP(LAC)
AC = ¬255
->9
C(101): !BMDEST: BM
PCALL
->BP
C(112): !APP (NULL)
EXPEND; NEST IF AC >= 0
->9
C(84):C(85):C(89):C(90):C(92): !PPAR,FPAR,APAR,BAPAR,RPAR
C(93):C(94):C(97):C(98): !MPAR,BMPAR,VREF,BVREF
LOAD(256+X); !LAD X
->9
C(88): !ARRAY ELEMENT (REF)
AREF
->9
C(102): !BYTE AREF
BAREF
->9
C(91):C(95): !MAP ELEMENT (REF,BREF)
PCALL UNLESS X = INT
->9
C(69): !F (CALL)
PCALL UNLESS X = ADR
->9
C(68): !P (CALL)
PCALL
X = 256; !FOR SNL
->CONDSKIP
C(76): !R (CALL)
EXPEND; FINAL = 512; PCALL
AC = ¬255
->9
C(111): ->9; !SEP
!COMPILE OPERATORS
C(104): !MOD
OPR(65); OPR(513); !SMA!CMA:SKP!CMA
PRINT(1); OP(39); !TAD #1
->9
C(1): !PLUS-SIGN
DO(TAD) IF CLASS # 24; !TAD (UNLESS UNARY)
->9
C(2): !MINUS-SIGN
IF CLASS # 24 START
IF PEND > 0 START
PRINT(1); OP(79); !INFILTRATE CMA
DO(TAD); NOT; !TAD: CMA
FINISH ELSE START
NEG; DO(TAD)
FINISH
FINISH ELSE START
NEG
FINISH
->9
C(3): !UOP: ¬
NOT
->9
C(4): C(5): !LEFT-SHIFT, RIGHT-SHIFT
IF PEND = 0 AND LIT&(¬7) = 0 START
PEND = -1
WHILE LIT # 0 CYCLE
IF X # 5 THEN OPR(2056) ELSE OPR(2064); !RCL,RCR
LIT = LIT-1
REPEAT
FINISH ELSE START
NEG IF X = 5
JMSX(SH)
FINISH
->9
C(6): !AND
DO(74)
->9
C(10): !XOR
DO(69)
->9
C(11):C(12):C(13):C(14):C(15): !OR,MULT,IDIV,DIV,EXP
JMSX(X)
->9
C(8): !REFOP -- (DISP -- REF)
NEG
C(7): !REFOP ++ (DISP ++ REF)
GET NEXT
IF PEND = 0 START
PEND = 256+X; !AD OF X PLUS LIT
FINISH ELSE START
EXPEND
PRINT(X); OP(ADA)
AC = 255
FINISH
->9
C(9): !REFASS: ==
GET NEXT; FAULT(15) IF TTX&REF = 0
IF PEND-256 = X AND LIT = 1 START
PRINT(X); OP(89); !ISZ* (FOR ISZ)
AC = ¬255 IF ¬AC&255 = X
FINISH ELSE START
IF PEND > 0 START
TTX == TT0++(PEND&255)
EXPEND
IF TTX&(OWN+REF) = 0 START
PRINT(-65537); OP(42); !AND #-65537
FINISH
FINISH
PRINT(X); OP(DAD)
AC = ¬(X+256); ACLIT = 0
FINISH
->9
END; !COMPILE SS
END; !COMPILE BLOCK
ENDOFPROGRAM