%BEGIN; !IMP15 COMPILER 30/10/78 %EXTERNALROUTINESPEC CLOSE OUTPUT %integer outstream %routine select output(%integer stream) outstream = stream %end %routine newline %if outstream = 0 %then print ch(10) %end %routine newlines(%integer i) %integer j %for j = 1, 1, i %cycle newline %repeat %end %routine print symbol(%integer sym) %if outstream = 0 %then print ch(sym) %end !OUTPUT STREAMS %CONSTINTEGER ERR=0, OBJ=1, MAP=2 !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) APP == PHRASE(112); BAPP = APP TT0 == TAGTYPE(0); TT0 = BEG MREF == GRAM(INITIAL(34)>>7&255) COMPILE BLOCK(-3,0,TT0,TT0) NEWLINE %MONITOR %AND %STOP %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); !LINE-END CODE LINES = 0 ANALYSE; COMPILE %IF SS # 0 %IF SSTYPE&8_400000 # 0 %START; !START OR END OF BLOCK AC = \255 %EXIT %IF SSTYPE&8_200000 # 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): PRINTSTRING("FORM"); ->F S(1): PRINTSTRING("ATOM"); ->F S(2): PRINTSTRING("NAME"); ->F S(3): PRINTSTRING("SIZE"); ->F S(4): PRINTSTRING("DUPLICATE"); ->F S(5): PRINTSTRING("%BEGIN"); ->M S(6): PRINTSTRING("%CYCLE"); ->M S(7): PRINTSTRING("%START"); ->M S(8): PRINTSTRING("%END"); ->M S(9): PRINTSTRING("%REPEAT"); ->M S(10): PRINTSTRING("%FINISH"); ->M S(11): PRINTSTRING("%RESULT"); ->M S(12): PRINT SYMBOL('''') PRINT IDENT PRINT SYMBOL('''') M: PRINTSTRING(" MISSING"); ->F S(13): PRINTSTRING("BOUNDS"); ->F S(14): PRINTSTRING("INDEX"); ->F S(15): PRINTSTRING("CONTEXT"); ->E S(16): PRINTSTRING("ACCESS"); ->A S(17): PRINTSTRING("ORDER"); ->F S(18): PRINTSTRING("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 ->Z2 %UNLESS SYM = NL POS = 0; POS1 = 0 Z1: SYMTYPE = 1 Z2: READ SYMBOL(SYM) POS = POS+1 %UNLESS POS = 73 CHAR(POS) = SYM %IF SYM # NL %START %RETURN %IF QUOTE # 0 ->Z1 %IF SYM = ' ' SYMTYPE=2 %AND ->Z2 %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 Z1: 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 ->Z1 %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 ->Z1 %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 INDEX(I)&(\511) = HEAD J = INDEX(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; ->Z25 %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 Z25: 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 = 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 ->Z91 %IF ATOM1 <= 0 GG = INITIAL(ATOM1) ->Z91 %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; ->Z90 %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 ->Z91 %IF GG >= 0 G = G+1 %FINISH %ELSE %START NMAX = NMAX+1; ->Z90 %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 ->Z91 %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 Z90: ATOM1 = -3 Z91: 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 %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) BOWN = 0 %ROUTINE PR(%INTEGER X) %INTEGER I I = IMOD(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 OPC); !OUTPUT OP-CODE PRINT SYMBOL(OPC); 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; ->Z1 %FINISH %FINISH PRINT(PEND); OP(C) %FINISH %FINISH %ELSE %START Z1: OP(C+16); !* 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 == TAGTYPE(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 == TAGTYPE(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 Z1: GET NEXT Z2: ->C(X) %IF CLASS <= 31; !OPERATORS,SIMP ->C(CLASS) Z9: ->Z1 %IF NEXT # LINK Z10: %RETURN %IF LABCODE = 0 Z11: 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 ->Z811 %IF TTX&EXT # 0 ->Z9 %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 ->Z9 %FINISH OWNC = 0; PEND = -1 %IF TTX&3 = 0 %START; !SWITCH SAVE(-LIT) SAVE(SIZE) Z701: TTX = DMAX<<8+TTX ->Z9 %FINISH %IF TTX&EXT # 0 %START; !CONST SAVE(LIT) ->Z701 %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 ->Z9 %FINISH PLANT(-LIT) OWNC = SIZE; PLANT(OWNC) LIT = 0; BOWN = 0 ->Z9 %IF TTX&2 = 0 BOWN = 1; OWNC = OWNC&1+OWNC ->Z9 C(108): !CONST BOUND SEP (COLON) LIT1 = LIT; PEND = -1 ->Z9 C(109): !OWNSEP (COMMA) PLANT OWN %IF OWNC > 0 LIT = 0; PEND = -1 ->Z9 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 Z811:PRINT SYMBOL('('); !BODY OR EXT SPEC ->Z9 %IF TTX&BODY # 0; !BODY PLANT NAME(X) PRINT(X); PRINT SYMBOL(',') PRINT SYMBOL(')') ->Z9 !COMPILE BEGIN,END C(57): !ENDOFPRIM TBASE = TMAX %RETURN C(58): !ENDOFPERM GLOBAL = TBASE; TBASE = TMAX LINE = 1; LINES = 0; ICOUNT = 0 CLOSE OUTPUT %RETURN C(55): !BEGIN %IF LEVEL < 0 %START; !MAIN BEGIN %if global = 0 %start %if tmax = 0 %then tmax = 1 tbase = tmax; global = tbase %finish 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; %STOP !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 ->Z9 %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 ->Z9 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 ->Z9 C(51): !REPEAT POP LABEL(0) ->Z11 !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 ->Z9 %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) ->Z9 C(43): !OR PUSH(2) ->Z9 C(44): !NOT LNEST = LNEST!!2 ->Z9 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 ->Z9 !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 %AND %STOP %IF LSTACK < 0 LSTACK = LSTACK<<2+LABCODE ESTACK = ESTACK<<1+ELSE LMIN = LMIN-2 %RETURN C(46): !FINISH POP LABEL(1) ->Z9 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) ->Z9 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 ->Z9 !COMPILE LABELS AND JUMPS C(80): !LAB FAULT(17) %IF X < ATAG DEF(X) %RETURN C(64): !L ACCESS = 0; FINAL = 512; JUMP(X) ->Z9 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 ->Z10 !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 ->Z9 C(17): !TRUE OPR(2050); !STL Z171:I = 4; !SHOULD BE PRED ->PEX C(18): !FALSE OPR(2048); !CLL ->Z171 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) ->Z9 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) ->Z9 C(37): !MONITOR PEND = -1; MON(LIT) ->Z9 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 ->Z9 !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 ->Z9 %FINISH LOAD(0); LIT = I ->Z2 C(103): !ASSA: = (EXP = APP (A,M)) PEND1 = PEND; LIT1 = LIT; PEND = -1 ->Z9 C(65): !V LOAD(X) ->Z9 C(73): !ARRAY ELEMENT (VAL) AREF; I = 3 VG: PRINT(I); OP(84); !LAC* ->Z9 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) ->Z9 C(74): !BYTE ARRAY ELEMENT (VAL) BAREF ->BG C(78): !BYTE MAP ELEMENT (VAL) PCALL ->BG C(96): !VDEST: V STORE(X) ->Z9 C(86): !ARRAY ELEMENT (DEST) AREF; I = 3 VP: RESTORE VP1:PRINT(I); OP(81); !DAC* AC = \AC ->Z9 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 ->Z9 C(100): !BADEST: BA BAREF BP: RESTORE CALL(BPUT); PRINT(3); OP(LAC) AC = \255 ->Z9 C(101): !BMDEST: BM PCALL ->BP C(112): !APP (NULL) EXPEND; NEST %IF AC >= 0 ->Z9 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 ->Z9 C(88): !ARRAY ELEMENT (REF) AREF ->Z9 C(102): !BYTE AREF BAREF ->Z9 C(91):C(95): !MAP ELEMENT (REF,BREF) PCALL %UNLESS X = INT ->Z9 C(69): !F (CALL) PCALL %UNLESS X = ADR ->Z9 C(68): !P (CALL) PCALL X = 256; !FOR SNL ->CONDSKIP C(76): !R (CALL) EXPEND; FINAL = 512; PCALL AC = \255 ->Z9 C(111): ->Z9; !SEP !COMPILE OPERATORS C(104): !MOD OPR(65); OPR(513); !SMA!CMA:SKP!CMA PRINT(1); OP(39); !TAD #1 ->Z9 C(1): !PLUS-SIGN DO(TAD) %IF CLASS # 24; !TAD (UNLESS UNARY) ->Z9 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 ->Z9 C(3): !UOP: \ NOT ->Z9 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 ->Z9 C(6): !AND DO(74) ->Z9 C(10): !XOR DO(69) ->Z9 C(11):C(12):C(13):C(14):C(15): !OR,MULT,IDIV,DIV,EXP JMSX(X) ->Z9 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 ->Z9 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 == TAGTYPE(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 ->Z9 %END; !COMPILE SS %END; !COMPILE BLOCK %ENDOFPROGRAM