˙!!! %option stack=30 !!! 19-Feb-82 !!!! 15/5/78 {Modified run under new subsystem so that it can support its own supervisor} !!!!!!!!!!!%CONTROL 1; ! ... TEST ONLY SWITCHES %CONSTSTRING(5) VERSION = "4.12" %CONSTINTEGER GBASE= 426 %CONSTINTEGER GMAX = 512; !??? {Changed from %CONST to %OWN to get 8.1 pass1 to accept source} %ownSHORTINTEGERARRAY PHRASE(132:255) = 326, 137, 219, 0, 386, 164, 242, 246, 216, 210, 229, 98, 378, 183, 310, 292, 268, 259, 349, 221, 367, 364, 410, 413, 416, 419, 422, 391, 405, 199, 236, 158, 382, 357, 0, 278, 285, 307, 302, 318, 321, 346, 341, 370, 425, 426, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 7, 40, 49, 96, 0 %CONSTBYTEINTEGERARRAY ATOMIC(105:130) = 14, 9, 4, 20, 6, 110, 111, 30, 3, 80, 59, 59, 13, 4, 13, 59, 43, 73, 79, 72, 71, 4, 2, 2, 4, 2 %OWNSHORTINTEGERARRAY GRAM(0:GMAX) = 0, -32765, 4, 5, 511, 8198, 4, -32748, -32747, -32741, -32740, -32739, -32738, -32737, 15, -32736, -32750, 511, -32257, 15, 27, 22, -32744, 511, 8217, -32747, 511, 511, 511, 27, 33, 37, 36, 8226, -32750, 511, 16, 8230, -32737, 511, -32726, 511, 43, 44, -32725, -32721, 27, -32725, 44, -32708, -32706, -32698, -32689, -32688, -32687, -32741, -32675, -32686, -32741, 66, -32706, 511, -32698, -32695, -32257, 27, -24482, -24482, -32673, 511, 71, -32694, -32695, 511, -32695, -32257, 77, -32681, 511, 89, -32257, 4187, -32685, 84, -32685, -32695, 511, -32695, 27, ˙ -32703, 73, -32695, 511, 8219, 8219, 12315, 97, 27, -32657, -32647, -32655, -32654, -32647, -32660, -32653, -32651, -32646, 122, -32645, -32649, 120, -32644, 121, -32643, 126, -32645, 119, -32641, 128, -24576, 8192, 129, 130, 0, 8192, 8192, 8192, 8192, 131, 132, 133, 134, 114, 115, 135, -32649, 123, -32768, -32622, -32621, -32620, -32624, -32619, 150, -32623, 8344, 8192, 126, 125, 154, -32613, 0, -32612, 0, 157, 0, 20480, 150, -32607, -32606, 163, 4096, 4608, 2048, -32594, -32768, -32768, -32594, -32594, -32593, -32593, -32591, -32591, 177, 178, -32589, 0, 180, 181, 0, 182, 0, 175, -32594, -32768, -32768, -32594, -32594, -32594, -32574, -32574, -32573, -32573, 195, 196, 197, 0, 198, 194, -32564, -32564, -32562, -32562, 206, -32561, 0, 208, 0, 209, 204, -32555, -32768, 0, 214, 12503, 0, 8409, -32552, 0, -24576, 8192, -32542, 223, -32541, -32540, 174, 0, 215, 0, -32532, -32536, 241, -32529, -24576, -32533, 8192, -32533, -32533, 8192, -24576, 8192, 0, 243, -32526, -32768, 243, -32520, 249, 250, 254, -32516, 0, -32518, 250, 8447, 256, -32510, 0, 0, -32507, 262, 4608, 2311, 264, 18697, -32501, 0, 10240, -32498, 271, 272, 273, 274, 125, 16659, -32491, 0, 8192, -32768, -32486, -32485, 0, 215, 8476, 0, -32768, -32768, -32478, -32477, 0, 215, 284, -32468, -32474, 8487, -32474, -32467, -32468, -32468, 0, 8489, 8488, 8495, -32466, -32462, 0, 8496, 8500, -32461, 0, -32452, 8504, -32457, -3˙2451, -32452, 0, 8506, 8505, 8511, -32450, 0, 8514, -32447, -32443, 0, 8515, -32434, -32440, 8521, -32440, -32430, -32429, -32429, 0, 8527, -32428, -32428, 0, 8522, 8523, 8527, 8534, -32427, -32423, 0, 8535, 8539, -32422, 0, 350, -24223, -24222, 0, 355, 351, -24223, 0, 8550, 359, 8552, 361, 8554, 363, 8192, 365, 4462, 0, 368, -32401, 0, 371, 4468, 373, 12662, -32392, 377, 371, 0, 379, 8572, -32390, 0, 383, 8576, 385, 8407, -32380, 0, -32378, 8448, 388, -32768, -32768, -32370, -32370, -32369, -32369, 399, 401, -32366, 0, 0, 403, 404, 398, 406, 4503, -32359, 377, 406, 411, 4508, 365, 414, 4511, 411, 417, 4514, 414, 420, 4517, 417, 423, 4520, 420, 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, 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 %OWNBYTEINTEGERARRAY GCLASS(0:GMAX) = 255, 114, 116, 1, 89, 162, 2, 53, 54, 49, 50, 51, 52, 57, 142, 1, 118, 117, 13, 142, ˙152, 152, 6, 117, 142, 118, 117, 13, 59, 144, 59, 152, 83, 164, 6, 117, 128, 164, 4, 13, 1, 13, 56, 59, 56, 4, 2, 56, 59, 34, 35, 28, 29, 10, 11, 33, 42, 19, 48, 133, 35, 13, 28, 12, 119, 133, 28, 29, 11, 13, 150, 5, 12, 119, 12, 119, 133, 35, 13, 150, 119, 165, 15, 83, 4, 12, 119, 12, 133, 5, 10, 10, 119, 83, 150, 165, 1, 138, 63, 62, 61, 60, 64, 75, 74, 77, 78, 76, 94, 109, 20, 20, 95, 20, 109, 94, 109, 20, 95, 83, 161, 101, 101, 143, 159, 137, 163, 166, 101, 153, 153, 153, 102, 102, 102, 109, 94, 23, 8, 22, 21, 24, 73, 143, 15, 83, 141, 90, 91, 101, 112, 0, 4, 0, 153, 133, 147, 102, 86, 87, 88, 147, 146, 140, 70, 67, 68, 69, 71, 74, 75, 76, 77, 78, 101, 94, 0, 101, 153, 137, 153, 102, 102, 70, 67, 68, 69, 72, 71, 74, 75, 76, 77, 78, 94, 101, 145, 153, 102, 74, 75, 76, 77, 78, 94, 0, 101, 161, 153, 102, 80, 81, 115, 1, 147, 2, 134, 105, 0, 82, 145, 99, 100, 1, 32, 79, 149, 150, 151, 86, 87, 88, 43, 84, 45, 83, 43, 45, 83, 84, 83, 82, 139, 4, 2˙, 139, 53, 51, 59, 152, 4, 0, 59, 139, 164, 97, 4, 0, 136, 99, 100, 148, 140, 46, 140, 46, 0, 140, 99, 100, 132, 137, 46, 108, 132, 46, 0, 132, 83, 1, 9, 145, 147, 167, 106, 84, 83, 1, 9, 145, 132, 168, 43, 45, 167, 36, 38, 39, 40, 0, 170, 169, 167, 36, 38, 0, 169, 167, 36, 0, 43, 168, 37, 41, 40, 0, 172, 171, 168, 37, 0, 168, 37, 41, 0, 171, 43, 45, 168, 36, 38, 39, 40, 0, 174, 39, 40, 0, 173, 174, 172, 168, 36, 38, 0, 173, 168, 36, 0, 151, 30, 31, 0, 151, 151, 30, 0, 137, 6, 147, 4, 147, 126, 147, 1, 147, 127, 59, 4, 0, 1, 147, 113, 147, 4, 2, 98, 97, 152, 175, 4, 0, 1, 162, 113, 162, 59, 139, 4, 164, 59, 70, 69, 74, 75, 76, 77, 78, 94, 95, 0, 159, 101, 153, 102, 1, 147, 4, 127, 98, 1, 147, 107, 1, 147, 107, 1, 147, 107, 1, 147, 107, 1, 147, 107, 124, 125, 147, 107, 147, 107, 147, 107, 147, 127, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 %CONSTSHORTINTEGERARRAY KDICT(32: 538) = 0, 511, 131, 527, 131, 131, 531, 131, 535, 539, 543, 551, 555, 559, 575, 579, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 591, 594, 599, 619, 635, 131, 131, 652, 724, 752, 840, 876, 1020, 128, 128, 1084, 128, 128, 1296, 1320, 1344, 1384, 1408, 128, 1460, 1824, 2056, 2080, 128, 2112, 128, 128, 128, 131, 2127, 131, 131, 2151, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 2155, 131, 131, -32351, -16119, 16679, 16743, 18734, 16614, 16385, 16386, -16282, 16489, 17128, 16388, -32322, -15576, 17195, 16392, 21710, -32465, 19369, 16550, 16387, 16397, -32196, -32451, 18542, 18798, 16804, -32323, -14138, 18670, 19284, -32195, -32450, 18606, 16868, 18862, -30642, 10578, 11457, -31922, -32429, 16823, 8912, 67, 16951, 9921, 69, -32429, 16887, 8912, 67, 17079, 68, 18910, -32187, 10841, 69, 16896, 9415, 78, 17393, -30070, -32177, 8665, 8908, 16394, -31027, 78, -31533, 84, -32183, 10194, 76, 17386, 10958, 69, 18135, 84, 16512, 8909, 10830,˙ 16391, 16384, -32055, 10073, 9921, 8649, 16704, 9153, 10190, 8915, 17322, -28340, -31026, -31530, 88, -32055, 8916, 10066, 9793, 16768, 84, 18071, 10053, 84, 16399, 68, -32433, 21873, 70, -31034, -31540, 80, -32059, 10194, 10567, 9921, 22001, 9938, 22065, 10697, 84, 17904, 9801, 69, 21937, 8915, 19171, -31039, -31543, -32306, 10575, 16395, -32429, 17143, 8912, 67, 17207, 9422, 9299, 19106, 10700, 69, 17623, -26042, 10830, 9157, 10565, -28607, -29626, -30643, -31794, -32301, -15243, 17528, 8912, 67, 23416, 9921, 69, -32301, -15179, 17592, 8912, 67, 23480, 10305, -32301, -14734, 18040, 8912, 67, 24306, 78, -32301, -14798, 17976, 8912, 67, 24370, 10578, 11457, -31922, -32429, 18163, 8912, 67, 23539, 9921, 69, -32301, -14539, 18232, 8912, 67, 23608, 18204, -32183, 10063, 71, 17024, 10835, 17840, 10305, -32429, 16631, 8912, 67, 16695, -32319, 10831, 18464, 8909, -32301, -16201, 16568, 8912, 67, 17015, -32050, -32302, 10071, 16448, 18975, 19219, -31291, 8914, 9412, 8387, 8916, -32301, -15694, 17080, 8912, 67, 24050, 9938, 16832, -31419, 10959, 9428, 8910, -32301, -15886, 16888, 8912, 67, 24114, -29759, -30909, -31408, -32173, 10964, 10066, 17495, 9813, 7892, -32451, 17430, 17045, 8389, 84, 19041, 10575, 68, -32088, 10182, 9938, 10817, 21810, 21521, 76, -27455, -28474, -29491, -30642, -32301, -10123, 22648, -31540, -32178, 8912, 67, 23672, 10575, 8397, 76, 18032, 10063, 71, 17968, 9921, 69, -32301, -10059, 22712, 8912, 67, 23736, 10305, -32301, -9614, 23160, 8912, 67, ˙ 24178, 78, -32301, -9678, 23096, 8912, 67, 24242, 10578, 11457, -31922, -32429, 23283, 8912, 67, 23795, 9921, 69, -32301, -9419, 23352, 8912, 67, 23864, -25656, -26167, -26672, -31532, -32041, 10713, 8916, 77, 16640, 10825, 9283, 16825, -28223, -28593, 9426, 9166, -29144, -30015, -31034, -32051, 8398, 8909, -12107, 20664, 10305, -32301, -11662, 21112, 8912, 67, 24498, 78, -32301, -11726, 21048, 8912, 67, 23922, 10578, 11457, 8398, 8909, -11467, 21304, 20496, 80, 17751, 10834, 16396, 8645, -8206, 24567, 10055, 9793, 17688, 10575, 84, 16960, -32184, 10962, 69, 17559, 10053, 16389, 78, -32180, 9428, 76, 18397, 10693, 83, 18268, 9416, 8908, 18333, -32067, -32292, -15771, 17005, 17252, 18734, 16402, 16649 !******************************************* !* * !* TRANSPORTABLE IMP COMPILER * !* * !* COPYRIGHT PETER S. ROBERTSON * !* DEPARTMENT OF COMPUTER SCIENCE * !* UNIVERSITY OF EDINBURGH * !* ALL RIGHTS RESERVED * !* * !******************************************* ! ! THROUGHOUT THE SOURCE TEXT OF THIS PROGRAM, THE LOWER CASE ! ALPHABET IS REPRESENTED BY LETTER+32 E.G. 'A'+32 %CONSTINTEGER SS0=250, SS1=251, SS2=252, SS3=253, SS4=254 %CONSTINTEGER NULL=512; !??? %CONSTINTEGER TRANSP = 18 %CONSTINTEGER PHRASES = 132 %CONSTINTEGER EQUIVS = 105 %CONSTINTEGER DIRECTIVES = 86 %CONSTINTEGER ANAPP=160 %CONSTINTEGER GLOBAL=0 %CONSTINTEGER ICONST=83, RCONST=84, SCONST=82 %CONSTINTEGER LB=1, RB=2 %CONSTINTEGER PRE1=49, PRE2=57 %CONSTINTEGER OWN1=53, OWN2=51 %CONSTINTEGER SET1=60, SET2=64 %CONSTINTEGER CHECK1=66, CHECK2=72 %CONSTINTEGER DEF1=60, DEF2=79 %CONSTINTEGER IDENT=59, SWIT˙CH=80, COMMENT=7 %CONSTINTEGER TERMIN=13 %CONSTINTEGER APPEP=153 %CONSTINTEGER PAGE SIZE = 64 %CONSTINTEGER STX = 2 %CONSTINTEGER PAGE = 12 !********************************************* !* OTYPE * MOD * SPECD * FORMAT * APP * LINK * !********************************************* ! 3 2 1 1 1 8 ! ! OTYPE : 1 OWN ! 2 CONST ! 3 EXTRINSIC ! 4 SYSTEM ! 5 DYNAMIC ! 6 EXTERNAL ! 7 PERM ! !******************************* !* LENGTH * USED * TYPE * FORM * !******************************* ! 8 1 3 4 ! %BEGIN ! ------I/O STREAM ASSIGNMENTS CHANGED TEMPORARILY------ %CONSTINTEGER PRIM = 2, PROG = 1; ! INPUT STREAMS %CONSTINTEGER REPORT=3,OBJ=2, LISTING=1; ! OUTPUT STREAMS %CONSTINTEGER EOP=87; ! ENDOFPROGRAM SUBATOM %CONSTINTEGER EOF=86; ! ENDOFFILE SUBATOM %CONSTINTEGER TEXT LIMIT=255; ! MAX STRING LENGTH %CONSTBYTEINTEGERARRAY CMAP(0 : 15)= 0, 67, 68, 81, 65, 83, 80, 73, 72, 71, 79, 69, 7 0, 66, 0, 0 %CONSTINTEGER STRING = 16, RECORD=17; ! STRING/RECORD SUBATOMS %CONSTINTEGER SPECIAL=55; ! SPECIAL DECLARATOR %CONSTINTEGER RFN=65; ! RECORDFORMAT NAME CLASS %CONSTINTEGER ULINE=18; ! CLASS FOR '_' %CONSTINTEGER NULL STRING=401 %OWNINTEGER PERMIN = 1; ! PERM/PROG SWITCH %OWNINTEGER DIAG = 0, CONTROL = 0 %OWNINTEGER BPT=0; ! CODE BUFFER POINTER %OWNSHORTINTEGERARRAY BUFFER(1 : 401) %CONSTINTEGER MCODE = 38 ! %DIAGNOSE FLAGS (2\\N) ! ! 0 - GRAMMAR TRACE ! 1 - RECORD USE ! 2 - APP DEFN. ! 3 - RECORD DEFN. ! %ROUTINESPEC FAULT(%INTEGER N) !********************************************* !* ALMOST THE WHOLE COMPILER ASSUMES A 16 BIT WORD. * !********************************************* %OWNINTEGER MARK = ' ' %OWNINTEGER FILE = 0; ! BEGIN OR EXTERNAL FILE ? %CONSTIN˙TEGER DICT END = 2750 %INTEGERARRAY DICT(0:DICT END) %CONSTINTEGER MAX LAB = 80 %BYTEINTEGERARRAY LABINF(1 : MAX LAB) %INTEGER LIST, LREALS; ! OPTION FLAGS %INTEGER STATS; ! NUMBER OF STATEMENTS %ownINTEGER CODE = 0; ! OBJECT FILE SIZE %INTEGER LINES; ! LINES ON LISTING PAGE %INTEGER LINENUM; ! CURRENT LINE NUMBER %INTEGER LIT; ! LAST LITERAL POS %INTEGER LIT POS; ! LITERAL TEXT POINTER %INTEGER LIMIT; ! DIGIT SEARCH LIMIT %INTEGER DIGIT; ! CURRECT DIGIT %INTEGER OLD SYM; ! FIRST SYM OF NAME %INTEGER LABEL; ! CURRENT LABEL %INTEGER X; ! CURRENT TAG APP/FORMAT %ownINTEGER SYM = 0; ! CURRENT INPUT SYMBOL %INTEGER ATOM1; ! CURRENT ATOM %INTEGER ATOM2; ! VARIANT OF ATOM1 %INTEGER SUBATOM; ! EXTRA INFO %INTEGER LAST; ! LAST ATOM TYPE %INTEGER SS TYPE; ! 0 LABEL, 1 DECLARATION, ! 2 FORMAL PARAMS, 3 STATEMENT %INTEGER SYMTYPE; ! -2:LETTER, -1: DIGIT ! 0:TERMINATOR, 1: OTHER %INTEGER TYPE; ! VARIABLE TYPE WANTED %INTEGER VAR TYPE; ! VARIABLE TYPE FOUND %ownINTEGER POS = 0; ! CURRENT INPUT POSITION %INTEGER ATOM POS; ! CURRENT ATOM START POSN. %INTEGER DUP; ! DUPLICATE FLAG %INTEGER OUT; ! CURRENT OUTPUT STREAM %INTEGER PREFIX, SPREFIX; ! OWN, BYTE, EXTERNAL ETC. %INTEGER CONST INT %INTEGER O TYPE %INTEGER DEC TYPE; ˙ ! CURRENT DECLARATOR %OWNINTEGERARRAY CNEST(0 :10); ! STACK FOR CONDITIONS %OWNBYTEINTEGERARRAY LINE(1 : 73); ! INPUT LINE BUFFER %CONSTINTEGER RECLEN = -300; ! -(MAX LENGTH OF ANALYSIS RECORD) %INTEGERARRAY REF, CO, SUB, LOC(RECLEN : -1) %INTEGER SS; ! SOURCE STATEMENT ENTRY %INTEGER A; ! ATOM POINTER %INTEGER P; ! PHRASE POINTER %INTEGER FAULTY; ! FAULT INDICATOR %INTEGER F TYPE; ! TYPE OF FAULT %INTEGER G LIMIT; ! END OF GRAM POINTER %INTEGER T LIMIT; ! MAX EXTENT OF DICTIONARY %INTEGER TMAX; ! CURRENT MAX TAG (FREE) %INTEGER T BASE; ! FIRST NAME AT CURRENT LEVEL %INTEGER DP; ! END OF CURRENT NAME %INTEGER RELOCATE; ! RELOCATION FOR FORMATS %INTEGER APP %SHORTINTEGERNAME PAPP; ! ==PHRASE(APPEP) %INTEGER EILAB; ! %ELSEIF LABEL %ownINTEGER MARGIN = 0 %INTEGER INHIBIT; ! FLAG FOR DECLARATIONS MISPLA %ROUTINE SEND %INTEGER J %RETURN %IF BPT <= 0 FAULT(22) %IF BPT >= LITPOS %IF FAULTY = 0 %START SELECTOUTPUT(OBJ) PRINTSYMBOL(BUFFER(J)) %FOR J = 1,1,BPT SELECTOUTPUT(LISTING) %FINISH BPT=0 %END %ROUTINE PUT(%INTEGER N) CODE = CODE+1 SEND %IF BPT > 71 BPT=BPT+1; BUFFER(BPT)=N %END %ROUTINE ADDR(%INTEGER N) %INTEGER V V=N//10 ADDR(V) %UNLESS V=0 PUT(N-V*10+'0') %END %ROUTINE OP(%INTEGER C, A) PUT(C); ADDR(A) %END %ROUTINE PRINT NAME(%INTEGER N) %INTEGER D, FLAG ! ----- 'UNPACK' USES AT LEAST A 30-BIT WORD ---- %ROUTINE UNPACK(%INTEGER V) %INTEGER J, N, C %CYCLE J = 24,-6,0 C = (V>>J)&63 %IF C # 0 %START C = C+32; ! ADD IN 32 REMOVED WHEN PACKING %IF FLAG # 0 %START %IF FLAG < 0˙ %THEN PUT(C) %ELSE PRINT SYMBOL(C) FLAG = FLAG+1 %FINISH %FINISH %REPEAT %END %IF N < 0 %THEN N = -N %AND FLAG = -13 %ELSE FLAG = 1 D=DICT(N) UNPACK(DICT(D-2)) %FOR D = N-D&255, 1, N-D>>11&3 %END %ROUTINE FAULT(%INTEGER N) %INTEGER ERROR POS, STREAM, SPACING %SWITCH FM(-1 : 24) STREAM = REPORT; SELECTOUTPUT(REPORT) ATOM POS = DUP %IF DUP # 0 ERROR POS = ATOM POS ERROR POS = 0 %IF ERROR POS = POS %AND N > 1 FAULTY=FAULTY+1 SPACING = MARGIN+ERROR POS+8 -2 %CYCLE %IF POS > 0 %AND (LIST # 0 %OR STREAM = REPORT) %START WRITE(LINE NUM, 4) %AND SPACE %IF STREAM # REPORT %CYCLE POS = 1,1,POS PRINTSYMBOL('|') %IF POS = ERROR POS %AND STREAM=REPORT PRINTSYMBOL(LINE(POS)) %REPEAT SYM=LINE(POS) %FINISH NEWLINE %IF SYM # NL PRINTSYMBOL('*') %IF STREAM = REPORT %START WRITE(LINE NUM, 4); SPACE %ELSE SPACE %IF ERROR POS # 0 %START SPACES(SPACING-1); PRINTSTRING("! ") %FINISH %FINISH ->FM(N) FM(24): PRINTSTRING("COMPILER ERROR!"); ->F FM(20): PRINTSTRING("TEXT TOO LONG"); ->F FM(21): PRINTSTRING("TOO MANY NAMES"); ->F FM(22): PRINTSTRING("TOO MANY LONG NAMES"); ->F FM(23): PRINTSTRING("PROGRAM TOO COMPLEX"); ->F FM(18): PRINTSTRING("ACCESS") FAULTY = FAULTY-1 %IF STREAM = REPORT ->F FM(0): PRINTSTRING("FORM"); ->F FM(1): PRINTSTRING("ATOM"); ->F FM(2): PRINTSTRING("TYPE"); ->F FM(3): PRINTSTRING("NAME"); ->F FM(4): PRINTSTRING("SIZE"); ->F FM(5): PRINTSTRING("CONTEXT"); ->F FM(6): PRINTSTRING("MATCH"); ->F FM(7): PRINTSTRING("COPY"); ->F FM(8): PRINTSTRING("SPEC"); ->F FM(9): PRINTSTRING("%END"); ->MISS FM(10): PRINTSTRING("%CYCLE"); ->MISS FM(11): PRINTSTRING("%REPEAT"); ->MISS FM(12): ˙PRINTSYMBOL('"'); PRINT NAME(X); PRINTSYMBOL('"'); ->MISS FM(13): PRINTSTRING("%START"); ->MISS FM(14): PRINTSTRING("%FINISH"); ->MISS FM(15): PRINTSTRING("ORDER"); ->F FM(16): PRINTSTRING("BOUNDS"); ->F FM(17): PRINTSTRING("RESULT") MISS: PRINTSTRING(" MISSING") F: NEWLINE %EXIT %IF STREAM = LISTING STREAM = LISTING; SELECTOUTPUT(LISTING) %REPEAT MARGIN = MARGIN+POS %AND SPACES(MARGIN+8) %IF SYM # NL POS = 0; OUT = 0 %SIGNAL 0,10 %IF N >= 20 %END ! ---- 'C GEN' DEPENDS ON A 32-BIT WORD ---- %ROUTINE C GEN(%INTEGER N) %INTEGER J, M, L M = N; N = |M| %IF N>>16 = 0 %THEN L = 4 %ELSE L = 8 PUT('N'); PUT(L+1+'0'); PUT(','); PUT('Y') PUT( (N>>J)&15+'A' ) %FOR J = (L-1)*4, -4, 0 PUT('U') %IF M < 0 LIT = CODE %END %INTEGERFN EVAL(%INTEGER P) %CONSTBYTEINTEGERARRAY BASIS('V' : 'Z')=3,1,8,4,0 %INTEGER N, J, B, S, L, MOD N=0 %RESULT = DICT(-P) %IF P < 0 L=BUFFER(P); %RESULT=0 %IF L=0 %OR L=1 B=BUFFER(P-1); %RESULT=B %IF L < 0 B=BASIS(B) MOD='A'; MOD=0 %IF B=8 %CYCLE J=P-2,-1,P-L S=BUFFER(J)-MOD %IF B=0 %THEN N=N*10 %ELSE N=N< 0) %C %OR TAG&15 = 4 %OR DECTYPE=1 %START; ! VALID REDEFINITION FLAG = FLAG!!1024; ! REMOVE SPEC BIT DECTYPE = TAG&(\128) %RETURN %FINISH %FINISH %FINISH DUP=ATOM POS %IF DUP=0 %RETURN %IF DECTYPE=0; ! LABEL %FINISH EXTRA=DP; ! APP + FORMAT TAG=DECTYPE FF=0 %IF DECTYPE = 0 %START TAG = 3; FF = 1024 %ELSE FF = FF!SPREFIX<<13 %FINISH %IF TAG&15 >= 7 %START; ! APP NEEDED FF = FF!1024 %IF SSTYPE = 2 %AND TAG&15 <= 10 CONST INT = 0 %UNLESS 11#TAG&15#13 %START %IF SPREFIX=1 %OR SPREFIX=2 %C %THEN DICT(DP)=APP %ELSE %START APARM=1; DICT(DP)=A CHAIN A CHAIN=DP %FINISH %FINISH %ELSE DICT(DP)=0 DP=DP+1; FF=FF!256; ! SET APP BIT FF=FF!1024 %IF SPEC < 0 %AND SPREFIX < 3 %FINISH %IF TAG&X'70'=X'50' %START; ! RECORD DICT(DP)=FORMAT; DP=DP+1 FF=FF!512; ! SET FOR˙MAT BIT %FINISH %IF TAG&15=6 %START; ! SWITCH DICT(DP)=0 DP=DP+1 %FINISH TAG = TAG!128 %IF SPREFIX > 3 %OR PERMIN# 0 %IF CONST INT # 0 %START DICT(DP) = 0; DP = DP+1 TAG = TAG&X'FFF0'+5 %FINISH EXTRA=DP-EXTRA; ! 1=APP, 2=APP+FORMAT, 0=NEITH DICT(DP) = TAG; TYPE=TAG>>4&7 DP=DP+1 DICT(DP) = FF!(DP-T MAX-2)!EXTRA<<11 SUBATOM=DP; TMAX=DP+1 X=DP %END %ROUTINE READ SYM %IF SYM<32 %START LINE NUM = LINE NUM+1 ATOM POS = 0; POS = 0; MARGIN = 0 %IF LIST = 0 %START WRITE(LINE NUM, 5) %IF QUOTE # 0 %THEN PRINT SYMBOL('"') %ELSE %START PRINT SYMBOL(MARK); MARK = ' ' %FINISH SPACE %FINISH SYM TYPE=1 %FINISH %CYCLE %CYCLE READSYMBOL(SYM) %IF SYM = PAGE %START LINES = 0 %AND %CONTINUE %IF QUOTE = 0 LINES = PAGE SIZE %FINISH PRINTSYMBOL(SYM) %IF LIST = 0 POS=POS+1 %AND LINE(POS)=SYM %UNLESS POS >= 73 %RETURN %IF QUOTE#0 %EXIT %IF SYM#' ' SYM TYPE=1 %REPEAT %EXIT %UNLESS SYM='%' SYM TYPE=2 %REPEAT %IF SYM<32 %THEN SYMTYPE=0 %AND MARK='+' %ELSE %START SYM=SYM-32 %IF 'A'+32 <= SYM <= 'Z'+32; ! ...CONVERT LOWER CASE KEY=KDICT(SYM) SYM TYPE=KEY&3-2 %UNLESS KEY&3=0 %AND SYMTYPE=2 %FINISH %END %ROUTINE LOOKUP(%INTEGER P) %INTEGER OLD, NEW, L, DISP, D, SIZE, FIRST COUNT=0; SIZE = DP-TMAX+1; FIRST = DICT(T MAX) %WHILE P > LIM %CYCLE COUNT = COUNT-1 P=P-1 D=DICT(P) DISP=D&255+2 L=D>>11&3; OLD=P-DISP; X=P; P=OLD %IF SIZE+L-DISP=0 %AND DICT(OLD) = FIRST %START NEW=T MAX %CYCLE NEW = NEW+1; OLD = OLD+˙1 %IF NEW=DP %START; ! FOUND IT O TYPE = D>>13 TAG = DICT(X-1) ATOM2=CMAP(TAG&15); ! FORM -> CLASS SUB ATOM=X; VAR TYPE=TAG>>4&7 ATOM2 = 66 %IF VARTYPE = 0 %AND ATOM2 = 68 ATOM1 = ATOM2 %AND SUBATOM = -OLD %IF ATOM2 = ICONST %IF D&256#0 %START; ! SET APP PAPP=|DICT(OLD)| %IF PAPP=0 %START %IF 11 <= TAG&15 <= 12 %START PAPP=PHRASE(ANAPP) APARM=OLD<<3+1; ! 1 DIMEN %ELSE F TYPE=8 %RETURN %IF SPEC < 0 ATOM1=0; ATOM2=0 %FINISH %FINISH OLD=OLD+1 %FINISH %ELSE PAPP=APP; ! DEFAULT APP FORMAT=0 %IF D&512#0 %START %IF ATOM2=RFN %THEN FORMAT=SUBATOM %ELSE %START FORMAT=DICT(DICT(OLD)-2) ATOM2=ATOM2+7 %FINISH %FINISH DICT(X-1)=DICT(X-1)!128 %UNLESS SPEC < 0 SUBATOM=COUNT %IF LIM > T MAX %RETURN %FINISH %EXIT %IF DICT(NEW) # DICT(OLD) %REPEAT %FINISH %REPEAT %END %ROUTINE CODE DIGIT %IF LIMIT=0 %START; ! MULTI CHAR DIGIT = SYM %IF DIGIT = '''' %START QUOTE = 0 READSYM DIGIT = -1 %AND %RETURN %UNLESS SYM = '''' QUOTE = 1 %FINISH READSYM %ELSE %IF '0' <= SYM <= '9' %OR 'A' <= SYM <= 'F' %START %IF SYM <= '9' %THEN DIGIT = SYM-'0' %C %ELSE DIGIT = SYM-'A'+10 %IF DIGIT <= LIMIT %START DIGIT = DIGIT+'A' ˙ READ SYM %RETURN %FINISH %FINISH DIGIT=0; QUOTE=0 %IF SYM='''' %START %IF LIMIT # 9 %START DIGIT = -1; READSYM %FINISH %FINISH %FINISH %END %ROUTINE CODE ATOM %INTEGER TP %ROUTINE TPUT(%INTEGER S) POS = 0 %IF S < 32 FAULT(20) %IF TP = TEXT LIMIT TP = TP+1; BUFFER(LITPOS-TP) = S %END %INTEGERNAME SS %INTEGER DTYPE, XTYPE, SRMOD, SLEN, PREFIX %INTEGER J, K, L, S, LP %CONSTBYTEINTEGERARRAY BASE SYM(1 : 4)= 'X', 'M', 'B', 'K' %CONSTSHORTINTEGERARRAY BASE INF(1:4)= X'590F',X'5800',X'5701',X'5607' %CONSTSHORTINTEGER SPS=117; ! START OF SPEC SUB %CONSTBYTEINTEGERARRAY SPEC SUB(SPS : 127)=%C 8,9,10,7,105,104,25,24,72,73,1 %CONSTSHORTINTEGERARRAY P VALUE(0 : 10)=%C 0, X'1827'(2), X'1067', X'0127'(2),X'10A7', X'00A7',X'2418',X'4418', X'2218' %CONSTSHORTINTEGERARRAY SATOMS(1 : 12) = ! SPEC, NAME, MAP, MAPSPEC, , X'0035', X'3835', X'3238', X'0032', X'3835', ! ARRAY ARRAYNAME ARRAYSPEC NAMESPEC ARRAYNAMESPEC, X'0033', X'3835', X'0033', X'3835', X'3835', ! FN, FNSPEC X'3238', X'0032' %CONSTBYTEINTEGERARRAY SCLASS(1 : 12) = ! SPEC, NAME, MAP, MAPSPEC, , 109, 2, 9, 118, 1, ! ARRAY, ARRAYNAME,ARRAYSPEC,NAMESPEC, ARRAYNAMESPEC, 11, 12, 111, 110, 112, ! FN, FNSPEC 8, 117 %CONSTINTEGER XSPS = 109 %CONSTINTEGERARRAY XMOD(XSPS : 116) = 17,18,27,28,97,98,107,108 LP=LIT POS ATOM POS=POS; LAST=ATOM1 %IF QUOTE#0 %START; ˙ ! CONTINUATION OF STRING CONST TP=0 TPUT(QUOTE>>8); TPUT(QUOTE&255) %CYCLE READSYM %IF SYM= DELIM %START QUOTE=0 READSYM; %EXIT %IF SYM# DELIM QUOTE=1 %FINISH TPUT(SYM) %REPEAT BUFFER(LIT POS)=TP LITPOS=LITPOS-TP-1 %FINISH SLEN=0; XTYPE=0; SRMOD=0; PREFIX=0 %CYCLE ATOM1=0; ATOM2=0; SUB ATOM=0; TAG=0 ATOM1=TERMIN %AND %RETURN %IF SYMTYPE=0 %IF SYMTYPE=-1 %START; ! DIGIT %UNLESS (LAST=0 %AND OUT=0) %OR LAST=8%START LIMIT=9; DIGIT='Z' NEW BASE: ATOM1=ICONST; ATOM2 = ICONST %CYCLE LIT POS=LIT POS-1 BUFFER(LIT POS)=DIGIT CODE DIGIT %IF DIGIT <= 0 %START %IF LIMIT = 9 %AND SYM = '.' %AND ATOM1 = ICONST %START DIGIT = '.' ATOM1 = RCONST; ATOM2 = RCONST LP = LP-1 READ SYM %ELSE ATOM1=0 %IF LIMIT#9 %AND DIGIT=0 BUFFER(LP)=LP-LITPOS LIT POS=LIT POS-1 SUBATOM=LP FAULT(23) %IF LITPOS <= 0 %RETURN %FINISH %FINISH %REPEAT %FINISH %FINISH %IF SYM TYPE < 0 %START; ! LETTER DP=T MAX OLD SYM=SYM ! ---- THE FOLLOWING PACKING ROUTINE IS WORD-LENGTH DEPENDENT BUT CAN ! BE MODIFIED WITH NO OTHER SIDE-EFFECTS PROVIDED COMPLEMENTARY ! ALTERATIONS ARE MADE TO 'UNPACK' IN ROUTINE 'PRINT NAME' ---- %CYCLE SS == DICT(DP) SS = SYM-32 READ SYM; %EXIT %IF SYM TYPE >= 0 OLD SYM=0 SS = (SS<<6) + (SYM-32) READ SYM;˙ %EXIT %IF SYM TYPE >= 0 SS = (SS<<6) + (SYM-32) READ SYM; %EXIT %IF SYM TYPE >= 0 SS = (SS<<6) + (SYM-32) READ SYM; %EXIT %IF SYM TYPE >= 0 SS = (SS<<6) + (SYM-32) READ SYM; %EXIT %IF SYM TYPE >= 0 DP=DP+1 %REPEAT %IF SYM='''' %AND OLD SYM # 0 %START DELIM = '''' %CYCLE J=1,1,4 %IF OLD SYM=BASE SYM(J) %START QUOTE = 1 K=BASE INF(J) DIGIT=K>>8; LIMIT=K&255 READSYM -> NEW BASE %FINISH %REPEAT %FINISH DP=DP+1 FAULT(21) %IF DP >= T LIMIT ATOM1=IDENT; ATOM2=IDENT LIM=T BASE; LOOKUP(T MAX) %RETURN %FINISH %IF SYM='''' %OR SYM = '"' %START DELIM = SYM QUOTE=1; ! INTO TEXT MODE ATOM1=SCONST; ! SYMBOL, OR ATOM2=ICONST; ! STRING READSYM; SUB ATOM=SYM; ! FIRST CHAR QUOTE=0 %IF SUBATOM=DELIM READSYM %IF SUBATOM=DELIM %START; ! ' ' FOUND %IF SYM#DELIM %START; ! NULL SYMBOL OR STRING SUB ATOM=NULL STRING; %RETURN %FINISH ! ' ' ' FOUND QUOTE=1 READSYM; ! '' -> ' %FINISH %IF SYM=DELIM %START; ! FOUND DELIM %OR '?' QUOTE=0 READ SYM; ! SKIP QUOTE %IF SYM#DELIM %START LITPOS=LITPOS-2 BUFFER(LITPOS+2)=-1 BUFFER(LITPOS+1)=SUBATOM SUBATOM=LITPOS+2 %RETURN %FINISH %FINISH QUOTE=SUBATOM<<8+SYM; ˙ ! PRESERVE SYMBOLS ATOM2=SCONST; ! IT MUST BE A STRING SUBATOM=LITPOS %RETURN %FINISH DP=KEY>>2; ! INDEX INTO DICT READ SYM; ! GET NEXT SYMBOL %CYCLE S=KDICT(DP) %EXIT %IF S&X'4000'#0; ! END OF LIST MARKER %IF S&127#SYM %OR SYMTYPE < 0 %START ATOM POS=POS %AND %RETURN %IF S >= 0 DP=DP+1; ! ONTO ALTERNATIVE %ELSE K = S>>7&127; READ SYM %IF S > 0 %START %IF K # 0 %START ATOM POS = POS %AND %RETURN %IF K#SYM %OR SYMTYPE<0 READ SYM %FINISH K = 1 %FINISH DP = DP+K %FINISH %REPEAT ATOM1=S&63; ! PICK OFF CLASS SUB ATOM=S>>6&255 %EXIT %IF ATOM1#0 L=P VALUE(SUBATOM) %IF L#0 %START %RETURN %IF PREFIX&L&63 # 0 %OR (LAST # 0 %AND L&1 # 0) PREFIX=PREFIX!L>>6 XTYPE=SUBATOM %IF SUBATOM <= 7 %FINISH ATOM POS=POS %REPEAT; ! ROUND FOR ANOTHER ATOM2=KDICT(DP+1)&63 %IF S < 0; ! VARIANT %IF ATOM1=STRING %OR ATOM1=RECORD %START DTYPE=ATOM1 CODE ATOM %IF DTYPE=STRING %START ATOM1=0 %AND %RETURN %UNLESS ATOM1=ICONST SLEN=EVAL(SUBATOM); ! STRING LENGTH %UNLESS 0 < SLEN <= TEXT LIMIT %START ATOM1=0; F TYPE=4 %RETURN %FINISH SRMOD=X'40'; ! TYPE FOR STRING %ELSE %IF ATOM2=IDENT %START LIM=GLOBAL; LOOKUP(T BASE) %FINISH %UNLESS ATOM2 = RFN %START F TYPE = 3 ATOM1 = 0; ATOM2 = 0 %RETURN %FINISH˙ SRMOD=X'50'; ! TYPE FOR RECORD %FINISH CODE ATOM ATOM1=0 %AND %RETURN %IF ATOM1#RB %IF SYM TYPE=2 %START; ! KEYWORD FOLLOWS CODE ATOM %IF ATOM1 # SPECIAL %AND ATOM2 # SPECIAL %START ATOM1 = 0; ATOM2 = 0; %RETURN %FINISH SUBATOM = 1 %IF SUBATOM = 127;! SPEC %FINISH %ELSE SUBATOM=5; ! NULL SPECIAL ATOM1=0 %AND %RETURN %C %IF DTYPE=RECORD %AND SUBATOM >= 11 K=SATOMS(SUBATOM) ATOM1=K&255; ATOM2=K>>8&255 SUBATOM=SCLASS(SUBATOM) %ELSE %UNLESS PRE1 <= ATOM1 <= PRE2 %START ATOM1=0 %IF PREFIX#0 %RETURN %FINISH %FINISH %IF SUBATOM >= SPS %START SPEC = -1; SUBATOM = SPEC SUB(SUBATOM) %ELSE %IF SUBATOM >= XSPS %IF XTYPE # 6 %START ATOM1 = 0; ATOM2 = 0; %RETURN %FINISH XTYPE = 3; ! EXTRINSIC!! SUBATOM = XMOD(SUBATOM) SRMOD = SRMOD-X'10' %IF SRMOD # 0 %FINISH %IF PREFIX&64#0 %START; ! OWN DATA %UNLESS ATOM1 = OWN1 %OR ATOM1 = OWN2 %START;! NON-DATA %IF XTYPE <= 3 %START; ! CONSTROUTINE ? ATOM1 = 0; %RETURN %FINISH %ELSE ATOM1=ATOM1+1; ! ONTO '%OWN' VARIANT OUT=(SUB ATOM+SRMOD)>>4 %IF SUBATOM&1 = 0 %START; ! CONSTNAME ? OUT = 1; ! ADDRESSES ARE INTEGERS %ELSE CONST INT = 1 %IF XTYPE = 2 %C %AND (SUBATOM+SRMOD)&X'70' <= X'30' %FINISH OUT = 15 %IF XTYPE = 3; ! DON'T INITIALIZE EXTRINSICS %FINISH %FINISH SUBATOM=SUBATOM+LREALS %IF SUBATOM&X'70'=X'60' SUBATOM=SUBATOM+SLEN<<8+SRMOD+(PREFIX>>3&X'70') DEC TYPE=SUBATOM SPREFIX=XTYPE PREFIX=0 %END !*******************˙****************************************** !* DEC TYPE: * !************************************************************* %INTEGERFN GAPP %CONSTINTEGER PSEP = 129, PCALL = 130 %INTEGER L, P, TYPE, NEXT, C %INTEGERFN CLASS(%INTEGER T) %CONSTBYTEINTEGERARRAY EXPS(0 : 7)=0,147(3),140,0,146(2) %CONSTBYTEINTEGERARRAY PARM MAP(0 : 15)=0,0,137,0,0,0,0,122, 176,177,123,0,159,0,0,0 %CONSTBYTEINTEGERARRAY TMOD(0:7) = 0,8(3),4,0,9,9 TYPE = T>>4 TYPE = TMOD(TYPE) %AND %RESULT = EXPS(T>>4) %IF T&15 = 1;! EXPRN TYPE = 10 %IF TYPE = 0 %RESULT=PARM MAP(T&15); ! CORRECT CLASS FOR NAMES %END %ROUTINE SET GCELL(%INTEGER C, GC, LEN) C = C<<9; C = C+L %UNLESS GC = PCALL %WHILE L#GLIMIT %CYCLE L=L+1 %RETURN %IF GRAM(L)=C %AND GCLASS(L) = GC %C %AND (TAG&X'70'#X'40' %OR GRAM(L-1)=LEN) %REPEAT %IF TAG&X'70'=X'40' %START GLIMIT=GLIMIT+1; GRAM(GLIMIT)=LEN; ! SET STRING LE %FINISH GLIMIT=GLIMIT+1; GRAM(GLIMIT)=C; GCLASS(GLIMIT) = GC L=GLIMIT %IF DIAG&4 # 0 %START PRINTSTRING("SET"); WRITE(L, 3) WRITE(C, 3); WRITE(GC, 3); WRITE(LEN, 3) NEWLINE %FINISH %END %RESULT = NULL %IF TBASE=TMAX L = GBASE; P = TMAX SET GCELL(0, PCALL, 0) %CYCLE P = P-1 NEXT = P-DICT(P)&255-2 TAG = DICT(P-1) C = CLASS(TAG&127) SET GCELL(TYPE, C, TAG>>8&255) %EXIT %IF NEXT <= TBASE P = NEXT SET GCELL(0, PSEP, 0) %REPEAT SET GCELL(0, LB, 0) FAULT(23) %IF GLIMIT >= GMAX %RESULT=L %END %ROUTINE HEX(%INTEGER N) %INTEGER J,K %CYCLE J = 1, 1, 4 K = N>>12; N = N<<4 %IF K > 9 %THEN K = K-10+'A' %ELSE K = K+'0' PRINTSYMBOL(K) %REPEAT ˙ %END %ROUTINE ANALYSE(%INTEGER G) %SWITCH DIR(86:102) %INTEGER EXTEND, AMBIG, SUB LOCK, DOWN LOCK %INTEGER J, K, L, N, A1, NODE, NEW TYPE, T %ROUTINE REORDER %INTEGERNAME X, Y %INTEGER R K=0 %WHILE N < 0 %CYCLE R=REF(N); J=CO(N) %IF LOC(N)&X'FF' > TRANSP %START;! DROP TRANSPARENT X == K; R=R&X'6000'; ! PICK OFF ORDER %WHILE X#0 %CYCLE Y == REF(X) %EXIT %IF Y&X'6000' <= R Y=Y-X'2000'; ! DECREMENT ORDERING CODE X == CO(X); ! ON DOWN THE CHAIN %REPEAT CO(N)=X; X=N %FINISH N=J %REPEAT %IF DIAG&8 # 0 %START PRINTSTRING("REORDER N ="); WRITE(N, 3); NEWLINE %FINISH %END %ROUTINE SHOW(%INTEGER Z) WRITE(Z, 3) PRINTSTRING(" [") HEX(REF(Z)) SPACE; HEX(CO(Z)) SPACE; HEX(SUB(Z)) SPACE; HEX(LOC(Z)) PRINTSYMBOL(']'); NEWLINE %END EXTEND=0; SUB LOCK = 0; DOWN LOCK = 0 A=0; A1=0; N=0; NODE=0 AMBIG=0 P = RECLEN L1: J=GRAM(G); K = GCLASS(G); ->EOP %IF K = 0 NEW TYPE = J>>9&15 NEW TYPE = TYPE %IF NEW TYPE = 0 %IF DIAG&1 # 0 %START WRITE(G, 4); WRITE(K, 3) WRITE(ATOM1, 3); WRITE(ATOM2, 3); WRITE(SUBATOM, 3) WRITE(TYPE, 2); WRITE(FORMAT, 3) NEWLINE %FINISH %IF K >= PHRASES %START; ! PHRASE P=P+1; F TYPE=4 %AND -> ERROR %IF P=A REF(P)=J; CO(P)=N LOC(P)=TYPE<<8+K TYPE=NEW TYPE SHOW(P) %IF DIAG&8 # 0 N=-P G=PHRASE(K) -> L1 %FINISH CLASS=K CLASS=ATOMIC(CLASS) %IF CLASS >= EQUIVS ->DIR(CLASS) %IF CLASS >= DIRECTIVES %IF ATOM2=IDENT %AND (DEF1 <= CLASS <= DEF2 %OR CLASS = ICONST)%START LIM=GLOBAL; LOOKUP(T BASE) ˙ %FINISH %IF SET1 <= CLASS <= SET2 %AND %C (OTYPE#2 %OR ATOM2=68 %OR ATOM2=70) %START CLASS = CLASS+7; TYPE = TAG>>4&7 %FINISH NEW TYPE=TYPE %IF CLASS=ATOM1 %OR CLASS=ATOM2 %START %IF CLASS = IDENT %START DECLARE IDEN TYPE = 15 %IF NEWTYPE = 15 %FINISH %IF CHECK1 <= CLASS <= CHECK2 %START %IF VAR TYPE#TYPE %START %UNLESS VARTYPE <= 3 %AND (TYPE=8 %OR TYPE=9) %START %UNLESS VARTYPE >= 6 %AND TYPE=9 %START %UNLESS TYPE = 10 %START F TYPE = 2; ->ALT %FINISH %FINISH %FINISH %FINISH F TYPE=0 %FINISH ENTRY: A=A-1; F TYPE=4 %AND -> ERROR %IF A=P REF(A)=J; CO(A)=N LOC(A)=TYPE<<8+K TYPE=NEW TYPE SUB(A)=SUBATOM SHOW(A) %IF DIAG&8 # 0 ->DONE %IF J&511 = 511; ! END OF SS -> NEXT %IF AMBIG=0; ! NOT AMBIGUOUS G=AMBIG; AMBIG=0; -> L1 %FINISH ALT: G=G+1; -> L1 %IF J < 0; ! TRY ALTERNATIVE NEXT: %IF NODE=A1 %START; ! LAST NODE FOR THIS ATOM EXTEND=0; SUB LOCK=0; DOWN LOCK = 0 -> ERROR %IF NODE=A; ! NO NEW NODES A1=A CODE ATOM %IF CLASS < DIRECTIVES; ! GET NEXT ATOM %FINISH NODE=NODE-1; N=NODE %IF EXTEND#0 %START K = LOC(N)&255 %IF K # 0 %START J=REF(N) TYPE = LOC(N)>>8 N=CO(N); ! WELL ? -> ENTRY %FINISH %FINISH -> SKIP EOP: REORDER N=-N; SUB(N)=K SKIP: ! ON DOWN CHAIN G=REF(N)&511; -> EOP %IF G=0 TYPE=LOC(N)>>8 -> L1 DIR(89): ! %COLON -> ERROR %UNLESS ATOM1=3; ! LOOK FOR COLON DONE: N=A; REORDER; SS=K %RETURN %˙IF DUP=0 F TYPE=7 ERROR: QUOTE=0 %AND READSYM %WHILE NL#SYM#';' %IF F TYPE=0 %START %IF ATOM1=IDENT %AND LIM=GLOBAL %START F TYPE=3 %ELSE %IF ATOM1 = 0 FTYPE = 1 %ELSE %IF SCONST <= ATOM1 <= RCONST FTYPE = 2 FTYPE = 5 %IF TYPE = 15 %FINISH %FINISH FAULT(F TYPE) QUOTE=0; SYMTYPE=0; DEC TYPE=0 PREFIX=0; SPREFIX=0; CONST INT = 0 %RETURN DIR(86): ! %INT -> ALT %IF TYPE > 3 %AND TYPE#8; ! NOT INTEGER DCONT: G = J&511 -> EOP %IF G=0; ! END OF PHRASE -> L1 DIR(87): ! %REAL -> ALT %IF TYPE < 6 %OR TYPE=8 %OR TYPE = 15;! NOT REAL -> DCONT DIR(88): ! %STR -> ALT %IF TYPE#4; ! NOT STRING -> DCONT DIR(90): ! %FN %IF BLOCK TYPE&15 # 8 %START; ! NOT A FUNCTION ->DALT %IF DIAG >= 0 %OR BLOCKTYPE&15 # 9; ! OR A FUNNY MAP %FINISH TYPE=BLOCK TYPE>>4&7 %IF TYPE <= 3 %THEN TYPE=8 %ELSE %START TYPE=9 %IF TYPE >= 6 %FINISH -> DCONT DIR(91): ! %M -> DALT %IF BLOCK TYPE&15#9; ! NOT A MAP TYPE=BLOCK TYPE>>4&7 -> DCONT DIR(94): ! %SUB -> DCONT %IF SUB LOCK#0 -> ALT %UNLESS ATOM1=U LINE -> ERROR %IF SYMTYPE # -2 L=FORMAT CODE ATOM ATOM2=0 F TYPE=8 %AND -> ERROR %IF L <= 0 LIM=DICT(L); ! ONTO THE END LOOKUP(L); ! LOOK FOR SUBNAME F TYPE=3 %AND -> ERROR %IF ATOM2=0 ! NOT FOUND SUB LOCK=1 -> DCONT DIR(95): ! %APP -> ALT %UNLESS ATOM1=LB -> DCONT DIR(97): ! %SETPLUS PAPP = APP ˙L = PHRASE(152+APARM&7) DICT(APARM>>3)=L %IF APARM&X'FFF8'#0 %WHILE A CHAIN#0 %CYCLE T=A CHAIN; A CHAIN=DICT(T); DICT(T)=L %REPEAT ! SET APP FOR ARRAY -> DCONT DIR(98): ! %PLUS F TYPE=4 %AND -> ERROR %IF APARM&7=6 APARM=APARM+1 -> DCONT DIR(99): ! %AMBIG AMBIG=J&511 -> ALT DIR(100): ! %DUMMY EXTEND = 1 %IF A1 # A A1 = A1-1; K = 0 ->ENTRY DIR(101): ! %LUP DICT(T LIMIT-2)=APARM DICT(T LIMIT-1)=FORMAT ->DCONT %UNLESS NODE = A1 TLIMIT = TLIMIT-2; FAULT(23) %IF T LIMIT <= T MAX -> DCONT DIR(102): ! %LDOWN ->DCONT %IF DOWN LOCK # 0 DOWN LOCK = 1 APARM=DICT(T LIMIT ) FORMAT=DICT(T LIMIT+1) T LIMIT = T LIMIT+2 %IF NODE = A1 -> D CONT DALT: F TYPE=5; ! CONTEXT -> ALT %END; ! OF ANALYSE FORMAT=0; APARM=0; RELOCATE=0 LITPOS=400 SS=0; DEC TYPE=0; DUP=0; CONST INT = 0 PREFIX=0; SPREFIX=0 A CHAIN=0; F TYPE=0; MARK = ' ' %IF CONT=0 %START MARGIN = MARGIN+POS %IF SYM TYPE=0 %START POS=0; READ SYM %FINISH ATOM1=0 %IF SYMTYPE=0 %OR SYM='!' %START SKIP: READSYM %WHILE SYMTYPE#0 %RETURN %FINISH CODE ATOM; -> SKIP %IF ATOM1=COMMENT STATS=STATS+1 OP('O',LINE NUM) %IF PERMIN = 0; ! DUMP LINE NUMBER %IF ATOM1 = MCODE %AND SUBATOM = 1 %START CODE ATOM %IF ATOM2 = IDENT %START LIM = GLOBAL; LOOKUP(T BASE) %FINISH FAULT(0) %IF ATOM2 # ICONST CGEN(EVAL(SUBATOM)); PUT('P') %RETURN %FINISH TYPE=0 %IF ATOM1=IDENT %AND (SYM=':' %OR ATOM˙2=SWITCH) %START DEC TYPE=3 SS TYPE=0; ANALYSE(PHRASE(SS0));! LABEL %ELSE %IF DEC TYPE#0 %OR OUT#0 %START TYPE=OUT SS TYPE=1; ANALYSE(PHRASE(SS1));! DECLARATION %ELSE SS TYPE=3; ANALYSE(PHRASE(SS3));! STATEMENT %FINISH %FINISH %RETURN %FINISH CODE ATOM %IF CONT > 0 %START; ! APP SS TYPE=2; ANALYSE(PHRASE(SS2)); ! FORMAL PARAMETER J=GAPP FAULT(6) %IF 0#|FPP|#J FPP=J*SPEC %ELSE; ! RECORDFORMAT FP=TMAX; ! REMEMBER START OF NAMES SS TYPE=4; ANALYSE(PHRASE(SS4)) %IF SS#0 %AND TMAX > FP %START J=T LIMIT+TBASE-TMAX-1 FAULT(21) %IF J <= TMAX FPP=T LIMIT-1; ! FILL IN FORMAT REFERENCE DICT(FPP)=J; ! END OF FORMAT RELOCATE=J-FP %CYCLE K=J,1,FPP-1 DICT(K)=DICT(FP) FP=FP+1 %REPEAT T LIMIT=J %FINISH %FINISH %END; ! ANALYSE SS %ROUTINE COMPILE SS %CONSTBYTEINTEGERARRAY RCOMP(33:40)=34,33,35,36,38,37,39,40 %CONSTBYTEINTEGERARRAY COMP(33:40)='>','<','=','#',')','(',116,107 ! 116 = LOWER CASE 'T', 107 = LOWER CASE 'K' %CONSTBYTEINTEGERARRAY CON OP(82 : 84)='''', 'N', 'D' %CONSTBYTEINTEGERARRAY OPCODE(1:10)='*','/','&','!', '%','[',']','.','\',120 ! 120 = LOWER CASE 'X' %SWITCH C(1 : 130), D(50 : 57) %BYTEINTEGERNAME MM %INTEGERNAME M %INTEGER L, DIM, K %OWNINTEGER OWN DEF=0 %OWNINTEGER BP SIZE=0 %INTEGER CALL PENDING, PRED PENDING, PRED OP %INTEGER GLOBAL NOT, LOCAL NOT %INTEGER CLAST, CMOD, OPS, BIT, CLEVEL, DOUBLE %INTEGER PLAB, LOOP LAB, ULAB, CONDS, ELSE %INTEGER LIT1, LIT2, STARTT ˙ %INTEGER NEXT, CLASS, DCLASS, LINK %ROUTINE AOP(%INTEGER C, A) PUT(C) %IF A < 0 %START A = -A; PUT('-') %ELSE A = A//2 %FINISH ADDR(A) %END %ROUTINE EXTRA(%INTEGER N) PUT(','); ADDR(N) %END %ROUTINE DEF(%INTEGER N) %INTEGER K N=N+RELOCATE AOP('$',N); PRINT NAME(-N) K=DICT(N-1) EXTRA(K&127); ! TYPE!FORM EXTRA(K>>8&255); ! MAX STRING LENGTH EXTRA(DICT(N)>>13&7); ! OTYPE ! RECORD AOP(',',DICT(N-2)) %IF K&X'70'=X'50' %AND K&127#84 %END %ROUTINE CALL %INTEGER P CALL PENDING = 1 AOP('@',X) P = X P = P-1 %IF DICT(X)&512 # 0 %IF |DICT(P-2)| = NULL %START PUT('E'); CALL PENDING = 0 %ELSE PRED PENDING = PRED PENDING<<1 %FINISH %END %ROUTINE SET SIZE BP SIZE=LIT1-LIT2+1 %IF BPSIZE <= 0 %START ATOM POS=0; FAULT(4) BP SIZE=1 %FINISH PUT('B'+32); ADDR(BP SIZE) %END %ROUTINE POP LAB(%INTEGER MODE) %INTEGER L %IF LABEL > OLD LABEL %START L = LAB INF(LABEL>>2) %IF (L!!MODE)&1 # 0 %START LABEL = LABEL-4; P LAB = LABEL EILAB = PLAB+1 %IF L&4 # 0 P LAB = P LAB+1 %IF L&3 = 3 PLAB = 0 %IF L&8 = 0; ! NO EXIT CONDITION %RETURN %FINISH %FINISH %IF MODE = 0 %THEN MODE = 13 %ELSE MODE = 10 FAULT(MODE); ACCESS = 1 %END %ROUTINE C END %INTEGER L, T,LIM, FLAG %IF X=88 %START; ! ENDOFPERM STATS=0; LINE NUM=0 LIST=LIST&1; DEC TYPE=0 SELECTINPUT(PROG); ! ONTO SOURCE PROGRAM PERMIN = 0; ! S˙HOW NOT IN PERM %RETURN %FINISH ATOM POS = 0; FLAG = SYM %IF LEVEL = 1 %AND X # EOP %AND FILE = 2 %START DEC TYPE = EOP; FAULT(5) %FINISH LIM = T BASE %IF X=EOP %OR X=EOF %START; ! EOP X = X-EOF; ! EOF -> 0, EOP -> L1 FAULT(5) %UNLESS X = LEVEL PUT(';') %WHILE LEVEL > 1 %CYCLE FAULT(9) LEVEL=LEVEL-1 %REPEAT LIM = GLOBAL; ! GIVE UNUSED FOR GLOBALS %ELSE FAULT(5) %IF LEVEL <= 1 %AND FILE = 2 PUT(';') %FINISH %WHILE LABEL > OLD LABEL %CYCLE L=LABINF(LABEL>>2) %IF L&7=2 %THEN L=11 %ELSE L=14 LABEL=LABEL-4 FAULT(L) %REPEAT FAULT(17) %IF ACCESS # 0 %AND 8 <= BLOCKTYPE&15 <= 10 X=T MAX-1 %WHILE X > LIM %CYCLE T=DICT(X) %IF DICT(X-1)&128=0=LIST %AND T&X'400' = 0 %START %IF CONTROL&X'1000' = 0 %START %IF FLAG # NL %START MARGIN = MARGIN+POS NEWLINE FLAG = 0 %FINISH PRINTSTRING("? ") PRINT NAME(X) PRINTSTRING(" UNUSED ") %FINISH %FINISH FAULT(12) %IF T&X'400'#0 X=X-T&255-3 %REPEAT printsymbol(11) SPACES(MARGIN+8) %IF FLAG = 0 %END FAULT(24) %IF LABEL < 4 %OR LABEL > MAX LAB<<2 %IF ACCESS = 0 %AND SSTYPE = 3 %AND 33 # LOC(-1)&255 # 34 %START FAULT(18) %IF CONTROL&X'1000' = 0; ACCESS = 1 %FINISH CONDS=0; DIM=0; PRED PENDING = 0; PRED OP = 0 STARTT=0; ! DEFAULT TO CYCLE PLAB=0; ULAB=0; LOOP LAB=0; ELSE = 0; EILAB = 0 LIT1=0; LIT2=0 NEXT=SS; LINK=0 LIT=0 DCLASS = 0 TOP: %CYCLE X=SUB(NEXT) %EXIT %UN˙LESS X < 0 %AND NEXT <= P %IF CO(NEXT)#0 %START SUB(NEXT)=LINK; LINK=NEXT %FINISH NEXT=X %REPEAT CLASS=LOC(NEXT)&255 %IF DIAG&2 # 0 %START PRINTSTRING("C ="); WRITE(CLASS, 3) PRINTSTRING(" X ="); WRITE(X, 3) PRINTSTRING(" NEXT ="); WRITE(NEXT, 3) NEWLINE %FINISH NEXT=CO(NEXT) -> C(X) %IF CLASS < PRE1 -> CONT %IF CLASS=APPEP -> C(CLASS) %UNLESS CLASS=IDENT -> D(DCLASS) ACONT: ACCESS = 0 C(112): ! %AND (UI) CONT: %CYCLE ->TOP %IF NEXT#0 ->RETURN %IF LINK=0 NEXT=CO(LINK); LINK=SUB(LINK) %REPEAT C(9): ! '\' %IF CLASS = 45 %START;! LOGICAL NOT LIT1=\LIT1 %AND LIT = LIT+1 %IF LIT=CODE %ELSE X = 10 %FINISH C(1): ! '*' C(2): ! '/' C(3): ! '&' C(4): ! '!' C(5): ! '!!' C(6): ! '<<' C(7): ! '>>' C(8): ! '.' PUT(OPCODE(X)); -> CONT C(46):PUT('Q'); ->CONT;! REAL DIVIDE C(10): PUT('M'); -> ACONT; ! %RESULT== C(11): PUT('+') %UNLESS CLASS=44; ! UNARY PLUS -> CONT C(12): %IF CLASS#43 %THEN PUT('-') %ELSE %START LIT1=-LIT1 %AND LIT = LIT+1 %IF LIT=CODE PUT('U') %FINISH -> CONT C(13): PUT('X'); ->CONT; ! \\ C(14): PUT('Y'+32); DIAG = LIT1; -> CONT; ! DIAG C(15): PUT('Z'+32); CONTROL = LIT1; -> CONT; ! CONTROL C(16): PUT('V'); -> ACONT; ! %RESULT= C(17): %IF BLOCKTYPE # 7 %START FAULT(5) %UNLESS DIAG < 0 %AND BLOCKTYPE&15 = 8 %FINISH PUT('R'); -> ACONT; ! RETURN C(18): PUT('T'); -> PREDT; ˙ ! TRUE C(19): PUT('K'); ! FALSE PREDT: FAULT(5) %UNLESS BLOCKTYPE = 10 ->ACONT C(20): PUT(101); -> ACONT; ! %SIGNAL C(44):LIT2 = 0; ! %ON %EVENT FAULT(15) %IF INHIBIT&1 # 0 INHIBIT = INHIBIT!1 %CYCLE %EXIT %IF NEXT = 0 X = SUB(NEXT) %EXIT %IF (X < 0 %AND NEXT <= P) %OR LOC(NEXT)&255 # ICONST NEXT = CO(NEXT) LIT1 = EVAL(X) FAULT(16) %AND LIT1 = 0 %UNLESS 0 <= LIT1 <= 15 LIT2 = LIT2!(1<CONT C(21): PUT('S'+32); -> ACONT; ! %STOP C(22): LIST=LIST&2; -> CONT; ! %LIST C(23): LIST=LIST!1; -> CONT; ! %ENDOFLIST C(24): LREALS=16; -> CONT; ! %REALSLONG C(25): LREALS=0; -> CONT; ! %REALSNORMAL C(109):PUT('S'); -> CONT; ! 'EQ' C(45): PUT('Z'); -> CONT; ! EQEQ C(26): ! EXIT C(27): ! CONTINUE L=LABEL %WHILE L > OLD LABEL %CYCLE %IF LABINF(L>>2)&7=2 %START;! CYCLE FOUND %IF X = 26 %START MM == LABINF(L>>2) MM = MM!8 L = L-2; X = 'F' %ELSE X = 113 %FINISH OP(X,L-2) -> ACONT %FINISH L=L-4 %REPEAT FAULT(10); ->CONT C(31): ULAB=LABEL+3; OP(117,ULAB); ! UNTIL C(30): LOOP LAB=LABEL+2; DEF LAB(LOOP LAB);! WHILE C(28): ! IF C(29): ! UNLESS EILAB = PLAB %IF ELSE # 0 INHIBIT = INHIBIT!1 CONDS=1; DOUBLE=0 STARTT=(X-26)>>1+8 GLOBAL NOT=0; C LAST=1 CMOD=0; CLEVEL=1; OPS=1 LOCAL NOT=X&1; P LAB=LABEL CNEST(0)=P LAB; CNEST(1)=P LAB -> CONT C(32): LOCAL NOT=LOCAL NOT!!1; -> CONT;˙ ! %NOT C(79): CALL; ! P PRED OP = 4 ->PAC %IF CALL PENDING = 0 PRED PENDING = PRED PENDING!2 ->CONT C(108): PUT('C'); ! ACOMP PAC: X=35; ! '=' CONDS = CONDS-1 -> COP C(33): ! < C(34): ! > C(35): ! = C(36): ! # C(37): ! <= C(38): ! >= CONDS=CONDS-1 %IF NEXT#0 %START; ! DOUBLE SIDED PUT(126); ! SHOW DOUBLE SIDED DOUBLE=1; BIT=1; ! PSEUDO %AND -> ANDOP %FINISH %IF DOUBLE # 0 %START DOUBLE = 0; X = RCOMP(X) %FINISH PUT('?') COP: LOCAL NOT=(LOCAL NOT!!GLOBAL NOT)&1 X=X!!7 %IF LOCAL NOT#0 %IF CLAST#0 %START X=X!!7 %IF OPS&1#0 OP(COMP(X+PRED OP),CNEST(CLEVEL)) %ELSE %WHILE CMOD&1#0 %CYCLE CMOD=CMOD>>1; OPS=OPS>>1 CLEVEL=CLEVEL-1 GLOBAL NOT=GLOBAL NOT>>1 %REPEAT CMOD=CMOD>>1; OPS=OPS>>1; CLEVEL=CLEVEL-1 GLOBAL NOT=GLOBAL NOT>>1 X=X!!7 %IF OPS&1#0 OP(COMP(X+PRED OP),CNEST(CLEVEL)) DEF LAB(LABEL) %UNLESS LABEL=CNEST(CLEVEL) LABEL=CNEST(CLEVEL) %FINISH CLAST=0; LOCAL NOT=0; PRED OP = 0 DEF LAB(ULAB) %IF CONDS <= 0 %AND ULAB#0 PUT('"') %IF DOUBLE # 0 -> CONT C(39): ! AND C(40): ! OR BIT=X&1; ! 1=AND, 0=OR ANDOP: CONDS=CONDS+1 LOCAL NOT=(LOCAL NOT!!GLOBAL NOT)&1 BIT=BIT!!LOCAL NOT %IF BIT=OPS&1 %START %IF CLAST#0 %START CMOD=CMOD<<1 CNEST(CLEVEL+1)=CNEST(CLEVEL) CLEVEL=CLEVEL+1 OPS=OPS<<1!BIT˙ GLOBAL NOT=GLOBAL NOT<<1!LOCAL NOT %FINISH %ELSE CMOD=CMOD<<1 %IF CLAST#0 %START LABEL=LABEL+4 CLEVEL=CLEVEL+1; CNEST(CLEVEL)=LABEL %ELSE CMOD=CMOD!1 %IF OPS>>1&1 = BIT %START L = CNEST(CLEVEL-1) %ELSE LABEL=LABEL+4; L=LABEL %FINISH CLEVEL=CLEVEL+1; CNEST(CLEVEL)=L %FINISH OPS=OPS<<1!BIT GLOBAL NOT=GLOBAL NOT<<1!LOCAL NOT %FINISH CLAST=1; LOCAL NOT=0 -> CONT %IF DOUBLE=0 -> COP; ! REJOIN CONDITIONS C(119): ! STARTT STARTT = 2 %AND DEF LAB(LABEL+2) %IF STARTT = 0 LABEL = LABEL+4 FAULT(23) %IF LABEL>>2 > MAX LAB LABINF(LABEL>>2) = STARTT+ELSE LOOP LAB = 0; P LAB = 0; ! LABEL NO LONGER PENDING ELSE = 0; EILAB = 0 ->CONT C(41): OP('B',LABEL-2); ! REPEAT ACCESS = 0 C(42): POP LAB(X&1); ->CONT; ! FINISH C(43): ! ELSE POP LAB(0) %IF P LAB = 0; ! (FINISH) ELSE ... FAULT(5) %AND -> RETURN %IF PLAB&1#0 OP('F',PLAB+1) %UNLESS ACCESS = 0 DEF LAB(PLAB) PLAB=PLAB+1 STARTT=3+8; ! SHOW ELSE ELSE = 4 -> CONT C(54): OWN DEF=0; OUT=0; ! OWNVTYPE C(51): ! ATYPE C(52): ! OWN ATYPE C(53): ! VTYPE C(56): ! TYPE FAULT(15) %IF INHIBIT&1 # 0 %AND SPEC > 0 C(50): ! RTYPE C(57): ! SWITCH DCLASS=CLASS; -> CONT C(60): ! VSET C(61): ! NSET C(67): ! V C(68): ˙ ! N C(74): ! RECV C(75): ! RECN C(122): ! RTP C(123): ! PP C(124): ! FNP C(125): ! MP C(77): ! RECAN C(63): ! ANSET C(70): ! AN C(62): ! ASET C(69): ! A C(76): ! RECA AOP('@', X); ->CONT C(65): ! RFN C(66): ! AFN -> CONT C(71): ! M C(72): ! F C(73): ! RT C(78): ! RECORDMAP C(64): ! MSET CALL; -> CONT C(83): LIT2=LIT1; LIT1=EVAL(X); ! 'ICONST' CGEN(LIT1) %AND ->CONT %IF X < 0 C(82): ! SCONST C(84): ! 'RCONST' L=BUFFER(X) %IF L <= 0 %AND CLASS=ICONST %START; ! SYMBOL OP('N',3); L=BUFFER(X-1) PUT(','); PUT('Z') X=L//10 PUT(X+'A') PUT(L-X*10+'A') %ELSE L=|L| OP(CONOP(CLASS),L) %IF L > 0 %START PUT(',') %CYCLE X=X-1,-1,X-L PUT(BUFFER(X)) %REPEAT %FINISH %FINISH LIT=CODE -> CONT C(105):PUT('.'); -> CONT; ! '.' C(106):PUT('V'+32); -> CONT C(126):PUT('F'+32); ! COM STARTT=2+8; ! PSEUDO %CYCLE P LAB=LABEL; LOOP LAB=P LAB+2 DEF LAB(LOOP LAB) -> CONT C(113): ! BSEP %IF SPREFIX=0 %THEN DIM=DIM+1 %ELSE SET SIZE -> CONT C(116˙): AOP('L',X) ACCESS = 1 INHIBIT = INHIBIT!1; -> CONT C(80): INHIBIT = INHIBIT!1; ! SWITCH AOP('W',X); ->ACONT C(114):INHIBIT = INHIBIT!1; ! SLAB ACCESS = 1 AOP('_',X) L=DICT(X-2); ! POINTER TO TABLE K=DICT(L); ! LOWER BOUND FAULT(16) %AND ->CONT %UNLESS K <= LIT1 <= DICT(L-1) K=LIT1-K L=L-K>>4; ! ENTRY POINT K=1<<(K&15); ! REQUISITE BIT M == DICT(L-2) FAULT(7) %IF M&K#0 M = M!K -> CONT C(81): INHIBIT = INHIBIT!1; ! 'BL' C(115): AOP('J',X); -> ACONT; ! 'FL' C(128):LIT1 = BPSIZE %IF LIT1 = 0 BPSIZE=BP SIZE-LIT1+1; ! ORB -> OF %IF LIT1 <= 0 -> CONT C(129):PUT('P'+32); ->CONT; ! PSEP C(130):PUT('P'+32); PUT('E') PRED PENDING = PRED PENDING>>1 PRED PENDING = PRED PENDING-1 %AND ->PAC %IF PRED PENDING&1 # 0 ->CONT C(107): PUT('I'+32); ->CONT; ! ASSEP C(118): %IF DCLASS#54 %START; ! OSEP BP SIZE=BP SIZE-1 %IF BP SIZE <= 0 %START OF: ATOM POS=0; FAULT(16) OUT=0 -> RETURN %FINISH %FINISH OSEP: PUT('A') EXTRA(OWN DEF) %IF OWN DEF > 1 OWN DEF=0; LIT1 = 0 -> CONT C(117): BP SIZE=BP SIZE-1 %IF OUT#0; ! OWNT OUT=0 -> OSEP %IF BP SIZE=0 BP SIZE=0 -> OF %IF BUFFER(BPT)='A' %OR LIT = CODE PUT('I'); ! INDICATE CLEAR -> CONT C(110): ! LRB C(111): ! RRB -> CONT C(127):PUT('A'+32); -> CONT D(54): OWN DEF=OWN DEF+1; ! OWNVTYPE DICT(X-2) = LIT1 %IF CONST INT # 0 -> DDD D(57): ! SWITCH %IF LIT=CODE %THEN %START; ! SWITCH DEF PUT('W'+32) DICT(X-2)=T LIMIT-1 DICT(TLIMIT-1˙)=LIT2; ! LOWER BOUND DICT(TLIMIT-2)=LIT1; ! UPPER BOUND %IF LIT1 < LIT2 %START; ! BOUNDS INSIDE-OUT ATOM POS=0; FAULT(4) LIT1=LIT2 %FINISH K=LIT1-LIT2+1 K=(K+15)>>4; ! ENTRIES NEEDED TLIMIT=TLIMIT-K-3 FAULT(23) %IF T LIMIT <= TMAX DICT(L)=0 %FOR L = TLIMIT,1,TLIMIT+K %FINISH D(50): ! RTYPE OP('F',0) %IF DCLASS=50 %AND DEC TYPE#84 %AND SPEC >= 0 %C %AND LEVEL # 0 ! JUMP ROUND ROUTINE D(56): ! TYPE D(53): ! VTYPE DDD: DEF(X) -> CONT D(51): ! ARRAY DEC %IF DIM#0 %START; ! SET UP DOPE VECTOR OP('D'+32, DIM); DIM = 0 %FINISH DEF(X); PUT('H'+32) PUT('C'+32) %IF DICT(X-1)&15#13; ! NO SPACE FOR FORMATS -> CONT D(52): DEF(X); OUT=TYPE; ! OWNARRAY BPSIZE = 1 %IF TYPE = 15; ! EXTRINSICS ->CONT C(49): ! BEGEND %IF X=15 %THEN PUT('H') %AND XX=NULL STRING %ELSE C END RETURN: ! ! DEAL WITH LABELS ! OP('B',LOOP LAB) %IF LOOP LAB#0 DEF LAB(EILAB) %IF EILAB # 0 %AND EILAB # PLAB DEF LAB(P LAB) %IF P LAB#0 %END; ! OF COMPILE SS %IF BLOCK TYPE=0 %START; ! RECORD FORMAT ANALYSE SS(-1) XX=X-2 OP('G', 2) COMPILE SS %IF SS#0 OP('G',2); ! FORMAT END -> L9 %FINISH %IF BLOCKTYPE&15#15 %START; ! NOT BEGIN ANALYSE SS(1); ! FORMAL PARAMETERS %IF SPEC < 0 %THEN K = 0 %ELSE K = 1 OP('G', K) ˙ COMPILE SS %IF SS # 0 OP('G', K) -> L9 %IF K = 0 %FINISH ACCESS = 1 %CYCLE ANALYSE SS(0) XX=X-2 COMPILE SS %IF SS#0 COMPILE BLOCK(0,0,DICT(XX)) %IF DEC TYPE=84 %EXIT %IF DECTYPE=85 %OR DEC TYPE=EOP %C %OR DEC TYPE=EOF %IF 7 <= DECTYPE&15 <= 10 %OR DECTYPE=15 %START XX=XX-1 %IF DECTYPE&X'70'=X'50'; ! RECORDMAPS %IF LEVEL = 0 %AND DECTYPE = 15 %START %IF FILE = 0 %THEN FILE = 2 %ELSE FAULT(5) %FINISH %IF SPEC > 0 %AND SPREFIX > 3 %AND SPREFIX # 7 %START %IF LEVEL # 0 %THEN FAULT(15) %ELSE FILE = 1 %FINISH COMPILE BLOCK(LEVEL+1,DECTYPE,DICT(XX)) POS=0 %AND %EXIT %C %IF DEC TYPE=EOP %OR DEC TYPE=EOF;! PREMATURE END %FINISH %REPEAT ! POINT TO JUMP ROUND ROUTINE DEF LAB(0) %UNLESS BLOCK TYPE=15 %OR LEVEL = 0 L9: SPEC=1; TMAX=T BASE; T BASE=OLD T BASE LABEL = OLD LABEL T LIMIT=OLD T LIMIT %IF BLOCK TYPE#0 INHIBIT = INHIBIT>>1 %END; ! COMPILE BLOCK %ROUTINE SUMMARISE(%INTEGER STREAM) SELECT OUTPUT(STREAM) %IF FAULTY = 0 %START WRITE(STATS,5); PRINT STRING(" STATEMENTS COMPILED ") %ELSE PRINT STRING("PROGRAM CONTAINS"); WRITE(FAULTY,1) PRINT STRING(" FAULT"); PRINT SYMBOL('S') %IF FAULTY # 1 NEWLINE %FINISH CLOSE OUTPUT; ! TO ENSURE BUFFER FLUSHING %END !!!!! COMREG(0) = -1; !IN CASE IT BOMBS OUT SELECTOUTPUT(LISTING); SELECT INPUT(PRIM) NEWLINE; SPACES(5) PRINT STRING("EDINBURGH C.S. IMP COMPILER VERSION ") PRINT STRING(VERSION) NEWLINES(2) control = 0; ! **** optimise only: for supervisor maintenance {CONTROL = COMREG(14)}; CGEN(CONTROL); PUT('Z'+32) LIST = 2 CODE=0 LREALS=0; ! REALSNORMAL FAULTY=0 OUT = 0 SYMTYPE=0; PAPP == PHRASE(APPEP); APP = PAPP STATS=0; LINE NUM=0 BUFFER(NULL STRING)=0 T LIMIT=DICT END-1; G LIMIT=GBASE; LABEL=4 T MAX=GLOBAL; T BASE=GLOBAL X=0; ATOM1=0; LAST=0; INHIBIT = 0 COMPILE BLOCK(0,15,DICT(TLIMIT)); ! COMPILE A BEGIN TO START PUT(';') PUT(4); ! TO TERMINATE SEND; ! CLEAR THE BUFFER SUMMARISE(LISTING) !!!! COMREG(0) = -FAULTY !!!! COMREG(0) = STATS %IF COMREG(0) = 0 %signal 15,1 %if faulty # 0 %ENDOFPROGRAM