! IMP77 compiler first pass !to create an EMAS version: ! ! d*//* ! m-0 (f/!imp77:/ l* i/!imp77:/ m)* ! On EMAS all shorts should be changed to integers. ! ! Also, the INCLUDE facility will need to be modified. ! ARRAYS CHAR,MAPPED,ANYFORM,CNEST BECOME INTEGER ! ! !################################################### ! Copyright: 1 January 1980 # ! INTERACTIVE DATASYSTEMS (EDINBURGH) LTD. # ! Peter S. Robertson # ! 32 Upper Gilmore Place # ! Edinburgh EH3 9NJ # ! all rights reserved # !################################################### %externalintegerfn pass1 %constinteger temporary = x'40000000' ;!EMAS %externalstring(30) %fnspec imp11version %systemroutinespec ssmess(%integer n) ;!EMAS %systemroutinespec move(%integer a,b,c) %systemintegermapspec comreg(%integer n) ;!EMAS: %systemroutinespec setwork(%integername ad,f) ;!EMAS: %systemroutinespec connect(%string(32) s, %integerc access,mb,p,%record(?)%name r,%integername flag) ;!EMAS: %recordformat rfm(%integer conad,a,b,c,d,e,f,g,h,j,k,l) ;!EMAS: %systemroutinespec outfile(%string(15) s, %integer l, %c ml,p,%integername conad,flag) ;!EMAS: %constinteger fw only=b'1000000000' !configuration parameters %constinteger MAX INT=214748364 ;!EMAS !EMAS: %CONSTINTEGER max int = ((-1)>>1)//10 %constinteger MAX DIG=7 ;!EMAS !EMAS: %CONSTINTEGER max dig = (-1)>>1-maxint*10 %constinteger BYTE SIZE = 8; !bits per byte %constinteger MAX TAG = 700; !max no. of tags %constinteger MAX DICT = 4000; !max extent of dictionary %constinteger NAME BITS = 11 %constinteger MAX NAMES = 1<0 strings, <0 chars %owninteger CONT = ' ', CSYM = ' '; !listing continuation marker %owninteger DECL = 0; !current declarator flags %owninteger DIM = 0; !arrayname dimension %owninteger SPEC GIVEN = 0 %owninteger ESCAPE CLASS = 0; !when and where to escape %owninteger PROTECTION=0, ATOM FLAGS=0 %owninteger OTYPE = 0; !current 'own' type %owninteger REALS LN = 1; ! =4 for %REALSLONG %owninteger LAST1 = 0; !previous atom class %owninteger GEN TYPE = 0 %owninteger PTYPE = 0; !current phrase type %owninteger PAPP = 0; !current phrase parameters %owninteger PFORMAT = 0; !current phrase format %owninteger FORCE = 0; !force next ptype %owninteger G = 0, GG = 0, MAP GG = 0; !grammar entries %owninteger FDEF = 0; !current format definition %owninteger THIS = -1; !current recordformat tag %owninteger NMIN = 0; !analysis record atom pointer %owninteger NMAX = 0; !analysis record phrase pointer %owninteger RBASE = 0; !record format definition base %owninteger STBASE = 0; !constant work area base %owninteger GMIN = MAX GRAMMAR; !upper bound on grammar %owninteger DMAX = 1 %owninteger TMIN = MAX TAG; !upper bound on tags %owninteger SS = 0; !source statement entry %string(63) INCLUDE FILE %owninteger INCLUDE LIST = 0 %owninteger INCLUDE = 0; !=0 unused, #0 being used %owninteger PERM = 1; !1 = compiling perm, 0 = program %owninteger PROGMODE= 0; !-1 = file, 1 = begin/eop %owninteger SSTYPE = 0; !-1:exec stat ! 0: declaration ! 1: block in ! 2: block out %owninteger SPEC MODE = 0; !>=0: definition ! -1: proc spec ! -2: recordformat %owninteger OCOUNT = -1; !own constants wanted %owninteger LIMIT = 0; !lookup limit %owninteger COPY = 0; !duplicate name flag %owninteger ORDER = 0; !out of sequence flag %owninteger FOR WARN = 0; !non-local flag %owninteger DUBIOUS = 0; !flag for dubious statements %owninteger DP = 1 %owninteger POS1 = 0, POS2 = 0; !error position %owninteger POS= 0; !input line index %owninteger DIMENSION = 0; !current array dimension %owninteger LOCAL = 0; !search limit for locals %owninteger FM BASE = 0; !entry for format decls %owninteger SEARCH BASE = 0; !entry for record_names %owninteger FORMAT LIST = 0; !size of current format list %integer RECID %ownintegerarray CHAR(0:133)=nl(134); !input line %integerarray LIT POOL(0:LIT MAX) %owninteger LIT = 0; !current literal (integer) %owninteger LP = 0; !literals pointer %owninteger BLOCK X = 0; !block tag %extrinsicinteger permad ;!EMAS* %externalinteger LIST = 1; !<= to enable - SHOULD BE OWN %owninteger CONTROL = 0 ! CONTROL&1 = <1> NO TYPE CHECKS ON RECORD ASSIGNMENT. ! CONTROL&2 = <1> PERMIT %RETURN IN FUNCTIONS AND MAPS %owninteger DIAG = 0; !diagnose flags %integerarray HASH(0:MAX NAMES) %record(TAGFM)%array TAG(0:MAX TAG) !IMP77: %RECORD(tagfm)%ARRAY tag(0:max tag) %integerarray DICT(1:MAX DICT) %owninteger buffsize ;!EMAS: %byteintegerarrayname BUFF ;!EMAS: %byteintegerarrayformat bufffm(1:x'200000') ;!EMAS: !EMAS: %BYTEINTEGERARRAY buff(1:512) %owninteger BP = 0 !*** start of generated tables *** ! %endoflist %conststring(8)%array TEXT(0:255) = %c "Z","VDEC","OWNVDEC","EXTVSPEC","ADEC","OWNADEC", "EXTASPEC","PROC","PROCSPEC","FORMDEC","SWDEC","LDEC", "FORMSPEC","","","","","", "OPTION","COMMA","T","COLON","COMMENT","LB", "ALIAS","RB","SUB","ARRAYD","STYPE","ARRAY", "NAME","PROCD","FNMAP","SWITCH","OWN","EXTERNAL", "STRING","RECORD","FORMAT","SPEC","MCODE","LABEL", "OP1","OP2","OP3","SIGN","UOP","MOD", "DOT","COMP","ACOMP","EQ","EQEQ","JAM", "JUMP","RESOP","AND","OR","NOT","WHILE", "UNTIL","FOR","CWORD","EXIT","ON","SIGNAL", "THEN","START","ELSE","FINISH","FELSE","CYCLE", "REPEAT","PROGRAM","BEGIN","END","ENDPROG","ENDPERM", "FRESULT","MRESULT","BACK","MONITOR","STOP","LIST", "REALSLN","CONTROL","INCLUDE","MASS","RTYPE","ADDOP", "IDENT","V","N","CONST","FM","", "R","F","M","P","RP","FP", "MP","PP","L","S","A","AN", "NA","NAN","","","","", "","","","","","", "%MSTART","%CLEAR","%PRED","","%DUBIOUS","%DUP", "%PIN","%POUT","%EDUP","","PIDENT","CIDENT", "OIDENT","FNAME","SWID","DOTL","DOTR","ASEP", "CSEP","OSEP","PSEP","ARB","BPLRB","ORB", "PRB","CRB","RCRB","RECRB","RECLB","LAB", "MLAB","SLAB","XNAME","OWNT","DBSEP","PCONST", "CMOD","CSIGN","CUOP","COP1","COP2","COP3", "INDEF","XELSE","CRESOP","NLAB","RUNTIL","ACONST", "ORRB","FMANY","OSTRING","FMLB","FMRB","FMOR", "RANGERB","FSID","","","","", "","%DUMMY","%DECL","%TYPE","%ZERO","%APPLY", "%PROT","%SETPROT","%PTYPE","%GAPP","%LOCAL","%GUARD", "%MCODE","%CDUMMY","%SETTYPE","%OPER","%PARAM","%BLOCK", "%OTHER","%COMPILE","APP","BASEAPP","APP2","APP3", "APP4","APP5","APP6","ADEFN","NPARM","SWDEF", "SWIDS","CIEXP","RCONST","SCONST","ARRAYP","XIMP", "IMP","COND","SCOND","EXP1","EXP2","SEXP", "IEXP","IEXP1","IEXP2","ISEXP","SEQ","FDEF", "EXP","NARRAYP","STRUCT","RESEXP","BPL","CONSTB", "FITEM","MOREA","CLIST","FPP","FPP0","FPP1", "FPP2","INITVAR","RECEXP","EIMP","IDENTS","RANGE", "RCONSTB","VARP","INITDEC","","","", "ESCDEC","ESCPROC","ESCARRAY","ESCREC" %constinteger GMAX1= 718 %owninteger GMAX= 718 %constinteger IMP PHRASE = 25 %ownintegerarray PHRASE(200:255) = %c 0, 563, 564, 566, 568, 570, 572, 561, 613, 203, 200, 601, 477, 479, 623, 302, 206, 312, 322, 432, 425, 436, 443, 457, 452, 460, 466, 481, 401, 626, 628, 602, 520, 510, 485, 501, 574, 526, 527, 542, 549, 577, 396, 291, 197, 635, 515, 620, 167, 0, 0, 0, 639, 692, 700, 708 %constbyteintegerarray ATOMIC(130:179) = %c 90, 90, 90, 90, 90, 48, 48, 19, 19, 19, 19, 25, 25, 25, 25, 25, 25, 25, 23, 104, 104, 105, 30, 20, 21, 93, 47, 45, 46, 42, 43, 44, 40, 68, 55, 104, 60, 93, 25, 40, 93, 23, 25, 57, 25, 90, 176, 177, 178, 179 ! FLAG<1> 0<1> SS<2> 0<3> T<1> LINK<8> %constintegerarray INITIAL(0:119) = %c 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -32551, 0, 0, 0, 0, 13, 0, 14, 4, -32557, 16, -32550, 0, 0, 5, 6, 3, 12, 15, 8, 7, 9, 10, 11, -32558, -32554, -32559, -32552, -32553, 18, 22, 17, 21, 19, 0, 0, 0, -32562, -32560, 0, 0, 0, -32561, 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, -32556, 0, -32555, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ! MORE<1> 0<1> ORDER<2> TYPE<4> CLASS<8> %ownintegerarray GRAM(0:MAX GRAMMAR) = %c 0, -28523, -28521, -28602, -32706, -28509, -28603, -24502, -24503, -20405, -20404, -28595, -32697, -32709, -16323, -28600, -32704, -28587, -28589, -32681, -16344, -28586, -28588, -16366, -32586, 216, -12287, -16380, -8185, -8184, -12285, -12286, -12283, -12282, -12279, -12276, -16373, 20490, -32706, -32701, 216, -16364, -28610, -28613, -28612, 16445, 217, -16364, 62, -32701, 16450, -16364, 5346, -16364, 166, -16344, 4332, 130, -16360, -16361, 126, 217, -32701, 216, -16364, 16450, -32700, 16404, -32701, -32706, 216, 16405, 16407, -16222, 8414, 130, 217, -32697, 16450, 1250, 4307, 4318, 192, 93, 170, 90, 207, -16365, 16404, 90, -16360, -16365, 16404, 241, -16365, 16404, 132, 132, -16360, 4329, -16365, 16404, 133, 175, 90, -16365, 16404, 209, -16365, 16404, 4313, 217, 16451, 4263, 16384, 16384, 120, 216, -32700, 16404, -32706, 16404, 243, 16409, 454, -32685, 16404, 454, 248, -16365, 16404, 4263, 194, -16360, 4329, -32717, 16404, 4263, 16407, 454, 237, 127, 215, 454, 4263, 16384, -16364, 1502, -32629, -16361, 153, -32606, 222, 143, -32629, 153, 454, 126, 16409, 454, 16384, 234, -16365, -32595, 147, -32678, 234, 193, -32677, -32676, -32661, 109, -32717, 53, 52, 52, 52, 194, 194, 194, -28581, 4188, 194, -28566, 4203, 194, -28564, 4205, 4580, 16429, 183, 183, 186, 186, -28583, 0, 9437, 90, -16365, 0, 134, -16365, 0, 210, 4329, 199, -32677, -32672, -32676, -32688, -32690, -32705, -32661, -32659, -32689, -32686, -32687, -16330, 65, -32716, 186, -28583, -32717, -32715, -32713, 52, -32664, 4201, 186, -32717, -32715, 55, -16328, 0, 197, 197, 52, 52, 197, -28581, -28580, 186, -28581, 4188, 4318, 194, -28581, 4188, 9437, 194, 194, 454, 194, -28581, 4188, 16407, 216, 194, -28566, -28565, 186, -28566, 4203, 194, -28564, -28563, 186, -28564, 4205, 183, 183, 186, 183, -16365, 0, 183, -28583, -16328, 0, 4580, 16429, 5095, 183, 9444, 5348, 9437, 186, 16409, -16365, 0, 5348, 217, -32701, 16450, -32701, 216, -32700, 0, -32701, -32706, 216, 243, 217, -16318, 0, -32552, 0, -32700, 0, -32706, 0, 215, -32550, 228, -28616, -28615, 0, 4096, 218, 218, -28616, 0, -32677, -32676, -16361, -32710, -32669, -32662, -32661, -32660, -32659, 740, -32039, 740, -32719, 4096, 194, -32719, -32718, -32604, -32726, -32725, -32724, -32720, 4096, 6116, -32719, 0, 6116, -28581, 4188, 218, 122, 50, 16409, -32726, -32725, -32724, -32719, 4096, 4836, 454, 195, 195, 195, 454, -28581, 4188, 194, -28566, -28565, -28564, 4205, 195, 195, 195, 194, -32719, 0, 5095, 4829, -32726, -32725, -32724, -32719, 4096, 4827, 4828, 454, -32720, -32719, 4096, 4829, 4827, 4828, 4836, -16291, -32677, 92, 184, 121, -28581, -28580, -32722, -32723, 4317, -32726, -32725, -32724, 0, 183, -32726, -32725, -32724, -32720, 0, 4316, 195, 195, 195, 454, -28581, 4188, 4315, 183, 4317, -32726, -32725, 0, 195, 195, 4315, 4317, -32726, 0, 195, -32677, -32676, -16361, 16431, 228, 228, 47, -32610, -32611, 5345, -32609, -32608, -32607, 0, 4320, 4319, 5345, -32609, -32608, 0, 4319, 5345, -32609, 0, -32613, -16361, 16431, 222, 222, 156, -32677, 92, 183, 186, 1222, 16435, 228, 16403, 4324, 138, 8420, -32723, 4189, 93, 454, 148, -32674, 16546, 16409, -32597, 182, -16383, 16388, 234, -16365, -32595, 172, -32678, 234, 90, 244, 246, -16365, 0, 235, -32678, 234, -16365, 246, -16365, 0, -32678, 234, 90, 16407, 222, 16405, 222, 145, 16407, 222, 16405, 222, 146, 16407, 1252, 154, 5348, -16365, 142, 126, 182, -16383, 16391, 90, -16365, 127, -32678, 238, 90, 125, 239, -16365, 8319, 8430, 128, 126, -16361, 127, 190, 240, 189, 16409, 182, -16383, 16391, 90, -16365, 0, -32678, 240, 90, 16623, -16365, 0, 244, 232, 1252, 1252, 137, 1252, 137, 1252, 137, 1252, 137, 1252, 137, 222, -16365, 0, 131, 194, -16360, -16333, -16332, 124, 181, -16292, -16277, 16493, -31802, 5342, -28581, 4188, 4263, 181, 186, 454, 16475, 183, -28583, 199, 5598, 9438, 222, -32677, -32676, 16407, 186, 228, 135, 16409, -32632, 0, -32677, 92, -32677, -32676, -32662, -32661, -32660, -32659, 165, -32677, 92, 188, -32662, 107, 188, -32660, 109, -32732, 37, -16344, 4318, 148, -32674, 16424, 222, 16405, 222, 174, -28644, -32734, -32680, -28641, -32733, -32730, -32735, -32727, -32738, 4326, -32738, -32739, -32741, -32736, 199, -28644, -32680, -28641, 4326, -32739, -32741, 199, -32738, -32739, -32741, -32736, -32729, 199, -32616, 199, -32739, -32741, -32729, 199, -32616, -32729, 199, -28644, -32680, 4326, -32738, -32739, -32741, 199, 245, 4318, 245, 16409, 152, 4318, 16409, 152, 245, -32672, -32671, -32670, 99, 16407, 200, 144, 185, -32677, 92, 16407, -32582, 200, 200, 187, 141, -32677, 92, 16410, 191, -32677, -32676, -32662, -32661, -32660, 109, 198, 0( 1002) %ownintegerarray GLINK(0:MAX GRAMMAR) = %c -1, 71, 72, 38, 46, 47, 67, 67, 75, 67, 0, 67, 51, 76, 79, 53, 55, 80, 67, 81, 82, 83, 67, 84, 26, 41, 85, 86, 57, 57, 89, 93, 96, 97, 102, 103, 104, 107, 46, 67, 67, 0, 110, 110, 111, 52, 49, 0, 61, 67, 62, 0, 67, 0, 111, 112, 112, 58, 113, 114, 115, 64, 67, 66, 116, 117, 68, 0, 67, 122, 67, 0, 73, 123, 123, 67, 77, 67, 40, 77, 67, 67, 0, 124, 127, 128, 87, 86, 0, 90, 131, 89, 0, 94, 93, 0, 132, 98, 137, 100, 97, 0, 138, 67, 105, 104, 0, 108, 107, 0, 67, 67, 67, 139, 140, 141, 0, 118, 120, 116, 142, 116, 67, 71, 125, 67, 0, 67, 129, 85, 0, 143, 133, 144, 135, 145, 0, 156, 157, 59, 158, 67, 119, 91, 159, 146, 145, 148, 146, 151, 0, 153, 153, 154, 146, 0, 99, 160, 67, 134, 161, 162, 165, 161, 141, 162, 162, 168, 172, 174, 175, 176, 177, 178, 179, 182, 185, 188, 189, 180, 190, 190, 183, 191, 191, 186, 191, 191, 0, 188, 192, 193, 194, 0, 196, 0, 0, 198, 197, 0, 201, 200, 0, 204, 205, 0, 228, 232, 219, 234, 235, 0, 236, 237, 238, 0, 232, 226, 244, 245, 221, 248, 249, 250, 251, 252, 0, 255, 229, 249, 250, 251, 256, 0, 0, 188, 257, 263, 239, 272, 272, 242, 191, 191, 273, 246, 275, 275, 229, 279, 280, 281, 253, 282, 282, 283, 0, 258, 269, 269, 261, 270, 270, 264, 269, 269, 267, 270, 270, 232, 271, 232, 0, 284, 0, 276, 285, 256, 0, 232, 279, 232, 286, 287, 288, 232, 276, 0, 290, 0, 0, 292, 0, 294, 0, 296, 298, 0, 0, 301, 0, 0, 303, 305, 0, 307, 0, 309, 0, 311, 0, 0, 314, 317, 318, 319, 0, 0, 320, 315, 318, 0, 336, 336, 332, 351, 352, 353, 353, 353, 353, 334, 287, 354, 360, 0, 337, 345, 349, 361, 362, 363, 364, 365, 0, 346, 348, 0, 0, 272, 272, 0, 0, 368, 355, 373, 374, 375, 376, 0, 377, 379, 380, 386, 387, 366, 388, 388, 369, 272, 272, 272, 272, 392, 393, 394, 360, 395, 0, 0, 381, 362, 363, 364, 345, 0, 382, 383, 389, 365, 345, 0, 355, 356, 357, 0, 399, 272, 272, 400, 0, 410, 410, 405, 416, 406, 417, 418, 419, 0, 411, 417, 418, 419, 420, 0, 408, 405, 423, 416, 421, 424, 424, 407, 414, 426, 429, 430, 0, 425, 431, 427, 433, 435, 0, 432, 272, 272, 440, 441, 287, 442, 0, 445, 450, 446, 445, 451, 450, 0, 448, 447, 453, 452, 456, 0, 454, 458, 457, 0, 272, 463, 464, 287, 465, 0, 468, 468, 469, 470, 471, 472, 473, 474, 475, 476, 0, 478, 272, 480, 0, 482, 484, 484, 205, 489, 487, 495, 496, 490, 493, 489, 0, 490, 490, 0, 497, 498, 500, 0, 0, 503, 505, 509, 498, 507, 0, 505, 505, 503, 511, 512, 513, 514, 0, 516, 517, 518, 519, 0, 521, 522, 523, 524, 521, 0, 527, 528, 530, 535, 531, 533, 0, 531, 0, 536, 537, 538, 540, 541, 541, 0, 543, 545, 0, 546, 547, 548, 532, 550, 552, 557, 553, 555, 0, 553, 0, 558, 559, 556, 0, 562, 205, 0, 565, 563, 567, 564, 569, 566, 571, 568, 573, 570, 575, 574, 0, 578, 579, 591, 592, 583, 205, 584, 587, 587, 587, 589, 205, 593, 593, 594, 595, 596, 580, 599, 597, 600, 0, 205, 205, 205, 605, 605, 606, 607, 608, 604, 609, 611, 0, 193, 193, 193, 193, 193, 193, 193, 193, 0, 622, 622, 192, 625, 625, 0, 625, 625, 630, 632, 287, 287, 633, 287, 287, 636, 637, 638, 0, 649, 676, 683, 665, 654, 205, 205, 205, 205, 649, 658, 667, 684, 665, 0, 661, 685, 665, 661, 667, 684, 0, 669, 673, 688, 665, 205, 0, 205, 0, 673, 688, 205, 0, 665, 205, 0, 679, 691, 679, 658, 667, 684, 0, 649, 686, 661, 687, 205, 689, 690, 665, 679, 696, 696, 696, 696, 697, 698, 699, 0, 702, 702, 703, 705, 706, 707, 707, 699, 710, 710, 711, 712, 718, 718, 718, 718, 718, 718, 0, 0( 1002) %constintegerarray KDICT(32: 607) = %c 0, 511, 131, 531, 131, 551, 559, 131, 567, 575, 583, 603, 623, 631, 663, 671, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 691, 698, 707, 751, 795, 131, 131, 824, 900, 960, 1076, 1120, 1280, 128, 128, 1392, 128, 128, 1460, 1556, 1592, 1660, 1748, 128, 1828, 2044, 2240, 2272, 128, 2312, 128, 128, 128, 2331, 2339, 2371, 2379, 2399, 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, 2407, 131, 2379, -32351, 16428, 25, 16428, 29, -32349, 16433, 1, 16434, 1, -16127, 0, 16427, 21, 16407, 0, 16409, 0, -32323, -10840, 40, 16471, 0, -32341, -10580, 32, 16473, 117, 16384, 19, -31955, -32322, -10580, 36, -9290, 0, 16473, 113, 16432, 13, -32337, 16427, 46, 16427, 17, 16405, 0, 16404, 0, -31556, -31939, -32322, -9551, 2, 16433, 1, 16433, 5, 16426, 5, -31606, -32323, -9807, 0, -32374, -9678, 0, 16436, 0, 16435, 0, -31939, -32322, 16433, 4, 16426, 9, 16433, 3, -30772, -31666, 10578, 11457, -32344, 16413, 2, 16411, 2, 68, -32374, 16440, 0, 16440, 0, 8393, 83, 16408, 0, -31291, 10841, 69, -32311, 16412, 18, 10830, 9157, 10565, 16412, 18, 9415, 78, 16458, 0, -32049, 8665, 8908, 16455, 0, -30131, 78, -31277, 84, -32055, 10194, 76, 16469, 0, 10958, 69, 16447, 32, 84, -32319, 16418, 2, 10830, 16418, 2, 8909, 10830, 16406, 0, -31927, 10073, 9921, 8649, 16419, 5, 9153, 10190, 8915, 16469, 1, -27956, -31282, 88, -31927, 8916, 10066, 9793, 16419, 3, 84, 16447, 4, 68, -32305, 16459, 2, 70, -30650, -31284, 80, -31931, 10194, 10567, 9921, 16460, 1, 9938, 16461, 0, 10697, 84, 16467, 3, 9801, 69, 16460, 0, 8915, 16452, 0, -29631, -30903, -31282, -31793, 10069, 10819, 10185, 78, 16416, 9, 82, 16445, 0, 16416, 9, 9422, 9299, -32315, 16453, 0, 10700, 69, 16454, 0, 10700, 69, 16464, 1210, -30778, 78, -31549, 8916, 8903, 82, -32344, 16412, 17, 16472, 17, 10956, 8900, 16470, 0, 16446, 44, -30143, -30647, 10063, 71, -31671, -32302, 16412, 20, 8389, 76, 16412, 36, 10830, 9157, 10565, 16412, 20, 10835, 16467, 1, 8898, 76, 16425, 6, -31935, 10063, 10825, 10575, 16465, 109, 80, 16416, 10, -32191, 10831, 16442, 0, 8909, -32314, 16414, 1, -31794, 10069, 10819, 10185, 78, 16416, 10, 16416, 10, -30770, -31408, -32174, 10071, 16418, 1, -32374, 16441, 2, 16441, 2, 9428, 10063, 16402, 0, -32315, 16448, 0, 8918, 10830, 16448, 0, -30523, 82, -31419, -31927, 9167, 8402, 77, 16457, 0, 77, 16419, 6, 9412, 8387, 8916, 16415, 123, 9938, 16419, 7, -31931, 10959, 9428, 8910, 16415, 104, -28351, -30397, -31024, -32045, 10964, 10066, 16464, 1319, 9813, 7892, -32323, 16462, 1384, 16463, 1241, 8389, 84, 16456, 0, 10575, 68, -32314, 16421, 64, 10575, 8397, 84, -32301, 16422, 9, 8912, 67, 16422, 12, 76, -32301, 16412, 33, -31924, 10190, 9938, 9793, 16468, 1, 10063, 71, 16468, 4, -27704, -28983, -29488, -31276, -31913, 10713, 8916, 77, 16419, 4, 10825, 9283, 16417, 12, -31423, -31921, 9426, 9166, 40, 16420, 48, 80, 16466, 115, 10834, 16451, 0, 8645, 16423, 0, 10055, 9793, -32315, 16449, 0, 8918, 10830, 16449, 0, 10575, 84, -32311, 16412, 19, 10830, 9157, 10565, 16412, 19, -32056, 10962, 69, 16464, 1354, 10053, 16450, 0, 78, -32052, 9428, 76, 16444, 182, 10693, 83, 16446, 46, 9416, 8908, 16443, 180, 16407, 0, -31939, -32292, -10454, 51, 16426, 13, 16433, 1, 16409, 0, -32290, -10454, 51, 16426, 13, 16410, 0, 16431, 14, -32323, 16430, 51, 16433, 1 %list !*** end of generated tables *** !EMAS: %ROUTINE flush buffer !EMAS: %INTEGER j !EMAS: %IF faulty = 0 %START !EMAS: select output(object) !IMP77: %FOR j = 1, 1, bp %CYCLE; !imp77: !IMP77: PRINTSYMBOL(buff(j)); !imp77: !IMP77: %REPEAT; !imp77: !EMAS: %IF bp > 0 %START !EMAS: %CYCLE j = 1,1,bp !EMAS: print ch(buff(j)) !EMAS: %REPEAT !EMAS: %FINISH !EMAS: select output(listing) !EMAS: %FINISH !EMAS: bp = 0 !EMAS: %END %routine PRINT IDENT(%integer P, MODE) %integer J, AD P = TAG(P)_TEXT %if P = 0 %start %if MODE = 0 %then printsymbol('?') %c %else BP = BP+1 %and BUFF(BP) = '?' %return %finish AD = addr(DICT(P+1)) %if MODE = 0 %then printstring(string(AD)) %else %start !IMP77: %FOR j = ad+1, 1, ad+BYTEINTEGER(ad) %CYCLE; !imp77: !IMP77: bp = bp+1; !imp77: !IMP77 buff(bp) = BYTEINTEGER(j); !imp77: !IMP77 %REPEAT; !imp77: %cycle J = AD+1, 1, AD+byteinteger(AD) BP = BP+1 BUFF(BP) = byteinteger(J) %repeat %finish %end %routine ABANDON(%integer N) %switch REASON(0:12) %integer STREAM STREAM = LISTING %cycle newline %if SYM # nl printsymbol('*') %if N=10 %or N=12 %start ;!EMAS write(LINES,4); space %finish ;!EMAS ->REASON(N) REASON(0):printstring("compiler error!"); ->MORE REASON(1):printstring("switch vector too large"); ->MORE REASON(2):printstring("too many names"); ->MORE REASON(3):printstring("program too complex"); ->MORE REASON(4):printstring("feature not implemented"); ->MORE REASON(5):printstring("input ended: ") %if QUOTE # 0 %start %if QUOTE < 0 %then printsymbol(CQUOTE) %c %else printsymbol(SQUOTE) %finishelsestart printstring("%endof") %if PROGMODE >= 0 %then printstring("program") %c %else printstring("file") %finish printstring(" missing?"); ->MORE REASON(6):printstring("too many faults!"); ->MORE REASON(7):printstring("string constant too long"); ->MORE REASON(8):printstring("dictionary full"); -> MORE REASON(9): printstring("Included file ".INCLUDE FILE." does not exist") ->MORE REASON(10): printstring("cannot create IMP#INT file ") ssmess(flag) ->MORE REASON(11): printstring(" program too large ") ->MORE REASON(12): printstring("cannot set workfile T#WRK") ssmess(flag) MORE: newline printstring("*** compilation abandoned ***"); newline %exit %if STREAM = REPORT STREAM = REPORT select output(REPORT) %repeat ! %SIGNAL 15,15 %IF diag&4096 # 0 ;! INVALID EVENT %stop %end %routine PADDR(%integer M) !!! %INTEGER n !!! n = m>>3 !!! paddr(n) %IF n # 0 !!! put(m&7+'0') BUFF(BP+4) = M&255; M = M>>8 BUFF(BP+3) = M&255; M = M>>8 BUFF(BP+2) = M&255; M = M>>8 BUFF(BP+1) = M BP = BP+4 %end %routine OP(%integer CODE, PARAM) !!! put(code) !!! paddr(param) BUFF(BP+1) = CODE BUFF(BP+2) = PARAM>>8 BUFF(BP+3) = PARAM&255 BP = BP+3 %end %routine SET CONST(%integer M) !!! %INTEGER v !!! v = m !!! v = -m %IF v < 0 !!! put('N') !!! paddr(v) !!! put('U') %IF m < 0 BUFF(BP+1) = 'N' BUFF(BP+5) = M&255; M = M>>8 BUFF(BP+4) = M&255; M = M>>8 BUFF(BP+3) = M&255; M = M>>8 BUFF(BP+2) = M BP = BP+5 %end %routine COMPILE BLOCK(%integer LEVEL, BLOCK TAG, DMIN, TMAX, ID) %integerfnspec GAPP %routinespec DELETE NAMES(%integer QUIET) %routinespec ANALYSE %routinespec COMPILE %integer OPEN; OPEN = CLOSED; !zero if can return from proc %integer DBASE; DBASE = DMAX; !dictionary base %integer TBASE; TBASE = TMAX; !tag base %integer TSTART; TSTART = TMAX %integer LABEL; LABEL = 4; !first internal label %integer LAST ARRAY; LAST ARRAY = 0 %integer ACCESS; ACCESS = 1; !non-zero if accessible %integer INHIBIT; INHIBIT = 0; !non-zero inhibits declaratons %integername BFLAGS; BFLAGS == TAG(BLOCK TAG)_FLAGS %integer BLOCK TYPE; BLOCK TYPE = BFLAGS>>4&7 %integer BLOCK FORM; BLOCK FORM = BFLAGS&15 %integer BLOCK FM; BLOCK FM = TAG(BLOCK TAG)_FORMAT %integer BLOCK OTYPE; BLOCK OTYPE = OTYPE %integername BLOCK APP; BLOCK APP == TAG(BLOCK TAG)_APP %integer L, NEW APP %routine FAULT(%integer N) ! -5 : -1 - warnings ! 1 : 22 - errors %switch FM(-5:22) %integer ST %routine PRINT SS %integer S, P %return %if POS = 0 space P = 1 %cycle printsymbol(MARKER) %if P = POS1 %exit %if P = POS S = CHAR(P); P = P+1 %exit %if S = nl %or (S='%' %and P = POS) %if S < ' ' %start; !beware of tabs %if S = FF %then S = nl %else S = ' ' %finish printsymbol(S) %repeat !EMAS: pos = 0 %IF list <= 0 %end POS1 = POS2 %if POS2 > POS1 newline %if SYM # nl ST = REPORT ST = LISTING %if N = -3; !don't report unused on the console %cycle select output(ST) %if N < 0 %then printsymbol('?') %and POS1 = 0 %else printsymbol('*') %if ST # REPORT %start %if LIST <= 0 %and POS1 # 0 %start spaces(POS1+MARGIN); printstring(" ! ") %finish %finish %else %start printstring(INCLUDE FILE) %if INCLUDE # 0 write(LINES, 4); printsymbol(CSYM); space %finish ->FM(N) %if -5 <= N <= 22 printstring("fault"); write(N, 2); ->PS FM(-5):printstring("Dubious statement"); DUBIOUS = 0; ->PSD FM(-4):printstring("Non-local") POS1 = FOR WARN; FOR WARN = 0; ->PS FM(-3):PRINT IDENT(X, 0); printstring(" unused"); ->NPS FM(-2):printstring("""}"""); ->MISS FM(-1):printstring("access"); ->PSD FM(0): printstring("form"); ->PS FM(1): printstring("atom"); ->PS FM(2): printstring("not declared"); ->PS FM(3): printstring("too complex"); ->PS FM(4): printstring("duplicate"); ->PS FM(5): printstring("type"); ->PS FM(6): printstring("match"); ->PSD FM(7): printstring("context"); ->PSD FM(21):printstring("context "); PRINT IDENT(THIS, 0); ->PS FM(8): printstring("%cycle"); ->MISS FM(9): printstring("%start"); ->MISS FM(10):printstring("size"); write(LIT, 1) %if POS1 = 0;->PS FM(11):printstring("bounds") write(OCOUNT, 1) %unless OCOUNT < 0; ->PS FM(12):printstring("index"); ->PS FM(13):printstring("order"); ->PSD FM(14):printstring("not a location"); ->PS FM(15):printstring("%begin"); ->MISS FM(16):printstring("%end"); ->MISS FM(17):printstring("%repeat"); ->MISS FM(18):printstring("%finish"); ->MISS FM(19):printstring("result"); ->MISS FM(22):printstring("format"); ->PS FM(20):printsymbol('"'); PRINT IDENT(X, 0); printsymbol('"') MISS: printstring(" missing"); ->NPS PSD: POS1 = 0 PS: PRINT SS NPS: newline %exit %if ST = LISTING ST = LISTING %repeat %if N >= 0 %start ! %SIGNAL 15,15 %IF diag&4096 # 0 ;! INVALID EVENT NUMBER %if N # 13 %start; !order is fairly safe OCOUNT = -1 GG=0 COPY = 0; QUOTE = 0 SEARCH BASE = 0; ESCAPE CLASS = 0 %finish FAULTY = FAULTY+1 !check that there haven't been too many faults FAULT RATE = FAULT RATE+3; ABANDON(6) %if FAULT RATE > 30 FAULT RATE = 3 %if FAULT RATE <= 0 %finish TBASE = TSTART %if LIST <= 0 %and SYM # nl %start ERROR MARGIN = COLUMN ERROR SYM = SYM; SYM = nl %finish %end DMIN = DMIN-1; DICT(DMIN) = -1; !end marker for starts & cycles ABANDON(2) %if DMAX = DMIN %if LIST > 0 %and LEVEL > 0 %start write(LINES, 5); spaces(LEVEL*3-1) %if BLOCK TAG = 0 %start printstring("Begin") %finish %else %start printstring("Procedure "); PRINT IDENT(BLOCK TAG, 0) %finish newline %finish !deal with procedure definition (parameters) %if BLOCK TAG # 0 %start; !proc ANALYSE; COMPILE %if SS # 0 %if BLOCK OTYPE # 0 %start; !external-ish %if BFLAGS&SPEC = 0 %start; !definition %if PROGMODE <= 0 %and LEVEL = 1 %then PROGMODE = -1 %c %else FAULT(7) !!! %FINISH %ELSE %START; !external spec !!! bflags = bflags-spec; !definition elsewhere %finish %finish NEW APP = GAPP; !generate app grammar %if SPEC GIVEN # 0 %start; !definition after spec FAULT(6) %if NEW APP # BLOCK APP; !different from spec %finish BLOCK APP = NEW APP; !use the latest %if LEVEL < 0 %start; !not procedure definition DELETE NAMES(0) %return %finish %finish %else %start OPEN = 0; !can return froma block? %finish %cycle ANALYSE %continue %if SS = 0 COMPILE FAULT(-5) %if DUBIOUS # 0 !EMAS: flush buffer %IF bp >= 128 %if SSTYPE > 0 %start; !block in or out %exit %if SSTYPE = 2; !out COMPILE BLOCK(SPEC MODE, BLOCK X, DMIN, TMAX, ID) %exit %if SS < 0; !endofprogram %finish %repeat %if LIST > 0 %and LEVEL > 0 %start write(LINES, 5); spaces(LEVEL*3-1) printstring("End") newline %finish DELETE NAMES(0) %return %integerfn GAPP; !generate app grammar (backwards) %constinteger COMMA = 140; !psep %routinespec SET CELL(%integer G, TT) !IMP77: %ROUTINESPEC class(%RECORD(tagfm)%NAME v); !imp77: ! IMP77: %RECORD(tagfm)%NAME v; !imp77: %routinespec CLASS(%record(?)%name V) %record(TAGFM)%name V %integer P, LINK, TP, C, AP, T %result = 0 %if TMAX = LOCAL; !no app needed P = GMAX1; LINK = 0; T = TMAX %cycle V == TAG(T); T = T-1 CLASS(V); !deduce class from tag %if C < 0 %start; !insert %PARAM C = -C SET CELL(196, TP) TP = -1 %finish SET CELL(C, TP) %exit %if T = LOCAL; !end of parameters SET CELL(COMMA, -1); !add the separating comma %repeat ABANDON(3) %if GMAX > GMIN %result = LINK %routine SET CELL(%integer G, TT) !add the cell to the grammar, combining common tails %while P # GMAX %cycle P = P+1 %if GLINK(P) = LINK %and GRAM(P) = G %start %if TT < 0 %or (GRAM(P+1) = TT %and GLINK(P+1)=AP) %start LINK = P; !already there %return %finish %finish %repeat !add a new cell GMAX = GMAX+1 GRAM(GMAX) = G GLINK(GMAX) = LINK LINK = GMAX %if TT >= 0 %start; ! set type cell GMAX = GMAX+1 GRAM(GMAX) = TT GLINK(GMAX) = AP %finish P = GMAX %end !EMAS: %ROUTINE class(%RECORD(tagfm)%NAME v); !imp77: %routine CLASS(%record(?)%name V) !NOTIMP80 %RECORDSPEC v(tagfm) %constinteger ERR = 89 %constinteger RTP = 100 %constinteger FNP = 101 %constinteger MAPP = 102 %constinteger PREDP = 103 %constintegerarray CLASS MAP(0:15) = %c ERR,1764, 247, ERR(4), -RTP, -FNP, -MAPP, -PREDP, ERR, 214, ERR, 229, ERR %integer TAGS, TYPE, FORM AP = 0 TAGS = V_FLAGS TYPE = TAGS>>4&7; FORM = TAGS&15 TP = V_FORMAT<<3!TYPE C = CLASS MAP(FORM) C = 208 %and TP = 0 %if TYPE = 0 %and FORM = 2; !%NAME AP = V_APP %if TAGS&PARAMETERS # 0 %end %stop %end %routine DELETE NAMES(%integer QUIET) %integer FLAGS !IMP77: %RECORD(tagfm)%NAME tx; !imp77: %record(TAGFM)%name TX %while TMAX > TBASE %cycle X = TMAX; TMAX = TMAX-1 TX == TAG(X) FLAGS = TX_FLAGS FAULT(20) %if FLAGS&SPEC # 0 %and FLAGS&OWN BIT=0; !spec but no definition %if FLAGS&USED BIT = 0 %and LEVEL >= 0 %and LIST <= 0 %start FAULT(-3) %if QUIET = 0 ; !unused %finish DICT(TX_TEXT) = TX_LINK %repeat %end %routine ANALYSE %constinteger ORDER BITS = x'3000', ORDER BIT = x'1000' %constinteger ESCAPE = x'1000' %integer STRP, MARK, FLAGS, PROT ERR, K, S, C %owninteger KEY = 0 !IMP77: %INTEGER node; !imp77: !IMP77: %INTEGERNAME z; !imp77: !IMP77: %RECORD(arfm)%NAME arp; !imp77: %integer NODE %integername Z %record(ARFM)%name ARP %switch ACT(ACTIONS:PHRASAL), PACTION(0:15) %routine TRACE ANALYSIS !diagnostic trace routine (diagnose&1 # 0) %integer A %routine SHOW(%integer A) %if 0 < A < 130 %start space printstring(TEXT(A)) %finish %else write(A, 3) %end %owninteger LA1=0, LA2=0, LSA=0, LT=0 newline %if MON POS # POS %and SYM # nl MON POS = POS write(G, 3) space printstring(TEXT(CLASS)) printsymbol('"') %if GG&TRANS BIT # 0 A = GG>>8&15 %if A # 0 %start printsymbol('{') write(A, 0) printsymbol('}') %finish %if ATOM1 # LA1 %or ATOM2 # LA2 %or LSA # SUBATOM %c %or LT # TYPE %start printstring(" [") LA1 = ATOM1 SHOW(LA1) LA2 = ATOM2 SHOW(LA2) LSA = SUBATOM write(LSA, 3) LT = TYPE write(LT, 5) printsymbol(']') %finish newline %end %routine GET SYM !EMAS: readsymbol(sym) %if sptr>=send %then ABANDON(5) ;!EMAS: SYM=byteinteger(sptr) ;!EMAS: sptr=sptr+1 ;!EMAS: nextsym=byteinteger(sptr) ;!EMAS: POS = POS+1 %if POS # 133 CHAR(POS) = SYM printsymbol(SYM) %if LIST <= 0 COLUMN = COLUMN+1 %end %routine READ SYM %constintegerarray MAPPED(0:127) = %c 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, nl, 0, 3 , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,'!','"','#', '$', 1 ,'&', 39, '(',')','*','+', ',','-','.','/', '0','1','2','3', '4','5','6','7', '8','9',':',';', '<','=','>','?', '@','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O', 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z','[', '\',']','^','_', '`','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O', 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z', 2 , '|','}','~', 0 !! 0 = SPACE !! 1 = % !! 2 = { !! 3 = ff !! other values represent themselves %if SYM = nl %start S1: LINES = LINES+1 S11: POS = 0; POS1 = 0; POS2 = 0; MARGIN = 0; COLUMN = 0 %if LIST <= 0 %start %if INCLUDE # 0 %start printstring("&"); write(LINES, 4) %finish %else write(LINES, 5) CSYM = CONT; printsymbol(CSYM) space %if ERROR MARGIN # 0 %start LINES = LINES-1 spaces(ERROR MARGIN) ERROR MARGIN = 0 %if ERROR SYM # 0 %start printsymbol(ERROR SYM) POS = 1; CHAR(1) = ERROR SYM SYM = ERROR SYM; ERROR SYM = 0 ->S5 %finish %finish %finish S2: SYMTYPE = 1 %finish S3: !EMAS: readsymbol(sym) %if sptr>=send %then ABANDON(5) ;!EMAS: SYM=byteinteger(sptr) ;! EMAS sptr=sptr+1 ;!EMAS: nextsym=byteinteger(sptr) ;!EMAS: POS = POS+1 %if POS # 133 CHAR(POS) = SYM printsymbol(SYM) %if LIST <= 0 COLUMN = COLUMN+1 S5:%if SYM # nl %start %return %if QUOTE # 0; !dont alter strings SYM = MAPPED(SYM&127) %if SYM <= 3 %start; !special symbol ->S2 %if SYM = 0; !SPACE (or dubious control) SYMTYPE = 2 %and ->S3 %if SYM = 1; !% CONT = '+' %and ->S11 %if SYM = 3; !ff !must be { %cycle GET SYM ->S3 %if SYM = '}' ->S4 %if SYM = nl %repeat %finish KEY = KDICT(SYM) %if KEY&3 = 0 %and SYMTYPE = 2 %start; !keyword %if SYM = 'C' %and nextsym = nl %start; !%C... GETSYM; CONT = '+'; ->S1 %finish %finishelsestart SYMTYPE = KEY&3-2 %finish %return %finish S4:CONT = '+' SYMTYPE = QUOTE %end %integerfn FORMAT SELECTED FORMAT LIST = TAG(FORMAT)_APP; !number of names %if FORMAT LIST < 0 %start; !forward ref ATOM1 = ERROR+22 %result = 0 %finish %if SYM = '_' %start ESCAPE CLASS = ESC REC SEARCH BASE = TAG(FORMAT)_FORMAT %finish %result = 1 %end %routine CODE ATOM(%integer TARGET) %integer DBASE, DA %integer BASE, N, MUL,PEND QUOTE %integer J,K,L, PT %routine LOOKUP(%integer D) %constinteger MAGIC = 6700421 %integer NEW NAME, VID, K1, K2, FORM !IMP77: %RECORD(tagfm)%NAME t; !imp77: %record(TAGFM)%name T %longinteger K0 %integer NEW !first locate the text of the name NEW = addr(DICT(DMAX+1)) !IMP77: k2 = (hash value*magic)>>(32-2*name bits)!1; !IMP77: K0 = MAGIC K1 = (K0*HASH VALUE)&x'7FFFFFFF' K2 = K1>>(32-2*NAME BITS)!1 K1 = K2>>NAME BITS; !giving name bits %cycle NEWNAME = HASH(K1) %exit %if NEWNAME = 0; !not in ->IN %if string(addr(DICT(NEWNAME+1))) = string(NEW) K1 = (K1+K2)&MAX NAMES %repeat ! not found SPARE NAMES = SPARE NAMES-1 ABANDON(2) %if SPARE NAMES <= 0 HASH(K1) = DMAX; !put it in DICT(DMAX) = -1 NEWNAME = DMAX; DMAX = DP; ->NOT IN IN: SEARCH BASE = RBASE %if THIS >= 0 %and D # 0; !record elem defn %if SEARCH BASE # 0 %start; !record subname NEW = -1 X = SEARCH BASE %cycle ->NOT IN %if X < FORMAT LIST %exit %if TAG(X)_TEXT = NEW NAME X = X-1 %repeat %finish %else %start; !hash in for normal names X = DICT(NEWNAME) ->NOT IN %if X <= LIMIT; !wrong level %finish SUBATOM = X; !name found, extract info T == TAG(X) ATOM FLAGS = T_FLAGS FORMAT = T_FORMAT; APP = T_APP PROTECTION = ATOM FLAGS&PROT TYPE = ATOM FLAGS>>4&7; ATOM1 = AMAP(ATOM FLAGS&15) %if DIAG&8 # 0 %start printstring("lookup:") write(ATOM1, 3) write(TYPE, 1) write(APP, 3) write(FORMAT, 5) write(ATOM FLAGS,3) newline %finish %if D = 0 %start; !old name wanted T_FLAGS <- T_FLAGS!USED BIT SEARCH BASE = 0 %if ATOM FLAGS&SUBNAME # 0 %and FORMAT # 0 %start; !a record %return %if FORMAT SELECTED = 0 %finish %if ATOM FLAGS&PARAMETERS # 0 %start; !proc or array %if APP = 0 %start; !no parameters needed ATOM2 = ATOM1 ATOM1 = ATOM1-4 %if 97 <= ATOM1 <= 98 %start MAP GG = ATOM1; ATOM1 = VAR %finish %finish %else %start %if SYM = '(' %start SEARCH BASE = 0; !ignore format for now %if ATOM1 >= 106 %start; !arrays APP = PHRASE(APP+200) ESCAPE CLASS = ESC ARRAY ATOM1 = (ATOM1-106)>>1+91; !a,an->v na,nan->n %finish %else %start; !procedures ESCAPE CLASS = ESC PROC ATOM1 = ATOM1-4 %finish PHRASE(200)= APP ;! ready for analysis %finish %finish POS2 = POS; %return %finish !deal with constintegers etc %if ATOM FLAGS&CONST BIT # 0 %and ATOM1 = VAR %start MAP GG = CONST; ATOM2 = CONST SUBATOM = -SUBATOM %if TYPE = INTEGERX %finish %return %finish !new name wanted ->NOT IN %if TBASE # TSTART; !dont fault proc parm-parm %if D = LAB+SPEC+USED BIT %start T_FLAGS = T_FLAGS!USED BIT %return %finish %if ATOM FLAGS&SPEC # 0 %start; !a spec has been given %if D = LAB %start; !define label T_FLAGS <- LAB!USED BIT %return %finish %if 7 <= DECL&15 <= 10 %and DECL&SPEC = 0 %start !procedure definition after spec %if (DECL!!ATOM FLAGS)&b'1111111' = 0 %start; !correct type? T_FLAGS = T_FLAGS-SPEC SPEC GIVEN = 1 %return %finish !note that an external procedure must be speced as a !non-external procedure. %finish %if DECL&15 = RECFM %start; !recordformat T_FLAGS = RECORD<<4+RECFM T_FORMAT = FDEF %return %finish %finish %return %if LAST1 = JUMP %and ATOM1 = SWIT COPY = POS1 %if COPY = 0 NOTIN:APP = 0; VID = 0 ATOM1 = ERROR+2 %return %if D=0 ;! old name wanted TYPE=D>>4&7 FORM=D&15 ATOM1=AMAP(FORM) %if THIS < 0 %or APP < 0 %start; !normal scope NEW = NEWNAME TMAX = TMAX+1; X = TMAX %finish %else %start; !recordformat scope NEW = -1 RECID = RECID-1; VID = RECID TMIN = TMIN-1; X = TMIN FORMAT LIST = TMIN %finish %if 11 <= FORM <= 14 %start; !arrays DIM=1 %if DIM=0 ;! set dim for owns APP = DIM %finish D = D!USED BIT %if (OTYPE > 2 %and D&SPEC = 0) %or PERM # 0 !external definitions need not be used in the file in which !they are defined, so inhibit a useless unused warning. T == TAG(X) %if FORM = LAB %start ID = ID+1; VID = ID %finish T_INDEX = VID T_TEXT = NEW NAME T_FLAGS <- D T_APP = APP T_FORMAT = FDEF; FORMAT = FDEF SUBATOM = X %if NEW >= 0 %start; !insert into hash table T_LINK = DICT(NEW); DICT(NEW) = X %if GMIN = MAX GRAMMAR %start; !proc param params TMIN = TMIN-1; SUBATOM = TMIN TAG(TMIN) = T %finish %finish ABANDON(3) %if TMAX >= TMIN %end TOP: POS1 = POS SUBATOM = 0; PEND QUOTE = 0 !app and format must be left for assigning to papp & pformat ->NAME %if SYMTYPE = -2; !letter ->NUMBER %if SYMTYPE < 0; !digit %if SYMTYPE = 0 %start ATOM1 = TERMIN; ATOM2 = 0 %return %finish %if SYMTYPE # 2 %start; !catch keywords here ->TEXT %if QUOTE # 0; !completion of text ->STRINGS %if SYM = SQUOTE; !start of string ->SYMBOLS %if SYM = CQUOTE; !start of symbol ->NUMBER %if SYM = '.' %and '0' <= nextsym <= '9' %finish !locate atom in fixed dict K = KEY>>2; READ SYM %cycle J = KDICT(K) %exit %if J&x'4000' # 0 %if J&127 # SYM %or SYMTYPE < 0 %start ->ERR %unless J < 0 K = K+1 %finish %else %start L = J>>7&127; READ SYM %if J > 0 %start %if L # 0 %start ->ERR %if L # SYM %or SYMTYPE < 0 READ SYM %finish L = 1 %finish K = K+L %finish %repeat ATOM1 = J&127 %if ATOM1 = 0 %start; !comma ATOM1 = 19; SUBATOM = 19; ATOM2 = 0 %if SYM = nl %start %return %if OCOUNT >= 0 !special action needs to be taken with as !const array lists can be enormous READ SYM %finish %return %finish ATOM2 = J>>7&127 SUBATOM = KDICT(K+1)&x'3FFF' !!!!!cont = ' ' %return !report an error. adjust the error marker (pos1) to point !to the faulty character in an atom, but care needs to be taken !to prevent misleading reports in cases like ...????? ERR: ATOM1 = ERROR+1; ATOM2 = 0 POS1 = POS %if POS-POS1 > 2 %return !take care with strings and symbol constants. !make sure the constant is valid here before sucking it in !(and potentially loosing many lines) SYMBOLS:ATOM1 = VAR; ATOM2 = CONST; TYPE = INTEGERX MAP GG = CONST; PROTECTION = PROT SUBATOM = LP; ABANDON(3) %if LP >= LIT MAX QUOTE = \PEND QUOTE %return !an integer constant is acceptable so get it in and !get the next atom CHARS:N = 0; CONT = CQUOTE %cycle READ SYM %if SYM = CQUOTE %start %exit %if nextsym # CQUOTE READ SYM %finish %if N&(\((-1)>>BYTE SIZE)) # 0 %start; ! overflow POS1 = POS; ATOM1 = ERROR+10; %return %finish ->ERR %if QUOTE = 0 N = N<TOP !sniff the grammar before getting the string STRINGS:ATOM1 = VAR; ATOM2 = CONST; TYPE = STRINGV SUBATOM = (STRP-STBASE)!x'4000' MAP GG = CONST; PROTECTION = PROT QUOTE = SUBATOM TEXT LINE = LINES; !in case of errors %return !a string constant is ok here, so pull it in and get !the next atom TEXT: ->CHARS %if QUOTE < 0; !character consts L = STRP; N = STRP J = addr(GLINK(GMIN-1)); !absolute limit K = L+256; !string LENGTH limit K = J %if J < K; !choose lower %cycle CONT = SQUOTE; QUOTE = 1 %cycle READ SYM %if SYM = SQUOTE %start; !terminator? %exit %if nextsym # SQUOTE; !yes -> READ SYM; ! skip quote %finish L = L+1; byteinteger(L) = SYM LINES = TEXT LINE %and ABANDON(7) %if L >= K; !too many chars %repeat byteinteger(N) = L-N; !plug in LENGTH STRP = L+1; !ready for next string QUOTE = 0; CONT = ' '; READ SYM CODE ATOM(TARGET) %return %unless ATOM1 = 48 %and SYM = SQUOTE; !fold "???"."+++" %repeat %routine GET(%integer LIMIT) %integer S, SHIFT SHIFT = 0 %if BASE # 10 %start %if BASE = 16 %start SHIFT = 4 %finish %else %start %if BASE = 8 %start SHIFT = 3 %finish %else %start %if BASE = 2 %start SHIFT = 1 %finish %finish %finish %finish N = 0 %cycle %if SYMTYPE = -1 %start; !digit S = SYM-'0' %finish %else %start %if SYMTYPE < 0 %start; !letter S = SYM-'A'+10 %finish %else %start %return %finish %finish %return %if S >= LIMIT PT = PT+1; byteinteger(PT) = SYM %if BASE = 10 %start; !check overflow %if N >= MAX INT %and (S > MAX DIG %or N > MAX INT) %start !too big for an integer, !so call it a real BASE = 0; TYPE = REAL; N = 0 %finish %finish %if SHIFT = 0 %start N = N*BASE+S %finish %else %start N = N<= LIT MAX PT = STRP; MUL = 0 %cycle GET(BASE) %exit %unless SYM = '_' %and BASE # 0 %and PEND QUOTE = 0; !change of base READ SYM BASE = N %repeat %if PEND QUOTE # 0 %start ->ERR %if SYM # CQUOTE READSYM %finish %if SYM = '.' %start; !a real constant PT = PT+1; byteinteger(PT) = '.' READ SYM TYPE = REAL; BASE = 0; GET(10) %finish %if SYM = '@' %start; !an exponent PT = PT+1; byteinteger(PT) = '@'; K = PT READSYM TYPE = INTEGERX; BASE = 10 %if SYM = '-' %start READ SYM; GET(10); N = -N %finish %else %start GET(10) %finish PT = K+1; byteinteger(PT) = LP; LITPOOL(LP) = N; LP = LP+1 ATOM1 = ERROR+10 %if BASE = 0 TYPE = REAL; !exponents force the type %finish %if TYPE = REAL %start byteinteger(STRP) = PT-STRP SUBATOM = (STRP-STBASE)!x'2000'; STRP = PT+1 %finish %else %start LITPOOL(LP) = N LP = LP+1 %finish %return NAME: ATOM1 = 0 %and %return %if 27 <= TARGET <= 41 HASH VALUE = 0 !***************************** !*machine dependent for speed* !***************************** DP = DMAX+1 DA = addr(DICT(DP)); DBASE = DA %cycle HASH VALUE = (HASH VALUE+(HASH VALUE+SYM))&x'0FFFFFFF'; !is this good enough? DA = DA+1; byteinteger(DA) = SYM READ SYM %exit %if SYMTYPE >= 0 %repeat %if SYM = CQUOTE %start PEND QUOTE = 100 ->SYMBOLS %if HASH VALUE = 'M' READ SYM %if HASH VALUE = 'X' %then BASE = 16 %and ->BXK %if HASH VALUE = 'K' %c %or HASH VALUE = 'O' %then BASE =8 %and ->BXK %if HASH VALUE = 'B' %then BASE = 2 %and ->BXK ->ERR %finish N = DA-DBASE byteinteger(DBASE) = N DP = DP+(N+2)>>1 ABANDON(8) %if DP >= DMIN ATOM2 = 90; !ident %if LAST1 = 0 %and SYM = ':' %start; !label LIMIT = LOCAL; LOOKUP(LAB); %return %finish %if LAST1 = JUMP %start; !->label LIMIT = LOCAL; LOOKUP(LAB+SPEC+USED BIT); %return %finish %if DECL # 0 %and TARGET = 90 %start; !identifier SEARCH BASE = FM BASE LIMIT = LOCAL; LOOKUP(DECL) SEARCH BASE = 0 %finish %else %start LIMIT = 0; LOOKUP(0) %finish %end %integerfn PARSED MACHINE CODE ! *opcode_?????????? %routine OCTAL(%integer N) %integer M M = N>>3 OCTAL(M) %if M # 0 BP = BP+1; BUFF(BP) = N&7+'0' %end ATOM1 = ERROR %and %result=0 %unless SYMTYPE = -2; !starts with letter !EMAS: flush buffer %IF bp >= 128 BP=BP+1 %and BUFF(BP)='w' %cycle BP=BP+1 %and BUFF(BP)=SYM READ SYM %exit %if SYMTYPE >= 0; !pull in letters and digits %repeat BP=BP+1 %and BUFF(BP)='_' %if SYMTYPE # 0 %start; !not terminator ATOM1 = ERROR %and %result=0 %unless SYM = '_' READ SYM %while SYMTYPE # 0 %cycle %if SYMTYPE < 0 %start; !complex CODE ATOM(0); %result=0 %if ATOM1&ERROR # 0 %if ATOM2 = CONST %and TYPE = INTEGERX %start %if SUBATOM < 0 %then OCTAL(TAG(-SUBATOM)_FORMAT) %c %else OCTAL(LITPOOL(SUBATOM)) %finish %else %start %if 91 <= ATOM1 <= 109 %start OP(' ', TAG(SUBATOM)_INDEX) %finish %else %start ATOM1 = ERROR; %result=0 %finish %finish %finish %else %start BP=BP+1 %and BUFF(BP)=SYM; READ SYM %finish %repeat %finish BP=BP+1 %and BUFF(BP)=';' %result=1 %end CONT = ' ' %if GG = 0 LAST1 = 0 ; MAPGG=0 S = 0; SS = 0; SSTYPE = -1; FDEF = 0 FM BASE = 0 !deal with alignment following an error in one statement !of several on a line MARGIN = COLUMN; !start of statement POS = 0 APP = 0 STBASE = addr(GLINK(GMAX+1)); STRP = STBASE; LP = 0 TBASE = TSTART; !?????????????? LOCAL = TBASE %if GG = 0 %or OCOUNT >= 0 %start; !data or not continuation(z) AGAIN:%while SYM TYPE = 0 %cycle;!skip redundant terminators C = CONT CONT = ' '; CONT = '+' %if OCOUNT >= 0 READ SYM CONT = C %repeat ->SKIP %if SYM = '!'; !comment THIS = -1 CODE ATOM(0) %if ATOM1 = COMMENT %start SKIP: QUOTE = 1 C = CONT READ SYM %and CONT = C %while SYM # nl; !skip to end of line QUOTE = 0; SYMTYPE = 0 ->AGAIN %finish %finish DECL = 0; MARK = 0 GENTYPE = 0; FORCE = 0 DIM = 0; PROT ERR = 0 NODE = 0; NMAX = 0; NMIN = REC SIZE+1 ORDER = 1; GMIN = MAX GRAMMAR+1 SSTYPE = 0 %and ->MORE %if GG # 0; !continuation PTYPE = 0; SPEC GIVEN = 0 STATS = STATS+1; OP('O', LINES) %if PERM = 0 ->FAIL1 %if ATOM1&ERROR # 0; !first atom faulty %if ESCAPE CLASS # 0 %start; !enter the hard way after G = IMP PHRASE; SSTYPE = -1; ->A3 %finish G = INITIAL(ATOM1); !pick up entry point %if G = 0 %start; !invalid first atom G = INITIAL(0); SSTYPE = 0; ->A3; !declarator? %finish %if G < 0 %start; !phrase imp G = G&255 NMAX = 1 AR(1)_CLASS = 0; AR(1)_LINK = 0; AR(1)_SUB = IMP PHRASE %finish GG = GRAM(G); CLASS = GG&255; SSTYPE = GG>>12&3-1 ->A1 ACT(194): PTYPE = TYPE; PAPP = APP; PFORMAT = FORMAT; ->MORE ACT(196):K =G+1; ->A610 ACT(188):K = AR(NMAX)_SUB+1 A610: PAPP = GLINK(K) K = GRAM(K) ->MORE %if K = 0; !%NAME PTYPE = K&7; PFORMAT = K>>3 ACT(183):K = TYPE; GENTYPE = K %if GENTYPE = 0 %or K = REAL %if PFORMAT < 0 %start; !general type APP = PAPP; FORMAT = PFORMAT K = REAL %if PTYPE = REAL %and TYPE = INTEGERX K = FORCE %and FORCE = 0 %if FORCE # 0 %finish ->FAIL2 %unless PAPP = APP %and (PTYPE = K %or PTYPE = 0) ->MORE %if PFORMAT=FORMAT %or PFORMAT = 0 %or FORMAT = 0 %or CONTROL&1#0 ->FAIL2 ACT(197):ARP == AR(NMIN) K = ARP_SUB ARP_SUB=K>>4 ->FAIL3 %unless BLOCK FORM = K&15 %or CONTROL&2#0 TYPE = BLOCK TYPE PTYPE = BLOCK TYPE; PFORMAT = BLOCK FM; PAPP = APP PFORMAT = -1 %if PTYPE # RECORD ->MORE ACT(195):ARP == AR(NMIN) K = ARP_SUB ARP_SUB = K>>2 K = K&3 !1 = check integer !2 = check real !3 = check real + int ->MORE %if K = 0; !no action %if K = 1 %start FORCE = INTEGERX ->MORE %if TYPE = INTEGERX %or TYPE = 0 ->FAIL2 %finish ->FAIL2 %unless PTYPE = REAL FORCE = INTEGERX %if K = 3 ->MORE ACT(198):!%OTHER K = GG>>8&15 %if K = 0 %start; !restore atom ATOM1 = LAST1 ->MORE %finish %if K = 1 %start; !test string ->FAIL2 %unless TYPE = STRINGV ->MORE %finish %IF K=3 %START ;! check for own variable coming CODE ATOM(0) -> A7 %IF ATOM FLAGS&OWN BIT=0 ->MORE %FINISH FOR WARN = POS1 %if X <= LOCAL; !%FORTEST ->MORE PACTION(1):%if TYPE = RECORD %then G = PHRASE(242) %else PFORMAT = -1 ->A3 PACTION(2):PTYPE = REAL; PFORMAT = -1; ->A3 PACTION(3):PTYPE = STRINGV; PFORMAT = -1; ->A3 PACTION(4):PTYPE = INTEGERX; PFORMAT = -1; ->A3 PACTION(5):->A3 %if PTYPE = INTEGERX G = PHRASE(212) %and PFORMAT=-1 %if PTYPE = REAL G = PHRASE(213) %if PTYPE = STRINGV ->A3 PACTION(6):PTYPE = GRAM(AR(NMAX)_SUB+1)&7; PFORMAT = -1; ->A3 PACTION(7):PTYPE=REAL %if PTYPE = INTEGERX; PFORMAT=-1; ->A3 A1: LAST1 = CLASS; ATOM1 = 0; S = SUBATOM A2: %if GG&TRANS BIT = 0 %start; !insert into analysis record Z == NODE %cycle; !insert cell in order K = Z %exit %if GG&ORDER BITS = 0 %or K = 0 GG = GG-ORDER BIT; Z == AR(K)_LINK %repeat GG = MAP GG %if MAP GG # 0 %and GG&255 = VAR NMIN = NMIN-1; ->FAIL0 %if NMIN = NMAX Z = NMIN ARP == AR(NMIN) ARP_SUB = S; ARP_CLASS = (GG&255)!MARK ARP_LINK = K %finish MARK = 0; MAP GG = 0 MORE: G = GLINK(G); !chain down the grammar PACTION(0): A3: GG = GRAM(G); CLASS = GG&255 TRACE ANALYSIS %if DIAG&1 # 0 ->A5 %if CLASS = 0; !end of phrase %if CLASS < ACTIONS %start; !not a phrase or an action CLASS = ATOMIC(CLASS) %if CLASS >= FIGURATIVE ->A2 %if CLASS >= MANIFEST CODE ATOM(CLASS) %if ATOM1 = 0 %if ESCAPE CLASS # 0 %start; !escape to new grammar CLASS = ESCAPE CLASS; ESCAPE CLASS = 0 G = G+ESCAPE !note that following an escape the next item is !forced to be transparent! ESC: GG = 0 ARP == AR(NMAX+1) ARP_PAPP = PAPP; ARP_X = X; ->A4 %finish ->A1 %if CLASS = ATOM1 %or CLASS = ATOM2 A7: ->FAIL1 %if GG >= 0; !no alternative G = G+1 ->A3 %finish %if CLASS >= PHRASAL %start; !a phrase A4: NMAX = NMAX+1; ->FAIL0 %if NMAX = NMIN ARP == AR(NMAX) ARP_PTYPE = PTYPE ARP_POS = POS1 ARP_PFORMAT = PFORMAT ARP_LINK = GENTYPE ARP_CLASS = NODE ARP_SUB = G NODE = 0 G = PHRASE(CLASS) PTYPE = FORCE %and FORCE = 0 %if FORCE # 0 GENTYPE = 0 ->PACTION(GG>>8&15) %finish ->ACT(CLASS); !only actions left A5: !reverse links S = 0 %while NODE # 0 %cycle Z == AR(NODE)_LINK K = Z; Z = S; S = NODE; NODE = K %repeat SS = S A6: %if NMAX # 0 %start K = GENTYPE; !type of phrase ARP == AR(NMAX); NMAX = NMAX-1 NODE = ARP_CLASS GENTYPE = ARP_LINK PTYPE = ARP_PTYPE PFORMAT = ARP_PFORMAT G = ARP_SUB %if G&ESCAPE # 0 %start G = G-ESCAPE PAPP = ARP_PAPP MARK = 255 SUBATOM = S ->A3 %finish GENTYPE = K %if GENTYPE = 0 %or K = REAL TYPE = GEN TYPE K = GG; !exit-point code %cycle GG = GRAM(G) ->A2 %if K = 0 ->FAIL1 %if GG >= 0; !no alternative phrase K = K-ORDER BIT G = G+1; !sideways step %repeat %finish POS1 = COPY %and FAULT(4) %if COPY # 0 FAULT(13) %if ORDER = 0 FAULT(-4) %if FOR WARN # 0 POS1 = 0 FAULT RATE = FAULT RATE-1 %return ACT(193):GG = 0 %and ->A5 %unless SYM ='=' %or SYM='<'; !cdummy ACT(181):ATOM1 = AMAP(DECL&15) ; !dummy ->MORE ACT(182):CLASS = ESCDEC; G = GLINK(G)!ESCAPE DECL = 0; OTYPE = 0; ->ESC; !decl ACT(199): !reverse links; !compile S = 0 %while NODE # 0 %cycle Z == AR(NODE)_LINK K = Z; Z = S; S = NODE; NODE = K %repeat SS = S CODE ATOM(28) %if QUOTE # 0; !expend COMPILE; ->MORE %if ATOM1&ERROR = 0 ->FAIL1 ACT(184):->FAIL4 %unless TYPE = INTEGERX %if SUBATOM < 0 %then LIT = TAG(-SUBATOM)_FORMAT %c %else LIT = LIT POOL(SUBATOM) ->FAIL4 %if LIT # 0 ->MORE ACT(185): !apply parameters S = 0 %while NODE # 0 %cycle Z == AR(NODE)_LINK K = Z; Z = S; S = NODE; NODE = K %repeat SS = S ATOM1 = AR(S)_CLASS; ATOM2 = 0 ATOM1 = VAR %if ATOM1 = 97 %or ATOM1 = 98 ARP == AR(NMAX) X = ARP_X POS1 = ARP_POS POS2 = 0 APP = 0 FORMAT = TAG(X)_FORMAT FLAGS = TAG(X)_FLAGS TYPE = FLAGS>>4&7 PROTECTION = FLAGS&PROT PROTECTION = 0 %if FLAGS&ANAME # 0 %if FLAGS&SUBNAME # 0 %and FORMAT # 0 %start ->FAIL1 %if FORMAT SELECTED = 0 %finish ->A6 ACT(187):PROTECTION = PROT; ->MORE; !%SETPROT ACT(186):PROT ERR = NMIN %and ->A7 %if PROTECTION&PROT # 0; !%PROT ->MORE ACT(191):K = PROTECTION; !%GUARD CODE ATOM(0) PROTECTION = K %if ATOM FLAGS&ANAME = 0 ->MORE ACT(192):->FAIL1 %if PARSED MACHINE CODE=0 ->MORE ACT(189):K = GAPP; !%GAPP DELETE NAMES(1) TMAX = TBASE; TBASE = GRAM (GMIN); !restore tmax LOCAL= TBASE GMIN = GMIN+1 X = AR(AR(NMAX)_CLASS)_SUB TAG(X)_APP = K; !update app ->MORE ACT(190):GMIN = GMIN-1; !%LOCAL ABANDON(2) %if GMIN <= GMAX GRAM (GMIN) = TBASE; TBASE = TMAX LOCAL = TBASE ->MORE ! errors FAIL4:K = ERROR+10; ->FAILED; !*size FAIL3:K = ERROR+7; ->FAILED; !*context FAIL2:K = ERROR+5; POS2 = 0; ->FAILED; !*type FAIL0:K = ERROR+3; ->FAILED; !*too complex FAIL1:K = ATOM1 FAILED: %if DIAG&32 # 0 %start printstring("Atom1 =") write(ATOM1, 3) printstring(" Atom2 =") write(ATOM2, 3) printstring(" subatom =") write(SUBATOM, 3) newline printstring("Type =") write(TYPE, 1) printstring(" Ptype =") write(PTYPE, 1) newline printstring("App =") write(APP, 1) printstring(" Papp =") write(PAPP, 1) newline printstring("Format =") write(FORMAT, 1) printstring(" Pformat =") write(PFORMAT, 1) newline %signal 13,15 %finish QUOTE = 0 %and READSYM %while SYM # nl %and SYM # ';' %if K&ERROR # 0 %start FAULT(K&255) %finish %else %start %if PROT ERR = NMIN %then FAULT(14) %else FAULT(0) %finish GG = 0; SS = 0; SYMTYPE = 0 %end; !of analyse %routine COMPILE %constinteger THEN = 4, ELSE = 8, LOOP = 16 %switch C(0:ACTIONS), LITOP(1:12) %constbyteintegerarray OPERATOR(1:14) = %c '[', ']', 'X', '/', '&', '!', '%', '+', '-', '*', 'Q', 'x', '.', 'v' %constbyteintegerarray CC(0 : 7) = '#','=',')','<','(','>', 'k','t' %constintegerarray ANYFORM(0:15) = 1,0,1,1(4),1,0,1,1,0,1,1,1,1 %constintegerarray DECMAP(0:15) = %c 1, 2, x'100B', x'100D', x'140C', x'140E', 3, 4, x'1007', x'1008', x'1009', x'100A', 6, 0, 0, 0 %ownintegerarray CNEST(0:15) %integer LMODE, CLAB ,DUPID %integer RESLN %owninteger LAST DEF = 0 %owninteger LB, UB %integer CP, ORD %integer NEXT, LINK, J, K, N, DONE %integer CLASS %integer LIT2, DEFS, DECS, CIDENT %integer PENDING; %ownintegerarray PSTACK(1:40) %ownstring(8) NAME = "" %owninteger COUNT = 0 %routine DEF LAB(%integer L) OP(':', L) ACCESS = 1 %end %routine GET NEXT !IMP77: %RECORD(arfm)%NAME p; !imp77: %record(ARFM)%name P GN: %if NEXT = 0 %start; !end of phrase CLASS = 0 %and %return %if LINK = 0; !end of statement P == AR(LINK) NEXT = P_LINK LINK = P_SUB %finish %cycle P == AR(NEXT) X = P_SUB CLASS = P_CLASS %exit %if CLASS < ACTIONS; !an atom %if X = 0 %start; !null phrase NEXT = P_LINK; ->GN %finish %if P_LINK # 0 %start; !follow a phrase P_SUB = LINK; LINK = NEXT %finish NEXT = X %repeat NEXT = P_LINK %if DIAG&2 # 0 %start spaces(8-length(NAME)) %unless NAME = "" NAME = TEXT(CLASS) write(X, 2) space printstring(NAME) space COUNT = COUNT-1 %if COUNT <= 0 %start COUNT = 5 NAME = "" newline %finish %finish %end %routine SET SUBS(%integer N) !update the app field in n array descriptors %integer P P = TMAX %while N > 0 %cycle ! %SIGNAL 15,15 %IF p < tbase ;!INVALID EVENT TAG(P)_APP = DIMENSION P = P-1; N = N-1 %repeat %end %routine SET BP !define a constant bound pair from the last stacked constants PENDING = PENDING-2 LB = PSTACK(PENDING+1); UB = PSTACK(PENDING+2) %if UB-LB+1 < 0 %start POS1 = 0; NEXT = LINK; FAULT(11) UB = LB %finish SET CONST(LB); SET CONST(UB) BP=BP+1 %and BUFF(BP)='b' %unless CLASS = 146 %end %routine COMPILE END(%integer TYPE) ! type = 0:eof, 1:eop, 2:end %if ACCESS # 0 %start OPEN = 0 FAULT(19) %if BLOCK FORM > PROC; !can reach end %finish %while DICT(DMIN) >= 0 %cycle; !finishes & repeats FAULT(17+DICT(DMIN)&1) DMIN = DMIN+1 %repeat BP=BP+1 %and BUFF(BP)=';' BP=BP+1 %and BUFF(BP)=';' %if TYPE = 1; !endofprogram BFLAGS = BFLAGS!OPEN; !show if it returns DEF LAB(0) %if BLOCK TAG # 0 %and LEVEL # 1; !for jump around %if TYPE # 2 %start; !eop, eof FAULT(16) %if LEVEL # TYPE; !end missing %finish %else %start %if LEVEL = 0 %start FAULT(15); !spurious end %finish %finish !IMP77: PRINTSYMBOL(11); !IMP77: %end %routine DEF(%integer P) !dump a descriptor %integer T, F, TYPE !IMP77: %RECORD(tagfm)%NAME v; !imp77: %record(TAGFM)%name V DEFS = DEFS+1 V == TAG(P) T = 0 %unless V_INDEX < 0 %start; !no index for subnames ID = ID+1 %and V_INDEX = ID %if V_INDEX = 0 LAST DEF = V_INDEX T = LAST DEF %finish OP('$', T) PRINT IDENT(P, 1); !output the name T = V_FLAGS TYPE = T TYPE = TYPE&(\(7<<4)) %if TYPE&(7<<4) >= 6<<4;!routine & pred OP(',', TYPE&b'1111111'); !type & form F = V_FORMAT F = TAG(F)_INDEX %if T&x'70' = RECORD<<4 F = V_INDEX %if F < 0 OP(',', F); !format F = OTYPE+T>>4&b'1111000' F = F!8 %if CLASS = 125; !add spec from %DUP DIM = V_APP DIM=0 %unless 0>4+P BIT = 1<<(B&15) %if DICT(W+2)&BIT # 0 %start; !already set FAULT(4) %if PENDING # 0 %return %finish DICT(W+2) <- DICT(W+2)!BIT %if PENDING # 0 SET CONST(N) OP('_', TAG(X)_INDEX) %finish %else %start FAULT(12) %finish ACCESS = 1 %end %routine CALL !IMP77: %RECORD(tagfm)%NAME T; !IMP77: %record(TAGFM)%name T T == TAG(X) OP('@', T_INDEX) ACCESS = 0 %if T_FLAGS&CLOSED # 0; !never comes back BP=BP+1 %and BUFF(BP)='E' %if T_APP = 0; !no parameters %end %routine POP DEF SET CONST(PSTACK(PENDING)); PENDING = PENDING-1 %end %routine POP LIT %if PENDING = 0 %then LIT = 0 %else %start LIT = PSTACK(PENDING); PENDING = PENDING-1 %finish %end %if SSTYPE < 0 %start; !executable statement %if LEVEL = 0 %start; !outermost level FAULT(13); !*order %finish %else %start %if ACCESS = 0 %start ACCESS = 1; FAULT(-1); !only a warning %finish %finish %finish %if DIAG&2 # 0 %start newline %if SYM # nl printstring("ss =") write(SS, 1) newline COUNT = 5 NAME = "" %finish NEXT = SS PENDING = 0; LMODE = 0 LINK = 0; DECS = 0 DEFS = 0; RESLN = 0; DONE = 0 ORD = LEVEL ORD = 1 %if THIS >= 0; !recordformat declarations C(0): TOP: %if NEXT # LINK %start GET NEXT; ->C(CLASS) %finish !all done, tidy up declarations and jumps newline %if DIAG&2 # 0 %and COUNT # 5 %if LMODE&(LOOP!THEN!ELSE) # 0 %start; !pending labels and jumps OP('B', LABEL-1) %if LMODE&LOOP # 0; !repeat DEF LAB(LABEL) %if LMODE&THEN # 0; !entry from then DEF LAB(LABEL-1) %if LMODE&ELSE # 0; !entry from else %finish %return %if DECS = 0 ATOM1 = ERROR %and %return %if ATOM1 # 0; !%INTEGERROUTINE ORDER = ORD DECL = DECL&(\15)+DECMAP(DECL&15); !construct declarator flags ATOM1 = ATOMS(DECL&15); !generate class %if OTYPE # 0 %start; !own, const etc. ATOM1 = ATOM1+1 %if ATOM1 # PROC %if OTYPE = 2 %start; !const N = DECL&15 %if N&1 # 0 %start DECL = DECL!PROT DECL = DECL!CONST BIT %if DECL&b'1111111' = IFORM %finish %finish %ELSE %START DECL=DECL!OWN BIT %FINISH %finish SSTYPE = 1 %if SSTYPE = 0 %and ATOM1 = PROC ATOM1 = ATOM1+1 %if DECL&SPEC # 0; !onto spec variant OCOUNT = 0 %and CONT = '+' %if ATOM1 = 5; !own array %if ANYFORM(DECL&15) = 0 %start; !check meaningful %if DECL>>4&7 = RECORD %start THIS = FDEF %if TAG(FDEF)_FLAGS&SPEC # 0 ATOM1 = ERROR+21 %if FDEF = THIS; !*context for format %finish ATOM1 = ERROR+10 %if FDEF = 0; !*size %finish %return ATOP: ACCESS = 0; ->TOP ! declarators C(88): !rtype C(28): DECL = X&(\7); !stype FDEF = X&7; !precision FDEF = REALS LN %if X&b'1110001' = REAL<<4+1; !convert to long DECS = 1; ->TOP C(34): !own C(35): OTYPE = X; ORD = 1; ->TOP; !external C(152):DECL = DECL+X<<1; ->TOP; !xname C(31): !proc C(32): SPEC MODE = LEVEL+1; !fn/map DECL = DECL!PROT %if X = 9; !function C(29): ORD = 1 ; DIM= 0 ;!array C(30): DECL = DECL+X; !name DECS = 1 ->TOP C(27): LIT = 0; ! arrayd %if PENDING # 0 %start POP LIT %unless 0 TOP C(37): X = X!SUBNAME; !record C(36): LIT = 0; !string %if PENDING # 0 %start POP LIT %unless 0 < LIT <= 255 %start; !max LENGTH wrong ATOM1 = ERROR+10; %return %finish %finish FDEF = LIT; !format or LENGTH C(33): DECL = X; !switch DECS = 1 ->TOP C(39): DECL = DECL!SPEC; !spec OCOUNT = -1; !no initialisation SPEC MODE = -1 ->TOP C(38): DECL = 64+4; !recordformat (spec) ORDER = 1 ATOM1 = X DECL = DECL!SPEC %if ATOM1=12 ;! formatspec FDEF = TMAX+1; !format tag %return C(175): ID=ID+1 ;! fsid TAG(X)_INDEX=ID %return C(41): DECS = 1; DECL = X!SPEC; ->TOP; !label C(133):RECID = 0; RBASE = TMIN-1; !fname THIS = X FM BASE = FDEF; FORMAT LIST = TMIN DEF(THIS); ->TOP C(148):FDEF = 0 %and ->TOP %if NEXT = 0; !reclb GET NEXT; !skip name FDEF = X ->TOP C(127):BP=BP+1 %and BUFF(BP)='}'; ->TOP; !%POUT C(126):BP=BP+1 %and BUFF(BP)='{'; ->TOP; !%PIN C(174):SET BP; !rangerb C(171): !fmlb C(172): !fmrb C(173):BP=BP+1 %and BUFF(BP)='~'; BP=BP+1 %and BUFF(BP)=CLASS-171+'A'; ->TOP; !fmor C(168):RBASE = -RBASE; !orrb SSTYPE = 0; SPEC MODE = 0 C(147):SEARCH BASE = 0; !recrb TAG(THIS)_APP = TMIN TAG(THIS)_FORMAT = RBASE ->TOP C(45):BP=BP+1 %and BUFF(BP)='U' %if X = 36; ->TOP; !sign C(46):BP=BP+1 %and BUFF(BP)='\'; ->TOP; !uop C(47): !mod C(48): !dot C(42): !op1 C(43): !op2 C(44):BP=BP+1 %and BUFF(BP)=OPERATOR(X); ->TOP; !op3 !conditions & jumps %routine PUSH(%integer X) %if CNEST(CP)&2 # X %start CNEST(CP) = CNEST(CP)!1; X = X+4 %finish CLAB = CLAB+1 %if CNEST(CP)&1 # 0 CNEST(CP+1) = X; CP = CP+1 %end %routine POP LABEL(%integer MODE) LMODE = DICT(DMIN) %if LMODE < 0 %or LMODE&1 # MODE %start FAULT(MODE+8) %finish %else %start DMIN = DMIN+1; LABEL = LABEL-3 %finish %end C(56): !and C(57):PUSH(X); ->TOP; !or C(58):CNEST(CP) = CNEST(CP)!!2; ->TOP; !not C(138):X = 128+32+16+4; !csep: treat like %WHILE C(59): !while C(60):%if CLASS = 138 %then OP('f', LABEL-1) %c %else DEF LAB(LABEL-1); !until C(166): !runtil C(62):LMODE = (LMODE&(ELSE!LOOP)) !(X>>3); !cword CLAB = LABEL; CP = 1; CNEST(1) = X&7 ->TOP C(72):POP LABEL(0); !repeat DEF LAB(LABEL+1) %if LMODE&32 # 0; ->ATOP C(69):POP LABEL(1); ->TOP; !finish C(163): !xelse C(70):POP LABEL(1); !finish else ... FAULT(7) %if LMODE&3 = 3; !dangling else C(68):LMODE = (LMODE&ELSE)!3; !...else... %if ACCESS # 0 %start OP('F', LABEL-1); LMODE = ELSE!3 %finish DEF LAB(LABEL) ->TOP %if NEXT # 0 C(120): !%MSTART C(67): !start C(71): !cycle STCY: DEF LAB(LABEL-1) %and LMODE = LOOP %if LMODE = 0;!cycle DMIN = DMIN-1; ABANDON(3) %if DMIN <= DMAX DICT(DMIN) = LMODE LABEL = LABEL+3 %return C(64):FAULT(13) %if DICT(DMIN) >= 0 %or INHIBIT # 0; !on event INHIBIT = 1 LAST ARRAY = TMAX-1 N = 0 N = x'FFFF' %if PENDING = 0; !* = all events %while PENDING > 0 %cycle POP LIT; FAULT(10) %if LIT&(\15) # 0;!too big J = 1<STCY C(104):OP('J', TAG(X)_INDEX); !l INHIBIT = 1; ->ATOP C(149):STATS = STATS-1; !lab ACCESS = 1; INHIBIT = 1 FAULT(13) %if X < LAST ARRAY; !jump round array dec OP('L', TAG(X)_INDEX); ->TOP C(63):J = DMIN; L = LABEL-3; !exit, continue %cycle FAULT(7) %and ->TOP %if DICT(J) < 0 %exit %if DICT(J)&1 = 0 J = J+1; L = L-3 %repeat L = L+1 %if X = 32; !continue OP('F', L) DICT(J) = DICT(J)!X; !show given ->ATOP C(50):BP=BP+1 %and BUFF(BP)='C'; ->COP; !acomp C(49): BP = BP+1 %if NEXT # 0 %start; !comparator BUFF(BP)='"'; PUSH(0); !double sided %finish %else %start BUFF(BP)='?' %finish COP: X = X!!1 %if CNEST(CP)&2 # 0; !invert the condition J = CP; L = CLAB %while CNEST(J)&4 = 0 %cycle J = J-1; L = L-CNEST(J)&1 %repeat OP(CC(X), L) DEF LAB(CLAB+1) %if CNEST(CP)&1 # 0 CP = CP-1 CLAB = CLAB-CNEST(CP)&1 ->TOP C(78): !fresult C(79): !mresult C(80): OPEN = 0; !return, true, false C(82): ACCESS = 0; !stop C(89): !addop C(81): BP=BP+1 %and BUFF(BP)=X; ->TOP; !monitor C(65): POP LIT; OP('e', LIT); ->ATOP; !signal C(51): BP=BP+1 %and BUFF(BP)='S'; ->TOP; !eq C(53): BP=BP+1 %and BUFF(BP)='j'; ->TOP; !jam transfer C(52): BP=BP+1 %and BUFF(BP)='Z'; ->TOP; !eqeq C(74):%if LEVEL = 0 %start; !begin %if PROGMODE <= 0 %then PROGMODE = 1 %else FAULT(7) %finish SPEC MODE = LEVEL+1 BLOCK X = 0 BP=BP+1 %and BUFF(BP)='H'; %return C(77):PERM = 0; LINES = 0; STATS = 0; !endofperm !EMAS: close input !EMAS: select input(source) sptr=com46+32 ;!EMAS: send=com46+integer(com46) ;!EMAS: LIST = LIST-1 TBASE = TMAX; TSTART = TMAX %return C(76):%if INCLUDE # 0 %and X = 0 %start; !end of ... LINES = INCLUDE; SSTYPE = 0; !include !EMAS: close input LIST = INCLUDE LIST INCLUDE = 0 !EMAS: select input(source) sptr=oldsptr ;!EMAS: send = oldsend ;!EMAS: bp=bp+1 ; buff(bp)='~' bp=bp+1 ; buff(bp)='E' %return %finish SS = -1; !prog/file C(75):COMPILE END(X); %return; !%END C(85):%if X=0 %then CONTROL=LIT %else %start; !control DIAG = LIT&x'3FFF' %if LIT>>14&3 = 1 %finish OP('z'-X, LIT) ->TOP C(83):LIST = LIST+X-2; ->TOP; !%LIST/%ENDOFLIST C(84):REALS LN = X; ->TOP; !%REALS long/normal C(86):%if INCLUDE # 0 %start; !include "file" FAULT(7); %return %finish GET NEXT; !sconst INCLUDE FILE = string(X-x'4000'+STBASE) !EMAS: open input(3, include file) ABANDON(9) %if comreg(0) # 0 connect(INCLUDE FILE,0,0,0,r,flag) ;!EMAS: %if flag#0 %then ABANDON(9) ;!EMAS oldsptr=sptr ; oldsend=send ;!EMAS: sptr=r_conad+32 ;!EMAS: send=r_conad+integer(r_conad) ;! EMAS: INCLUDE = LINES; LINES = -1 INCLUDE LIST = LIST bp=bp+1 ; buff(bp)='~' bp=bp+1 ; buff(bp)='D' bp=bp+1 move(length(include file)+1,addr(include file), %c addr(buff(bp))) bp=bp+length(include file) !EMAS: SELECT INPUT(3) ->TOP C(154):DIMENSION = DIMENSION+1; !dbsep FAULT(11) %if DIMENSION = DIM LIMIT+1 ->TOP C(145):SET BP; ->TOP; !crb C(146):SET BP; !rcrb C(142): !bplrb DIMENSION = 1 %if DIMENSION = 0 OP('d', DIMENSION); OP(',', DEFS) %if CLASS # 146 %start SET SUBS(DEFS) LAST ARRAY = TMAX-1 FAULT(13) %if DICT(DMIN) >= 0 %or INHIBIT # 0 %or LEVEL=0 %finish DIMENSION = 0; DEFS = 0 ->TOP C(128): ID=DUPID ; ->TOP ;!EDUP C(130):BLOCK X = X OP('F', 0) %if DECL&SPEC = 0 %and LEVEL # 0; !jump round proc C(125): DUPID=ID; !%DUP C(90): DEF(X); ->TOP; !ident C(131): !cident %if TAG(X)_FLAGS&(b'1111111'+CONST BIT) = IFORM+CONST BIT %start TAG(X)_FORMAT = LIT %finish %else %start SET CONST(LIT) %if PENDING # 0 DEF(X) OP('A', 1) %finish CIDENT = X ->TOP C(124):DUBIOUS = 1 %if TAG(CIDENT)_FLAGS&PROT # 0; !%DUBIOUS ->TOP C(97): !f C(98): !m C(99): !p C(96): CALL; ->TOP; !r C(165): !NLab C(100): !rp C(101): !fp C(102): !mp C(103): !pp C(91): !v C(92): !n C(106): !a C(107): !an C(108): !na C(109): !nan K = TAG(X)_INDEX %if K < 0 %then OP('n', -K) %else OP('@', K) ->TOP C(121):SET CONST(0); ->TOP; !special for zero C(167):BP=BP+1 %and BUFF(BP)='G'; ->PSTR; !aconst (alias) C(CONST): !const %if X < 0 %start; !constinteger SET CONST(TAG(-X)_FORMAT); ->TOP %finish %if X&x'4000' # 0 %start; !strings BP=BP+1 %and BUFF(BP)='''' PSTR: X = X-x'4000'+STBASE K = byteinteger(X) BP=BP+1 %and BUFF(BP)=K K = K+X %cycle ->TOP %if X = K X = X+1; BP=BP+1 %and BUFF(BP)=byteinteger(X) %repeat %finish %if X&x'2000' # 0 %start; !real X = X-x'2000'+STBASE K = byteinteger(X) OP('D', K); BP=BP+1 %and BUFF(BP)=',' K = K+X %cycle ->TOP %if X = K X = X+1; J = byteinteger(X) %if J = '@' %start OP('@', LITPOOL(byteinteger(X+1))); ->TOP %finish BP=BP+1 %and BUFF(BP)=J %repeat %finish SET CONST(LIT POOL(X)) ->TOP C(137):BP=BP+1 %and BUFF(BP)='i'; ->TOP; !asep C(141):BP=BP+1 %and BUFF(BP)='a'; ->TOP; !arb !own arrays C(132):OCOUNT = UB-LB+1 DEF(X); !oident DIMENSION = 1; SET SUBS(1) %if NEXT = 0 %start; !no initialisation OP('A', OCOUNT) %if OCOUNT > 0 OCOUNT = -1 %finish %else %start; !initialisation given GET NEXT %finish ->TOP C(162):LIT = OCOUNT; ->INS; !indef C(143):POP LIT; !orb INS: FAULT(10) %and LIT = 0 %if LIT < 0 GET NEXT ->INST C(139): !osep (x=19) C(153):LIT = 1 INST: POP DEF %if PENDING # 0; !ownt (x=0) OP('A', LIT) OCOUNT = OCOUNT-LIT %if OCOUNT >= 0 %start ->TOP %if X # 0; !more coming OCOUNT = -1 %and %return %if OCOUNT = 0; !all done %finish GG=0 FAULT(11); %return C(SWIT):OP('W', TAG(X)_INDEX); INHIBIT = 1; ->ATOP C(134):DEF(X); !swid N = UB-LB+1 N = (N+15)>>4; !slots needed ( includes zero ) J = DMAX; DMAX = DMAX+N+2 ABANDON(1) %if DMAX >= DMIN TAG(X)_FORMAT = J DICT(J) = LB; DICT(J+1) = UB %cycle N = N-1 ->TOP %if N < 0 J=J+1 ; DICT(J+1)=0 %repeat C(151):STATS = STATS-1; !slab FAULT(7) %and %return %if X < TBASE %if PENDING # 0 %start; !explicit label DEF S LAB(PSTACK(1)) %finish %else %start FAULT(4) %and %return %if TAG(X)_APP # 0 TAG(X)_APP = 1 N = TAG(X)_FORMAT !IMP77: %FOR j = dict(n), 1, dict(n+1) %CYCLE; !imp77: !IMP77: def s lab(j); !imp77: !EMAS: flush buffer %IF bp >= 128 !IMP77: %REPEAT; !imp77: %cycle J=DICT(N),1,DICT(N+1) ;!EMAS: DEF S LAB(J) ;!EMAS: %repeat ;!EMAS: %finish INHIBIT = 1 %return C(140):BP=BP+1 %and BUFF(BP)='p'; ->TOP; !psep C(144):BUFF(BP+1)='p'; BUFF(BP+2)='E'; BP=BP+2; ->TOP; !prb !constant expressions C(155): !pconst %if X < 0 %then LIT = TAG(-X)_FORMAT %else LIT = LIT POOL(X) PENDING = PENDING+1; PSTACK(PENDING) = LIT; ->TOP C(156):LIT = PSTACK(PENDING); LIT = -LIT %if LIT < 0 PSTACK(PENDING) = LIT; ->TOP; !cmod C(157):LIT = -PSTACK(PENDING); PSTACK(PENDING) = LIT; ->TOP; !csign C(158):LIT = \PSTACK(PENDING); PSTACK(PENDING) = LIT; ->TOP; !cuop C(159): !cop1 C(160): !cop2 C(161):PENDING = PENDING-1; !cop3 LIT2 = PSTACK(PENDING+1); LIT = PSTACK(PENDING) ->LITOP(X>>2) LITOP(10):LIT = LIT*LIT2; ->SETL LITOP(12): LITOP(3):N = 1; !lit = lit\\lit2 FAULT(10) %if LIT2 < 0 %while LIT2 > 0 %cycle LIT2 = LIT2-1 N = N*LIT %repeat LIT = N; ->SETL LITOP(1):LIT = LIT<SETL LITOP(2):LIT = LIT>>LIT2; ->SETL LITOP(5):LIT = LIT&LIT2; ->SETL LITOP(11): LITOP(4):%if LIT2 = 0 %then FAULT(10) %else LIT = LIT//LIT2 ->SETL LITOP(8):LIT = LIT+LIT2; ->SETL LITOP(9):LIT = LIT-LIT2; ->SETL LITOP(6):LIT = LIT!LIT2; ->SETL LITOP(7):LIT = LIT!!LIT2 SETL: PSTACK(PENDING) = LIT; ->TOP C(170): !option string BUFF(BP+1) = '~'; BUFF(BP+2) = 'D'; BP = BP+2 ->PSTR !string resolution C(135):RESLN = 2; ->TOP; !dotl C(136):RESLN = RESLN+1; ->TOP; !dotr C(55): OP('r', RESLN); RESLN = 0; ->TOP; !resop C(164):OP('r', RESLN+4); RESLN = 0; !cresop C(122):X = 6; ->COP; !%PRED C(87):SET CONST(PSTACK(1)); !mass BP=BP+1 %and BUFF(BP)='P'; ->TOP %end %end; !of compile block !!!!! %ON 9 %START !!!!! abandon(5) !!!!! %FINISH !IMP77: list = 15 %IF comreg(14)&x'1000' # 0; !IMP77: !EMAS: selectinput(2) X=comreg(14) ;!EMAS: %if X=0 %start ;!EMAS: setwork(X,flag) ;!EMAS: %if flag#0 %then ABANDON(12) ;!EMAS: %finish ;!EMAS: buffsize=integer(X+8)-32 ;!EMAS: outfile("IMP#INT",buffsize+32,0,temporary,outconad,flag) ;!EMAS: ABANDON(10) %IF FLAG#0 outptr=outconad+32 ;!EMAS: outend=outconad+x'40000' ;!EMAS: BUFF==array(outptr,bufffm) ;!EMAS: com46=comreg(46) ;!EMAS: ABANDON(5) %if com46=0 ;!EMAS: sptr=permad+32 ;!EMAS: send=permad+integer(permad) ;!EMAS: %if comreg(27)&2#0 %then LIST=2 ;!EMAS: selectoutput(LISTING) TAG(MAX TAG) = 0; !%BEGIN defn TAG(0) = 0; !%BEGIN tag! TAG(0)_FLAGS=7 !IMP77: %FOR x = 0, 1, max names %CYCLE; !imp77: !IMP77: hash(x) = 0; !imp77: !IMP77: %REPEAT; !imp77: %cycle X = 0, 1, MAX NAMES HASH(X) = 0 %repeat printstring(" Edinburgh IMP77 Compiler - Version ") printstring(imp11VERSION); newlines(2) OP('l', 1) COMPILE BLOCK(0, 0, MAX DICT, 0, 0) BP=BP+1 %and BUFF(BP)=nl; !for bouncing off !EMAS: flush buffer integer(outconad)=BP+32 ;!EMAS: comreg(46)=outconad ;!EMAS: %result=STATS %if FAULTY=0 ;!EMAS: %result=-FAULTY ;!EMAS: %end %endoffile