Edinburgh IMP77 Compiler - Version 8.4 1 ! IMP77 compiler first pass 2 3 !################################################### 4 ! This program is a Copyright work. Over the last # 5 ! 20+ years a long and distinguished list of # 6 !institutions, individuals and other entities have # 7 !contributed portions of this program and may have # 8 ! reasonable claim over rights to certain parts of # 9 ! the program. This version is therefore provided # 10 ! for education and demonstration purposes only # 11 !################################################### 12 13 %BEGIN 14 %CONSTSTRING(4) version = "8.4" 15 16 !configuration parameters 17 18 %CONSTINTEGER max int = ((-1)>>1)//10 19 %CONSTINTEGER max dig = (-1)>>1-maxint*10 20 %CONSTINTEGER byte size = 8; !bits per byte 21 %CONSTINTEGER max tag = 800; !max no. of tags 22 %CONSTINTEGER max dict = 6000; !max extent of dictionary 23 %CONSTINTEGER name bits = 11; !size of name table as a power of two 24 %CONSTINTEGER max names = 1<0 strings, <0 chars 142 %owninteger end mark = 0; !%end flag 143 %OWNINTEGER cont = ' ' 144 %OWNINTEGER csym = ' '; !listing continuation marker 145 %OWNINTEGER decl = 0; !current declarator flags 146 %OWNINTEGER dim = 0; !arrayname dimension 147 %OWNINTEGER spec given = 0 148 149 %OWNINTEGER escape class = 0; !when and where to escape 150 %OWNINTEGER protection = 0 151 %OWNINTEGER atom flags = 0 152 %OWNINTEGER otype = 0; !current 'own' type 153 %OWNINTEGER reals ln = 1; ! =4 for %REALSLONG 154 %OWNINTEGER last1 = 0; !previous atom class 155 %OWNINTEGER gen type = 0 156 %OWNINTEGER ptype = 0; !current phrase type 157 %OWNINTEGER papp = 0; !current phrase parameters 158 %OWNINTEGER pformat = 0; !current phrase format 159 %OWNINTEGER force = 0; !force next ptype 160 %OWNINTEGER g = 0 161 %OWNINTEGER gg = 0 162 %OWNINTEGER map gg = 0; !grammar entries 163 %OWNINTEGER fdef = 0; !current format definition 164 %OWNINTEGER this = -1; !current recordformat tag 165 %OWNINTEGER nmin = 0; !analysis record atom pointer 166 %OWNINTEGER nmax = 0; !analysis record phrase pointer 167 %OWNINTEGER rbase = 0; !record format definition base 168 %OWNINTEGER gmin = max grammar; !upper bound on grammar 169 %OWNINTEGER dmax = 1 170 %OWNINTEGER tmin = max tag; !upper bound on tags 171 %OWNINTEGER ss = 0; !source statement entry 172 %STRING(63) include file 173 %OWNINTEGER include list = 0 174 %OWNINTEGER include level= 0 175 %OWNINTEGER include = 0; !=0 unused, #0 being used 176 %OWNINTEGER perm = 1; !1 = compiling perm, 0 = program 177 %OWNINTEGER progmode = 0; !-1 = file, 1 = begin/eop 178 %OWNINTEGER sstype = 0; !-1:exec stat 179 ! 0: declaration 180 ! 1: block in 181 ! 2: block out 182 %OWNINTEGER spec mode = 0; !>=0: definition 183 ! -1: proc spec 184 ! -2: recordformat 185 %OWNINTEGER ocount = -1; !own constants wanted 186 %OWNINTEGER limit = 0; !lookup limit 187 %OWNINTEGER copy = 0; !duplicate name flag 188 %OWNINTEGER order = 0; !out of sequence flag 189 %OWNINTEGER for warn = 0; !non-local flag 190 %OWNINTEGER dubious = 0; !flag for dubious statements 191 %OWNINTEGER dp = 1 192 %OWNINTEGER pos1 = 0 193 %OWNINTEGER pos2 = 0; !error position 194 %OWNINTEGER pos = 0; !input line index 195 %OWNINTEGER dimension = 0; !current array dimension 196 %OWNINTEGER local = 0; !search limit for locals 197 %OWNINTEGER fm base = 0; !entry for format decls 198 %OWNINTEGER search base = 0; !entry for record_names 199 %OWNINTEGER format list = 0; !size of current format list 200 %INTEGER recid 201 %OWNBYTEINTEGERARRAY char(0:133) = ; !input line 202+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 203+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 204+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 205+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 206+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 207+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 208+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 209+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 210+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 211+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 212+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 213+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 214+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 215+ 10, 10, 10, 10 216 %INTEGERARRAY lit pool(0:lit max) 217 %OWNINTEGER lit = 0; !current literal (integer) 218 %OWNINTEGER lp = 0; !literals pointer 219 %OWNINTEGER block x = 0; !block tag 220 %OWNINTEGER list = 1; !<= to enable 221 %OWNINTEGER control = 0 222 %OWNINTEGER diag = 0; !diagnose flags 223 %INTEGERARRAY hash(0:max names) 224 %RECORD(tagfm)%ARRAY tag(0:max tag) 225 %INTEGERARRAY dict(1:max dict) 226 %BYTEINTEGERARRAY buff(1:512) 227 %OWNINTEGER bp = 0 228 229 !*** start of generated tables *** 230 ! %endoflist 231 %conststring(8)%array text(0:255) = %c 232+ "Z","VDEC","OWNVDEC","EXTVSPEC","ADEC","OWNADEC", 233+ "EXTASPEC","PROC","PROCSPEC","FORMDEC","SWDEC","LDEC", 234+ "FORMSPEC","","","","","", 235+ "OPTION","COMMA","T","COLON","COMMENT","LB", 236+ "ALIAS","RB","SUB","ARRAYD","STYPE","ARRAY", 237+ "NAME","PROCD","FNMAP","SWITCH","OWN","EXTERNAL", 238+ "STRING","RECORD","FORMAT","SPEC","MCODE","LABEL", 239+ "OP1","OP2","OP3","SIGN","UOP","MOD", 240+ "DOT","COMP","ACOMP","EQ","EQEQ","JAM", 241+ "JUMP","RESOP","AND","OR","NOT","WHILE", 242+ "UNTIL","FOR","CWORD","EXIT","ON","SIGNAL", 243+ "THEN","START","ELSE","FINISH","FELSE","CYCLE", 244+ "REPEAT","PROGRAM","BEGIN","END","ENDPROG","ENDPERM", 245+ "FRESULT","MRESULT","BACK","MONITOR","STOP","LIST", 246+ "REALSLN","CONTROL","INCLUDE","MASS","RTYPE","ADDOP", 247+ "IDENT","V","N","CONST","FM","", 248+ "R","F","M","P","RP","FP", 249+ "MP","PP","L","S","A","AN", 250+ "NA","NAN","","","","", 251+ "","","","","","", 252+ "%MSTART","%CLEAR","%PRED","","%DUBIOUS","%DUP", 253+ "%PIN","%POUT","%EDUP","","PIDENT","CIDENT", 254+ "OIDENT","FNAME","SWID","DOTL","DOTR","ASEP", 255+ "CSEP","OSEP","PSEP","ARB","BPLRB","ORB", 256+ "PRB","CRB","RCRB","RECRB","RECLB","LAB", 257+ "MLAB","SLAB","XNAME","OWNT","DBSEP","PCONST", 258+ "CMOD","CSIGN","CUOP","COP1","COP2","COP3", 259+ "INDEF","XELSE","CRESOP","NLAB","RUNTIL","ACONST", 260+ "ORRB","FMANY","OSTRING","FMLB","FMRB","FMOR", 261+ "RANGERB","FSID","","","","", 262+ "","%DUMMY","%DECL","%TYPE","%ZERO","%APPLY", 263+ "%PROT","%SETPROT","%PTYPE","%GAPP","%LOCAL","%GUARD", 264+ "%MCODE","%CDUMMY","%SETTYPE","%OPER","%PARAM","%BLOCK", 265+ "%OTHER","%COMPILE","APP","BASEAPP","APP2","APP3", 266+ "APP4","APP5","APP6","ADEFN","NPARM","SWDEF", 267+ "SWIDS","CIEXP","RCONST","SCONST","ARRAYP","XIMP", 268+ "IMP","COND","SCOND","EXP1","EXP2","SEXP", 269+ "IEXP","IEXP1","IEXP2","ISEXP","SEQ","FDEF", 270+ "EXP","NARRAYP","STRUCT","RESEXP","BPL","CONSTB", 271+ "FITEM","MOREA","CLIST","FPP","FPP0","FPP1", 272+ "FPP2","INITVAR","RECEXP","EIMP","IDENTS","RANGE", 273+ "RCONSTB","VARP","INITDEC","","","", 274+ "ESCDEC","ESCPROC","ESCARRAY","ESCREC" 275 %constinteger gmax1=719 276 %owninteger gmax=719 277 %constinteger imp phrase =25 278 279 %ownintegerarray phrase(200:255) = %C 280+ 0, 564, 565, 567, 569, 571, 573, 562, 281+ 614, 203, 200, 602, 478, 480, 624, 298, 282+ 206, 308, 318, 433, 426, 437, 444, 458, 283+ 453, 461, 467, 482, 402, 627, 629, 603, 284+ 521, 511, 486, 502, 575, 527, 528, 543, 285+ 550, 578, 397, 287, 197, 636, 516, 621, 286+ 167, 0, 0, 0, 640, 693, 701, 709 287 288 %constbyteintegerarray atomic(130:179) = %c 289+ 90, 90, 90, 90, 90, 48, 48, 19, 290+ 19, 19, 19, 25, 25, 25, 25, 25, 291+ 25, 25, 23, 104, 104, 105, 30, 20, 292+ 21, 93, 47, 45, 46, 42, 43, 44, 293+ 40, 68, 55, 104, 60, 93, 25, 40, 294+ 93, 23, 25, 57, 25, 90, 176, 177, 295+ 178, 179 296 297 ! FLAG<1> 0<1> SS<2> 0<3> T<1> LINK<8> 298 %constintegerarray initial(0:119) = %c 299+ 24, 0, 0, 0, 0, 0, 0, 0, 300+ 0, 0, 0, 0, 0, 0, 0, 0, 301+ 0, 0, 23, 0, 0, 0, 0, 0, 302+ 0, 0, 0, 0, 0, 0, 0, 0, 303+ 0, 0, 0, 0, 0, 0, 0, 0, 304+ 20, 0, 0, 0, 0, 0, 0, 0, 305+ 0, 0, 0, 0, 0, 0, -32551, 0, 306+ 0, 0, 0, 13, 0, 14, 4, -32557, 307+ 16, -32550, 0, 0, 5, 6, 3, 12, 308+ 15, 8, 7, 9, 10, 11, -32558, -32554, 309+ -32559, -32552, -32553, 18, 22, 17, 21, 19, 310+ 0, 0, 0, -32562, -32560, 0, 0, 0, 311+ -32561, 0, 0, 0, 0, 0, 0, 0, 312+ 1, 2, 0, -32556, 0, -32555, 0, 0, 313+ 0, 0, 0, 0, 0, 0, 0, 0 314 315 ! MORE<1> 0<1> ORDER<2> TYPE<4> CLASS<8> 316 %ownintegerarray gram(0:max grammar) = %c 317+ 0, -28523, -28521, -28602, -32706, -28509, -28603, -24502, 318+ -24503, -20405, -20404, -28595, -32697, -32709, -16323, -28600, 319+ -32704, -28587, -28589, -32681, -16344, -28586, -28588, -12270, 320+ -32586, 216, -12287, -16380, -8185, -8184, -12285, -12286, 321+ -12283, -12282, -12279, -12276, -16373, 20490, -32706, -32701, 322+ 216, -16364, -28610, -28613, -28612, 16445, 217, -16364, 323+ 62, -32701, 16450, -16364, 5346, -16364, 166, -16344, 324+ 4332, 130, -16360, -16361, 126, 217, -32701, 216, 325+ -16364, 16450, -32700, 16404, -32701, -32706, 216, 16405, 326+ 16407, -16222, 8414, 130, 217, -32697, 16450, 1250, 327+ 4307, 4318, 192, 93, 170, 90, 207, -16365, 328+ 16404, 90, -16360, -16365, 16404, 241, -16365, 16404, 329+ 132, 132, -16360, 4329, -16365, 16404, 133, 175, 330+ 90, -16365, 16404, 209, -16365, 16404, 4313, 217, 331+ 16451, 4263, 16384, 16384, 120, 216, -32700, 16404, 332+ -32706, 16404, 243, 16409, 454, -32685, 16404, 454, 333+ 248, -16365, 16404, 4263, 194, -16360, 4329, -32717, 334+ 16404, 4263, 16407, 454, 237, 127, 215, 454, 335+ 4263, 16384, -16364, 1502, -32629, -16361, 153, -32606, 336+ 222, 143, -32629, 153, 454, 126, 16409, 454, 337+ 16384, 234, -16365, -32595, 147, -32678, 234, 193, 338+ -32677, -32676, -32661, 109, -32717, 53, 52, 52, 339+ 52, 194, 194, 194, -28581, 4188, 194, -28566, 340+ 4203, 194, -28564, 4205, 4580, 16429, 183, 183, 341+ 186, 186, -28583, 0, 9437, 90, -16365, 0, 342+ 134, -16365, 0, 210, 4329, 199, -32677, -32672, 343+ -32676, -32688, -32690, -32705, -32661, -32659, -32689, -32686, 344+ -32687, -16330, 65, -32716, 186, -28583, -32717, -32715, 345+ -32713, 52, -32664, 4201, 186, -32717, -32715, 55, 346+ -16328, 0, 197, 197, 52, 52, 197, -28581, 347+ -28580, 186, -28581, 4188, 4318, 194, -28581, 4188, 348+ 9437, 194, 194, 454, 16407, 216, 194, -28566, 349+ -28565, 186, -28566, 4203, 194, -28564, -28563, 186, 350+ -28564, 4205, 183, 183, 186, 183, -16365, 0, 351+ 183, 4580, 16429, 5095, 9444, 5348, 186, -28583, 352+ -16328, 0, 16409, -16365, 0, 9437, 5348, 217, 353+ -32701, 16450, -32701, 216, -32700, 0, -32701, -32706, 354+ 216, 243, 217, -16318, 0, -32552, 0, -32700, 355+ 0, -32706, 0, 215, -32550, 228, -28616, -28615, 356+ 0, 4096, 218, 218, -28616, 0, -32677, -32676, 357+ -16361, -32710, -32669, -32662, -32661, -32660, -32659, 740, 358+ -32039, 740, -32719, 4096, 194, -32719, -32718, -32604, 359+ -32726, -32725, -32724, -32720, 4096, 710, 6116, -32719, 360+ 0, 710, 6116, -28581, 4188, 218, 122, 50, 361+ 16409, -32726, -32725, -32724, -32719, 4096, 710, 454, 362+ 195, 195, 195, 454, -28581, 4188, 194, -28566, 363+ -28565, -28564, 4205, 195, 195, 195, 710, 4836, 364+ 5095, 4829, -32726, -32725, -32724, -32719, 4096, 4827, 365+ 4828, 454, -32720, -32719, 4096, 4829, 4827, 4828, 366+ 194, -32719, 0, 710, 4836, -16291, -32677, 92, 367+ 184, 121, -28581, -28580, -32722, -32723, 4317, -32726, 368+ -32725, -32724, 0, 183, -32726, -32725, -32724, -32720, 369+ 0, 4316, 195, 195, 195, 454, -28581, 4188, 370+ 4315, 183, 4317, -32726, -32725, 0, 195, 195, 371+ 4315, 4317, -32726, 0, 195, -32677, -32676, -16361, 372+ 16431, 228, 228, 47, -32610, -32611, 5345, -32609, 373+ -32608, -32607, 0, 4320, 4319, 5345, -32609, -32608, 374+ 0, 4319, 5345, -32609, 0, -32613, -16361, 16431, 375+ 222, 222, 156, -32677, 92, 183, 186, 1222, 376+ 16435, 228, 16403, 4324, 138, 8420, -32723, 4189, 377+ 93, 454, 148, -32674, 16546, 16409, -32597, 182, 378+ -16383, 16388, 234, -16365, -32595, 172, -32678, 234, 379+ 90, 244, 246, -16365, 0, 235, -32678, 234, 380+ -16365, 246, -16365, 0, -32678, 234, 90, 16407, 381+ 222, 16405, 222, 145, 16407, 222, 16405, 222, 382+ 146, 16407, 1252, 154, 5348, -16365, 142, 126, 383+ 182, -16383, 16391, 90, -16365, 127, -32678, 238, 384+ 90, 125, 239, -16365, 8319, 8430, 128, 126, 385+ -16361, 127, 190, 240, 189, 16409, 182, -16383, 386+ 16391, 90, -16365, 0, -32678, 240, 90, 16623, 387+ -16365, 0, 244, 232, 1252, 1252, 137, 1252, 388+ 137, 1252, 137, 1252, 137, 1252, 137, 222, 389+ -16365, 0, 131, 194, -16360, -16333, -16332, 124, 390+ 181, -16292, -16277, 16493, -31802, 5342, -28581, 4188, 391+ 4263, 181, 186, 454, 16475, 183, -28583, 199, 392+ 5598, 9438, 222, -32677, -32676, 16407, 186, 228, 393+ 135, 16409, -32632, 0, -32677, 92, -32677, -32676, 394+ -32662, -32661, -32660, -32659, 165, -32677, 92, 188, 395+ -32662, 107, 188, -32660, 109, -32732, 37, -16344, 396+ 4318, 148, -32674, 16424, 222, 16405, 222, 174, 397+ -28644, -32734, -32680, -28641, -32733, -32730, -32735, -32727, 398+ -32738, 4326, -32738, -32739, -32741, -32736, 199, -28644, 399+ -32680, -28641, 4326, -32739, -32741, 199, -32738, -32739, 400+ -32741, -32736, -32729, 199, -32616, 199, -32739, -32741, 401+ -32729, 199, -32616, -32729, 199, -28644, -32680, 4326, 402+ -32738, -32739, -32741, 199, 245, 4318, 245, 16409, 403+ 152, 4318, 16409, 152, 245, -32672, -32671, -32670, 404+ 99, 16407, 200, 144, 185, -32677, 92, 16407, 405+ -32582, 200, 200, 187, 141, -32677, 92, 16410, 406+ 191, -32677, -32676, -32662, -32661, -32660, 109, 198, 407+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 408+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 409+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 410+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 411+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 412+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 413+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 414+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 415+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 416+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 417+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 418+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 419+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 420+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 421+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 422+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 423+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 424+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 425+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 426+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 427+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 428+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 429+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 430+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 431+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 432+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 433+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 434+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 435+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 436+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 437+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 438+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 439+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 440+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 441+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 442+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 443+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 444+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 445+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 446+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 447+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 448+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 449+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 450+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 451+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 452+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 453+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 454+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 455+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 456+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 457+ 0 458 459 %ownintegerarray glink(0:max grammar) = %c 460+ -1, 71, 72, 38, 46, 47, 67, 67, 461+ 75, 67, 0, 67, 51, 76, 79, 53, 462+ 55, 80, 67, 81, 82, 83, 67, 84, 463+ 26, 41, 85, 86, 57, 57, 89, 93, 464+ 96, 97, 102, 103, 104, 107, 46, 67, 465+ 67, 0, 110, 110, 111, 52, 49, 0, 466+ 61, 67, 62, 0, 67, 0, 111, 112, 467+ 112, 58, 113, 114, 115, 64, 67, 66, 468+ 116, 117, 68, 0, 67, 122, 67, 0, 469+ 73, 123, 123, 67, 77, 67, 40, 77, 470+ 67, 67, 0, 124, 127, 128, 87, 86, 471+ 0, 90, 131, 89, 0, 94, 93, 0, 472+ 132, 98, 137, 100, 97, 0, 138, 67, 473+ 105, 104, 0, 108, 107, 0, 67, 67, 474+ 67, 139, 140, 141, 0, 118, 120, 116, 475+ 142, 116, 67, 71, 125, 67, 0, 67, 476+ 129, 85, 0, 143, 133, 144, 135, 145, 477+ 0, 156, 157, 59, 158, 67, 119, 91, 478+ 159, 146, 145, 148, 146, 151, 0, 153, 479+ 153, 154, 146, 0, 99, 160, 67, 134, 480+ 161, 162, 165, 161, 141, 162, 162, 168, 481+ 172, 174, 175, 176, 177, 178, 179, 182, 482+ 185, 188, 189, 180, 190, 190, 183, 191, 483+ 191, 186, 191, 191, 0, 188, 192, 193, 484+ 194, 0, 196, 0, 0, 198, 197, 0, 485+ 201, 200, 0, 204, 205, 0, 228, 232, 486+ 219, 234, 235, 0, 236, 237, 238, 0, 487+ 232, 226, 244, 245, 221, 248, 249, 250, 488+ 251, 245, 0, 252, 229, 249, 250, 251, 489+ 253, 0, 0, 188, 254, 260, 239, 269, 490+ 269, 242, 191, 191, 270, 246, 272, 272, 491+ 229, 273, 274, 275, 276, 0, 255, 266, 492+ 266, 258, 267, 267, 261, 266, 266, 264, 493+ 267, 267, 232, 268, 232, 0, 277, 0, 494+ 278, 232, 273, 232, 282, 283, 279, 285, 495+ 253, 0, 0, 286, 0, 232, 0, 288, 496+ 0, 290, 0, 292, 294, 0, 0, 297, 497+ 0, 0, 299, 301, 0, 303, 0, 305, 498+ 0, 307, 0, 0, 310, 313, 314, 315, 499+ 0, 0, 316, 311, 314, 0, 332, 332, 500+ 328, 349, 350, 351, 351, 351, 351, 330, 501+ 282, 352, 358, 0, 333, 341, 347, 359, 502+ 360, 361, 362, 363, 0, 342, 343, 345, 503+ 0, 346, 0, 269, 269, 0, 0, 366, 504+ 353, 371, 372, 373, 374, 0, 375, 376, 505+ 377, 383, 384, 364, 385, 385, 367, 269, 506+ 269, 269, 269, 389, 390, 391, 392, 393, 507+ 0, 378, 360, 361, 362, 341, 0, 379, 508+ 380, 386, 363, 341, 0, 353, 354, 355, 509+ 375, 395, 0, 396, 0, 400, 269, 269, 510+ 401, 0, 411, 411, 406, 417, 407, 418, 511+ 419, 420, 0, 412, 418, 419, 420, 421, 512+ 0, 409, 406, 424, 417, 422, 425, 425, 513+ 408, 415, 427, 430, 431, 0, 426, 432, 514+ 428, 434, 436, 0, 433, 269, 269, 441, 515+ 442, 282, 443, 0, 446, 451, 447, 446, 516+ 452, 451, 0, 449, 448, 454, 453, 457, 517+ 0, 455, 459, 458, 0, 269, 464, 465, 518+ 282, 466, 0, 469, 469, 470, 471, 472, 519+ 473, 474, 475, 476, 477, 0, 479, 269, 520+ 481, 0, 483, 485, 485, 205, 490, 488, 521+ 496, 497, 491, 494, 490, 0, 491, 491, 522+ 0, 498, 499, 501, 0, 0, 504, 506, 523+ 510, 499, 508, 0, 506, 506, 504, 512, 524+ 513, 514, 515, 0, 517, 518, 519, 520, 525+ 0, 522, 523, 524, 525, 522, 0, 528, 526+ 529, 531, 536, 532, 534, 0, 532, 0, 527+ 537, 538, 539, 541, 542, 542, 0, 544, 528+ 546, 0, 547, 548, 549, 533, 551, 553, 529+ 558, 554, 556, 0, 554, 0, 559, 560, 530+ 557, 0, 563, 205, 0, 566, 564, 568, 531+ 565, 570, 567, 572, 569, 574, 571, 576, 532+ 575, 0, 579, 580, 592, 593, 584, 205, 533+ 585, 588, 588, 588, 590, 205, 594, 594, 534+ 595, 596, 597, 581, 600, 598, 601, 0, 535+ 205, 205, 205, 606, 606, 607, 608, 609, 536+ 605, 610, 612, 0, 193, 193, 193, 193, 537+ 193, 193, 193, 193, 0, 623, 623, 192, 538+ 626, 626, 0, 626, 626, 631, 633, 282, 539+ 282, 634, 282, 282, 637, 638, 639, 0, 540+ 650, 677, 684, 666, 655, 205, 205, 205, 541+ 205, 650, 659, 668, 685, 666, 0, 662, 542+ 686, 666, 662, 668, 685, 0, 670, 674, 543+ 689, 666, 205, 0, 205, 0, 674, 689, 544+ 205, 0, 666, 205, 0, 680, 692, 680, 545+ 659, 668, 685, 0, 650, 687, 662, 688, 546+ 205, 690, 691, 666, 680, 697, 697, 697, 547+ 697, 698, 699, 700, 0, 703, 703, 704, 548+ 706, 707, 708, 708, 700, 711, 711, 712, 549+ 713, 719, 719, 719, 719, 719, 719, 0, 550+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 551+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 552+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 553+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 554+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 555+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 556+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 557+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 558+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 559+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 560+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 561+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 562+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 563+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 564+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 565+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 566+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 567+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 568+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 569+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 570+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 571+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 572+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 573+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 574+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 575+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 576+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 577+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 578+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 579+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 580+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 581+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 582+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 583+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 584+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 585+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 586+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 587+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 588+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 589+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 590+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 591+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 592+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 593+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 594+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 595+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 596+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 597+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 598+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 599+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 600+ 0 601 602 %constintegerarray kdict(32:607) = %c 603+ 0, 511, 131, 531, 131, 551, 559, 131, 604+ 567, 575, 583, 603, 623, 631, 663, 671, 605+ 129, 129, 129, 129, 129, 129, 129, 129, 606+ 129, 129, 691, 698, 707, 751, 795, 131, 607+ 131, 824, 900, 960, 1076, 1120, 1280, 128, 608+ 128, 1392, 128, 128, 1460, 1556, 1592, 1660, 609+ 1748, 128, 1828, 2044, 2240, 2272, 128, 2312, 610+ 128, 128, 128, 2331, 2339, 2371, 2379, 2399, 611+ 131, 131, 131, 131, 131, 131, 131, 131, 612+ 131, 131, 131, 131, 131, 131, 131, 131, 613+ 131, 131, 131, 131, 131, 131, 131, 131, 614+ 131, 131, 131, 131, 2407, 131, 2379, -32351, 615+ 16428, 25, 16428, 29, -32349, 16433, 1, 16434, 616+ 1, -16127, 0, 16427, 21, 16407, 0, 16409, 617+ 0, -32323, -10840, 40, 16471, 0, -32341, -10580, 618+ 32, 16473, 117, 16384, 19, -31955, -32322, -10580, 619+ 36, -9290, 0, 16473, 113, 16432, 13, -32337, 620+ 16427, 46, 16427, 17, 16405, 0, 16404, 0, 621+ -31556, -31939, -32322, -9551, 2, 16433, 1, 16433, 622+ 5, 16426, 5, -31606, -32323, -9807, 0, -32374, 623+ -9678, 0, 16436, 0, 16435, 0, -31939, -32322, 624+ 16433, 4, 16426, 9, 16433, 3, -30772, -31666, 625+ 10578, 11457, -32344, 16413, 2, 16411, 2, 68, 626+ -32374, 16440, 0, 16440, 0, 8393, 83, 16408, 627+ 0, -31291, 10841, 69, -32311, 16412, 18, 10830, 628+ 9157, 10565, 16412, 18, 9415, 78, 16458, 0, 629+ -32049, 8665, 8908, 16455, 0, -30131, 78, -31277, 630+ 84, -32055, 10194, 76, 16469, 0, 10958, 69, 631+ 16447, 32, 84, -32319, 16418, 2, 10830, 16418, 632+ 2, 8909, 10830, 16406, 0, -31927, 10073, 9921, 633+ 8649, 16419, 5, 9153, 10190, 8915, 16469, 1, 634+ -27956, -31282, 88, -31927, 8916, 10066, 9793, 16419, 635+ 3, 84, 16447, 4, 68, -32305, 16459, 2, 636+ 70, -30650, -31284, 80, -31931, 10194, 10567, 9921, 637+ 16460, 1, 9938, 16461, 0, 10697, 84, 16467, 638+ 3, 9801, 69, 16460, 0, 8915, 16452, 0, 639+ -29631, -30903, -31282, -31793, 10069, 10819, 10185, 78, 640+ 16416, 9, 82, 16445, 0, 16416, 9, 9422, 641+ 9299, -32315, 16453, 0, 10700, 69, 16454, 0, 642+ 10700, 69, 16464, 1210, -30778, 78, -31549, 8916, 643+ 8903, 82, -32344, 16412, 17, 16472, 17, 10956, 644+ 8900, 16470, 0, 16446, 44, -30143, -30647, 10063, 645+ 71, -31671, -32302, 16412, 20, 8389, 76, 16412, 646+ 36, 10830, 9157, 10565, 16412, 20, 10835, 16467, 647+ 1, 8898, 76, 16425, 6, -31935, 10063, 10825, 648+ 10575, 16465, 109, 80, 16416, 10, -32191, 10831, 649+ 16442, 0, 8909, -32314, 16414, 1, -31794, 10069, 650+ 10819, 10185, 78, 16416, 10, 16416, 10, -30770, 651+ -31408, -32174, 10071, 16418, 1, -32374, 16441, 2, 652+ 16441, 2, 9428, 10063, 16402, 0, -32315, 16448, 653+ 0, 8918, 10830, 16448, 0, -30523, 82, -31419, 654+ -31927, 9167, 8402, 77, 16457, 0, 77, 16419, 655+ 6, 9412, 8387, 8916, 16415, 123, 9938, 16419, 656+ 7, -31931, 10959, 9428, 8910, 16415, 104, -28351, 657+ -30397, -31024, -32045, 10964, 10066, 16464, 1319, 9813, 658+ 7892, -32323, 16462, 1384, 16463, 1241, 8389, 84, 659+ 16456, 0, 10575, 68, -32314, 16421, 64, 10575, 660+ 8397, 84, -32301, 16422, 9, 8912, 67, 16422, 661+ 12, 76, -32301, 16412, 33, -31924, 10190, 9938, 662+ 9793, 16468, 1, 10063, 71, 16468, 4, -27704, 663+ -28983, -29488, -31276, -31913, 10713, 8916, 77, 16419, 664+ 4, 10825, 9283, 16417, 12, -31423, -31921, 9426, 665+ 9166, 40, 16420, 48, 80, 16466, 115, 10834, 666+ 16451, 0, 8645, 16423, 0, 10055, 9793, -32315, 667+ 16449, 0, 8918, 10830, 16449, 0, 10575, 84, 668+ -32311, 16412, 19, 10830, 9157, 10565, 16412, 19, 669+ -32056, 10962, 69, 16464, 1354, 10053, 16450, 0, 670+ 78, -32052, 9428, 76, 16444, 182, 10693, 83, 671+ 16446, 46, 9416, 8908, 16443, 180, 16407, 0, 672+ -31939, -32292, -10454, 51, 16426, 13, 16433, 1, 673+ 16409, 0, -32290, -10454, 51, 16426, 13, 16410, 674+ 0, 16431, 14, -32323, 16430, 51, 16433, 1 675 ! %list 676 !*** end of generated tables *** 677 678 %ROUTINE flush buffer 679 %INTEGER j 680 %IF faulty = 0 %START 681 select output(object) 682 %FOR j = 1, 1, bp %CYCLE 683 printsymbol(buff(j)) 684 %REPEAT 685 select output(listing) 686 %FINISH 687 bp = 0 688 %END 689 690 %ROUTINE print ident(%INTEGER p, mode) 691 692 %ROUTINE putit(%INTEGER ch) 693 %IF mode = 0 %THEN %START 694 printsymbol(ch) 695 %ELSE 696 bp = bp+1 697 buff(bp) = ch 698 %FINISH 699 %END 700 701 %INTEGER k, l 702 p = tag(p)_text 703 %IF p = 0 %START 704 putit('?') 705 %RETURN 706 %FINISH 707 p = p+1; ! advance to name string 708 k = dict(p) 709 l = k & 255; ! length 710 %WHILE l > 0 %CYCLE 711 putit(k>>8) 712 l = l-1 713 p = p+1 714 k = dict(p) 715 %EXIT %IF l = 0 716 putit(k&255) 717 l = l-1 718 %REPEAT 719 %END 720 %ROUTINE abandon(%INTEGER n) 721 %SWITCH reason(0:9) 722 %INTEGER stream 723 stream = listing 724 %CYCLE 725 newline %IF sym # nl 726 printsymbol('*'); write(lines,4); space 727 ->reason(n) 728 reason(0):printstring("compiler error!"); ->more 729 reason(1):printstring("switch vector too large"); ->more 730 reason(2):printstring("too many names"); ->more 731 reason(3):printstring("program too complex"); ->more 732 reason(4):printstring("feature not implemented"); ->more 733 reason(5):printstring("input ended: ") 734 %IF quote # 0 %START 735 %IF quote < 0 %THEN printsymbol(cquote) %C 736+ %ELSE printsymbol(squote) 737 %ELSE 738 printstring("%endof") 739 %IF progmode >= 0 %THEN printstring("program") %C 740+ %ELSE printstring("file") 741 %FINISH 742 printstring(" missing?"); ->more 743 reason(6):printstring("too many faults!"); ->more 744 reason(7):printstring("string constant too long"); ->more 745 reason(8):printstring("dictionary full"); -> more 746 reason(9):printstring("Included file ".include file." does not exist") 747 more: newline 748 printstring("*** compilation abandoned ***"); newline 749 %EXIT %IF stream = report 750 close output 751 stream = report 752 select output(report) 753 %REPEAT 754 !%SIGNAL 15,15 %IF diag&4096 # 0 755 %STOP 756 %END 757 %ROUTINE op(%INTEGER code, param) 758 buff(bp+1) = code 759 buff(bp+2) = param>>8 760 buff(bp+3) = param 761 bp = bp+3 762 %END 763 %ROUTINE set const(%INTEGER m) 764 buff(bp+1) = 'N' 765 buff(bp+5) = m; m = m>>8 766 buff(bp+4) = m; m = m>>8 767 buff(bp+3) = m; m = m>>8 768 buff(bp+2) = m 769 bp = bp+5 770 %END 771 772 773 774 %ROUTINE compile block(%INTEGER level, block tag, dmin, tmax, id) 775 776 %INTEGERFNSPEC gapp 777 %ROUTINESPEC delete names(%INTEGER quiet) 778 %ROUTINESPEC analyse 779 %ROUTINESPEC compile 780 781 %INTEGER open; open = closed; !zero if can return from proc 782 %INTEGER dbase; dbase = dmax; !dictionary base 783 %INTEGER tbase; tbase = tmax; !tag base 784 %INTEGER tstart; tstart = tmax 785 %INTEGER label; label = 4; !first internal label 786 %INTEGER access; access = 1; !non-zero if accessible 787 %INTEGER inhibit; inhibit = 0; !non-zero inhibits declaratons 788 789 %INTEGERNAME bflags; bflags == tag(block tag)_flags 790 %INTEGER block type; block type = bflags>>4&7 791 %INTEGER block form; block form = bflags&15 792 %INTEGER block fm; block fm = tag(block tag)_format 793 %INTEGER block otype; block otype = otype 794 %INTEGERNAME block app; block app == tag(block tag)_app 795 796 %INTEGER l, new app 797 798 %ROUTINE fault(%INTEGER n) 799 800 ! -5 : -1 - warnings 801 ! 1 : 22 - errors 802 803 %SWITCH fm(-5:22) 804 %INTEGER st 805 806 %ROUTINE print ss 807 %INTEGER s, p 808 %RETURN %IF pos = 0 809 space 810 p = 1 811 %CYCLE 812 printsymbol(marker) %IF p = pos1 813 %EXIT %IF p = pos 814 s = char(p); p = p+1 815 %EXIT %IF s = nl %OR (s='%' %AND p = pos) 816 %IF s < ' ' %START; !beware of tabs 817 %IF s = ff %THEN s = nl %ELSE s = ' ' 818 %FINISH 819 printsymbol(s) 820 %REPEAT 821 pos = 0 %IF list <= 0 822 %END 823 824 pos1 = pos2 %IF pos2 > pos1 825 newline %IF sym # nl 826 st = report 827 st = listing %IF n = -3; !don't report unused on the console 828 %cycle 829 SELECT OUTPUT(st) 830 %if n < 0 %then printsymbol('?') %and pos1 = 0 %else printsymbol('*') 831 %if st # report %start 832 %if list <= 0 %and pos1 # 0 %start 833 spaces(pos1+margin); PRINTSTRING(" ! ") 834 %finish 835 %finish %else %start 836 PRINTSTRING(include file) %if include # 0 837 write(lines, 4); printsymbol(csym); space 838 %finish 839 ->fm(n) %if -5 <= n %AND n <= 22 840 PRINTSTRING("fault"); write(n, 2); ->ps 841 842 fm(-5):PRINTSTRING("Dubious statement"); dubious = 0; ->psd 843 fm(-4):PRINTSTRING("Non-local") 844 pos1 = for warn; for warn = 0; ->ps 845 fm(-3):print ident(x, 0); PRINTSTRING(" unused"); ->nps 846 fm(-2):PRINTSTRING("""}"""); ->miss 847 fm(-1):PRINTSTRING("access"); ->psd 848 849 fm(0): PRINTSTRING("form"); ->ps 850 fm(1): PRINTSTRING("atom"); ->ps 851 fm(2): PRINTSTRING("not declared"); ->ps 852 fm(3): PRINTSTRING("too complex"); ->ps 853 fm(4): PRINTSTRING("duplicate "); Print Ident(x, 0); ->ps 854 fm(5): PRINTSTRING("type"); ->ps 855 fm(6): PRINTSTRING("match"); ->psd 856 fm(7): PRINTSTRING("context"); ->psd 857 fm(21):PRINTSTRING("context "); print ident(this, 0); ->ps 858 fm(8): PRINTSTRING("%cycle"); ->miss 859 fm(9): PRINTSTRING("%start"); ->miss 860 fm(10):PRINTSTRING("size"); WRITE(lit, 1) %if pos1 = 0;->ps 861 fm(11):PRINTSTRING("bounds") 862 WRITE(ocount, 1) %unless ocount < 0; ->ps 863 fm(12):PRINTSTRING("index"); ->ps 864 fm(13):PRINTSTRING("order"); ->psd 865 fm(14):PRINTSTRING("not a location"); ->ps 866 fm(15):PRINTSTRING("%begin"); ->miss 867 fm(16):PRINTSTRING("%end"); ->miss 868 fm(17):PRINTSTRING("%repeat"); ->miss 869 fm(18):PRINTSTRING("%finish"); ->miss 870 fm(19):PRINTSTRING("result"); ->miss 871 fm(22):PRINTSTRING("format"); ->ps 872 fm(20):printsymbol('"'); print ident(x, 0); printsymbol('"') 873 miss: PRINTSTRING(" missing"); ->nps 874 psd: pos1 = 0 875 ps: print ss 876 nps: NEWLINE 877 %exit %if st = listing 878 st = listing 879 %repeat 880 %if n >= 0 %start 881 !%signal 15,15 %if diag&4096 # 0 882 %if n # 13 %start; !order is fairly safe 883 ocount = -1 884 gg = 0 885 copy = 0; quote = 0 886 search base = 0; escape class = 0 887 gg = 0 888 %finish 889 faulty = faulty+1 890 891 !check that there haven't been too many faults 892 893 fault rate = fault rate+3; abandon(6) %IF fault rate > 30 894 fault rate = 3 %IF fault rate <= 0 895 %FINISH 896 tbase = tstart 897 %IF list <= 0 %AND sym # nl %START 898 error margin = column 899 error sym = sym; sym = nl 900 %FINISH 901 %END 902 903 dmin = dmin-1; dict(dmin) = -1; !end marker for starts & cycles 904 abandon(2) %IF dmax = dmin 905 906 %IF list > 0 %AND level > 0 %START 907 write(lines, 5); spaces(level*3-1) 908 %IF block tag = 0 %START 909 printstring("Begin") 910 %FINISH %ELSE %START 911 printstring("Procedure "); print ident(block tag, 0) 912 %FINISH 913 newline 914 %FINISH 915 916 !deal with procedure definition (parameters) 917 918 %IF block tag # 0 %START; !proc 919 analyse; compile %IF ss # 0 920 921 %IF block otype # 0 %START; !external-ish 922 %IF bflags&spec = 0 %START; !definition 923 %IF progmode <= 0 %AND level = 1 %THEN progmode = -1 %C 924+ %ELSE fault(7) 925 %FINISH 926 %FINISH 927 928 new app = gapp; !generate app grammar 929 %IF spec given # 0 %START; !definition after spec 930 fault(6) %IF new app # block app; !different from spec 931 %FINISH 932 block app = new app; !use the latest 933 934 %IF level < 0 %START; !not procedure definition 935 delete names(0) 936 %RETURN 937 %FINISH 938 %FINISH %ELSE %START 939 open = 0; !can return from a block? 940 %FINISH 941 942 %CYCLE 943 analyse 944 %IF ss # 0 %START 945 compile 946 fault(-5) %IF dubious # 0 947 flush buffer %IF bp >= 128 948 %IF sstype > 0 %START; !block in or out 949 %EXIT %IF sstype = 2; !out 950 compile block(spec mode, block x, dmin, tmax, id) 951 %EXIT %IF ss < 0; !endofprogram 952 %FINISH 953 %FINISH 954 %REPEAT 955 %IF list > 0 %AND level > 0 %START 956 write(lines, 5); spaces(level*3-1) 957 printstring("End") 958 newline 959 %FINISH 960 delete names(0) 961 %RETURN 962 963 %INTEGERFN gapp; !generate app grammar (backwards) 964 %CONSTINTEGER comma = 140; !psep 965 %ROUTINESPEC set cell(%INTEGER g, tt) 966 %ROUTINESPEC class(%RECORD(tagfm)%NAME v) 967 %RECORD(tagfm)%NAME v 968 %INTEGER p, link, tp, c, ap, t 969 970 %RESULT = 0 %IF tmax = local; !no app needed 971 972 p = gmax1; link = 0; t = tmax 973 974 %CYCLE 975 v == tag(t); t = t-1 976 class(v); !deduce class from tag 977 %IF c < 0 %START; !insert %PARAM 978 c = -c 979 set cell(196, tp) 980 tp = -1 981 %FINISH 982 set cell(c, tp) 983 %EXIT %IF t = local; !end of parameters 984 set cell(comma, -1); !add the separating comma 985 %REPEAT 986 abandon(3) %IF gmax > gmin 987 988 %RESULT = link 989 990 %ROUTINE set cell(%INTEGER g, tt) 991 992 !add the cell to the grammar, combining common tails 993 994 %WHILE p # gmax %CYCLE 995 p = p+1 996 %IF glink(p) = link %AND gram(p) = g %START 997 %IF tt < 0 %OR (gram(p+1) = tt %AND glink(p+1)=ap) %START 998 link = p; !already there 999 %RETURN 1000 %FINISH 1001 %FINISH 1002 %REPEAT 1003 1004 !add a new cell 1005 1006 gmax = gmax+1 1007 gram(gmax) = g 1008 glink(gmax) = link 1009 link = gmax 1010 1011 %IF tt >= 0 %START; ! set type cell 1012 gmax = gmax+1 1013 gram(gmax) = tt 1014 glink(gmax) = ap 1015 %FINISH 1016 1017 p = gmax 1018 %END 1019 1020 %ROUTINE class(%RECORD(tagfm)%NAME v) 1021 %CONSTINTEGER err = 89 1022 %CONSTINTEGER rtp = 100 1023 %CONSTINTEGER fnp = 101 1024 %CONSTINTEGER mapp = 102 1025 %CONSTINTEGER predp = 103 1026 %CONSTINTEGERARRAY class map(0:15) = %C 1027+ 89, 1764, 247, 89,89,89,89, -100, -101, -102, -103, 89, 214, 1028+ ! err,1764, 247, err(4), -rtp, -fnp, -mapp, -predp, err, 214, 1029+ 89, 229, 89 1030 ! err, 229, err 1031 %INTEGER tags, type, form 1032 ap = 0 1033 tags = v_flags 1034 type = tags>>4&7; form = tags&15 1035 tp = v_format<<3!type 1036 c = class map(form) 1037 c = 208 %AND tp = 0 %IF type = 0 %AND form = 2; !%NAME 1038 ap = v_app %IF tags¶meters # 0 1039 %END ?PREDP unused ?MAPP unused ?FNP unused ?RTP unused ?ERR unused 1040 %END 1041 1042 %ROUTINE delete names(%INTEGER quiet) 1043 %INTEGER flags 1044 %RECORD(tagfm)%NAME tx 1045 %WHILE tmax > tbase %CYCLE 1046 x = tmax; tmax = tmax-1 1047 tx == tag(x) 1048 flags = tx_flags 1049 fault(20) %IF flags&spec # 0 %and flags&own bit = 0 1050 !{spec with no definition & not external} 1051 %IF flags&used bit = 0 %AND level >= 0 %AND list <= 0 %START 1052 fault(-3) %IF quiet = 0; !unused 1053 %FINISH 1054 dict(tx_text) = tx_link 1055 %REPEAT 1056 %END 1057 1058 %ROUTINE analyse 1059 1060 %CONSTINTEGER order bits = 16_3000, order bit = 16_1000 1061 %CONSTINTEGER escape = 16_1000 1062 %INTEGER strp, mark, flags, prot err, k, s, c 1063 %OWNINTEGER key = 0 1064 %INTEGER node 1065 %INTEGERNAME z 1066 %RECORD(arfm)%NAME arp 1067 %SWITCH act(actions:phrasal), paction(0:15) 1068 1069 %ROUTINE trace analysis 1070 !diagnostic trace routine (diagnose&1 # 0) 1071 %INTEGER a 1072 %ROUTINE show(%INTEGER a) 1073 %IF 0 < a %AND a < 130 %START 1074 space 1075 printstring(text(a)) 1076 %FINISH %ELSE write(a, 3) 1077 %END 1078 %OWNINTEGER la1=0, la2=0, lsa=0, lt=0 1079 newline %IF mon pos # pos %AND sym # nl 1080 mon pos = pos 1081 write(g, 3) 1082 space 1083 printstring(text(class)) 1084 printsymbol('"') %IF gg&trans bit # 0 1085 a = gg>>8&15 1086 %IF a # 0 %START 1087 printsymbol('{') 1088 write(a, 0) 1089 printsymbol('}') 1090 %FINISH 1091 %IF atom1 # la1 %OR atom2 # la2 %OR lsa # subatom %C 1092+ %OR lt # type %START 1093 printstring(" [") 1094 la1 = atom1 1095 show(la1) 1096 la2 = atom2 1097 show(la2) 1098 lsa = subatom 1099 write(lsa, 3) 1100 lt = type 1101 write(lt, 5) 1102 printsymbol(']') 1103 %FINISH 1104 newline 1105 %END 1106 1107 %ROUTINE get sym 1108 readsymbol(sym) 1109 abandon(5) %if sym < 0 1110 pos = pos+1 %IF pos # 133 1111 char(pos) = sym 1112 printsymbol(sym) %IF list <= 0 1113 column = column+1 1114 %END 1115 %ROUTINE read sym 1116 %owninteger Last = 0 1117 %CONSTBYTEINTEGERARRAY mapped(0:127) = %C 1118+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 3 , 0, 0, 0, 1119+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1120+ 0 ,'!','"','#', '$', 1 ,'&', 39, '(',')','*','+', ',','-','.','/', 1121+ '0','1','2','3', '4','5','6','7', '8','9',':',';', '<','=','>','?', 1122+ '@','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O', 1123+ 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z','[', '\',']','^','_', 1124+ '`','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O', 1125+ 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z', 2 , '|','}','~', 0 1126 1127 !! 0 = space 1128 !! 1 = % 1129 !! 2 = { 1130 !! 3 = ff 1131 !! other values represent themselves 1132 1133 %IF sym = nl %START 1134 s1: lines = lines+1 1135 printsymbol(end mark) %if end mark # 0 1136 s11: pos = 0; pos1 = 0; pos2 = 0; margin = 0; column = 0 1137 Last = 0 1138 end mark = 0 1139 %IF list <= 0 %START 1140 %IF include # 0 %START 1141 printstring(" &"); write(lines, -4) 1142 %FINISH %ELSE write(lines, 5) 1143 csym = cont; printsymbol(csym) 1144 space 1145 %IF error margin # 0 %START 1146 lines = lines-1 1147 spaces(error margin) 1148 error margin = 0 1149 %IF error sym # 0 %START 1150 printsymbol(error sym) 1151 pos = 1; char(1) = error sym 1152 sym = error sym; error sym = 0 1153 ->s5 1154 %FINISH 1155 %FINISH 1156 %FINISH 1157 s2: symtype = 1 1158 %FINISH 1159 s3:readsymbol(sym) 1160 abandon(5) %if sym < 0 1161 pos = pos+1 %IF pos # 133 1162 char(pos) = sym 1163 printsymbol(sym) %IF list <= 0 1164 column = column+1 1165 s5:%IF sym # nl %START 1166 Last = Sym 1167 %RETURN %IF quote # 0; !dont alter strings 1168 sym = mapped(sym&127) 1169 %IF sym <= 3 %START; !special symbol 1170 ->s2 %IF sym = 0; !space (or dubious control) 1171 symtype = 2 %AND ->s3 %IF sym = 1; !% 1172 cont = '+' %AND ->s11 %IF sym = 3; !ff 1173 !must be { 1174 %CYCLE 1175 get sym 1176 ->s3 %IF sym = '}' 1177 ->s4 %IF sym = nl 1178 %REPEAT 1179 %FINISH 1180 key = kdict(sym) 1181 %IF key&3 = 0 %AND symtype = 2 %START; !keyword 1182 %IF sym = 'C' %AND nextsymbol = nl %START; !%C... 1183 getsym; cont = '+'; ->s1 1184 %FINISH 1185 %ELSE 1186 symtype = key&3-2 1187 %FINISH 1188 %RETURN 1189 %FINISH 1190 s4:symtype = quote 1191 ->S1 %if last = 0 %and Quote = 0 1192 Cont = '+' 1193 %END 1194 1195 %INTEGERFN format selected 1196 format list = tag(format)_app; !number of names 1197 %IF format list < 0 %START; !forward ref 1198 atom1 = error+22 1199 %RESULT = 0 1200 %FINISH 1201 %IF sym = '_' %START 1202 escape class = esc rec 1203 search base = tag(format)_format 1204 %FINISH 1205 %RESULT = 1 1206 %END 1207 1208 %ROUTINE code atom(%INTEGER target) 1209 %INTEGER dbase, da 1210 %INTEGER base, n, mul, pend quote 1211 %INTEGER j,k,l, pt 1212 1213 %ROUTINE lookup(%INTEGER d) 1214 %INTEGER new name, vid, k1, k2, form 1215 %RECORD(tagfm)%NAME t 1216 %INTEGER new 1217 1218 ! twee little function because SKIMP86 can't do string compare properly 1219 ! returns 1 if the two names are the same, else zero 1220 %INTEGERFN dict match(%INTEGER ptr1, ptr2) 1221 %INTEGER len; 1222 ! start with a cheap check of the length and first character 1223 %IF dict(ptr1) # dict(ptr2) %THEN %RESULT = 0 1224 len = dict(ptr1) & 255 1225 ptr1 = ptr1 + 1 1226 ptr2 = ptr2 + 1 1227 len = len - 1 1228 %WHILE len >= 2 %CYCLE 1229 %if dict(ptr1) # dict(ptr2) %then %result = 0 1230 ptr1 = ptr1 + 1 1231 ptr2 = ptr2 + 1 1232 len = len - 2 1233 %REPEAT 1234 ! if the string was odd length, we might need one last byte checked 1235 %IF len = 1 %START 1236 %IF dict(ptr1)&255 # dict(ptr2)&255 %THEN %RESULT = 0 1237 %FINISH 1238 %RESULT = 1 1239 %END 1240 !first locate the text of the name 1241 1242 new = dmax+1; ! points to text of string in dictionary 1243 k1 = hash value & max names; ! rather crude hash! 1244 1245 %CYCLE 1246 newname = hash(k1) 1247 %EXIT %IF newname = 0; !not in 1248 ->in %IF dict match(newname+1, new) = 1 1249 k1 = (k1+1)&max names 1250 %REPEAT 1251 1252 ! not found 1253 1254 spare names = spare names-1 1255 abandon(2) %IF spare names <= 0 1256 hash(k1) = dmax; !put it in 1257 dict(dmax) = -1 1258 newname = dmax; dmax = dp; ->not in 1259 1260 in: search base = rbase %IF this >= 0 %AND d # 0; !record elem defn 1261 %IF search base # 0 %START; !record subname 1262 new = -1 1263 x = search base 1264 %CYCLE 1265 ->not in %IF x < format list 1266 %EXIT %IF tag(x)_text = new name 1267 x = x-1 1268 %REPEAT 1269 %FINISH %ELSE %START; !hash in for normal names 1270 x = dict(newname) 1271 ->not in %IF x <= limit; !wrong level 1272 %FINISH 1273 1274 subatom = x; !name found, extract info 1275 t == tag(x) 1276 atom flags = t_flags 1277 format = t_format; app = t_app 1278 protection = atom flags&prot 1279 type = atom flags>>4&7; atom1 = amap(atom flags&15) 1280 1281 %IF diag&8 # 0 %START 1282 printstring("lookup:") 1283 write(atom1, 3) 1284 write(type, 1) 1285 write(app, 3) 1286 write(format, 5) 1287 write(atom flags, 3) 1288 newline 1289 %FINISH 1290 1291 %IF d = 0 %START; !old name wanted 1292 t_flags = t_flags!used bit 1293 search base = 0 1294 1295 %IF atom flags&subname # 0 %AND format # 0 %START; !a record 1296 %RETURN %IF format selected = 0 1297 %FINISH 1298 1299 %IF atom flags¶meters # 0 %START; !proc or array 1300 1301 %IF app = 0 %START; !no parameters needed 1302 atom2 = atom1 1303 atom1 = atom1-4 1304 %IF 97 <= atom1 %AND atom1 <= 98 %START 1305 map gg = atom1; atom1 = var 1306 %FINISH 1307 %FINISH %ELSE %START 1308 %IF sym = '(' %START 1309 search base = 0; !ignore format for now 1310 %IF atom1 >= 106 %START; !arrays 1311 app = phrase(app+200) 1312 escape class = esc array 1313 atom1 = (atom1-106)>>1+91; !a,an->v na,nan->n 1314 %FINISH %ELSE %START; !procedures 1315 escape class = esc proc 1316 atom1 = atom1-4 1317 %FINISH 1318 phrase(200) = app 1319 %FINISH 1320 %FINISH 1321 pos2 = pos; %return 1322 %FINISH 1323 1324 !deal with constintegers etc 1325 1326 %IF atom flags&const bit # 0 %AND atom1 = var %START 1327 map gg = const; atom2 = const 1328 subatom = -subatom %IF type = integer 1329 %FINISH 1330 %RETURN 1331 1332 %FINISH 1333 !new name wanted 1334 ->not in %IF tbase # tstart; !don't fault proc parm-parm 1335 %IF d = lab+spec+used bit %START 1336 t_flags = t_flags!used bit 1337 %RETURN 1338 %FINISH 1339 %IF atom flags&spec # 0 %START; !a spec has been given 1340 %IF d = lab %START; !define label 1341 t_flags = t_Flags-Spec 1342 %RETURN 1343 %FINISH 1344 %IF 7 <= decl&15 %AND decl&15 <= 10 %AND decl&spec = 0 %START 1345 1346 !procedure definition after spec 1347 1348 %IF (decl!!atom flags)&2_1111111 = 0 %START; !correct type? 1349 t_flags = t_flags-spec 1350 spec given = 1 1351 %RETURN 1352 %FINISH 1353 1354 !note that an external procedure must be speced as a 1355 !non-external procedure. 1356 1357 %FINISH 1358 %IF decl&15 = recfm %START; !recordformat 1359 t_flags = record<<4+recfm 1360 t_format = fdef 1361 %RETURN 1362 %FINISH 1363 %FINISH 1364 %RETURN %IF last1 = jump %AND atom1 = swit 1365 copy = x %IF copy = 0 1366 1367 notin:app = 0; vid = 0 1368 atom1 = error+2 1369 1370 %return %if d = 0; !old name wanted 1371 type = d>>4&7; form = d&15; atom1 = amap(form) 1372 1373 %IF this < 0 %START; !normal scope 1374 new = newname 1375 tmax = tmax+1; x = tmax 1376 %FINISH %ELSE %START; !recordformat scope 1377 new = -1 1378 recid = recid-1; vid = recid 1379 tmin = tmin-1; x = tmin 1380 format list = tmin 1381 %FINISH 1382 1383 %IF 11 <= form %and form <= 14 %START; !arrays 1384 dim = 1 %IF dim = 0; !set dim for owns 1385 app = dim 1386 %FINISH 1387 1388 d = d!used bit %IF (otype > 2 %AND d&spec = 0) %OR perm # 0 %OR %C 1389+ Level = Include Level 1390 1391 !external definitions need not be used in the file in which 1392 !they are defined, so inhibit a useless unused warning. 1393 1394 t == tag(x) 1395 %IF form = lab %START 1396 id = id+1; vid = id 1397 %FINISH 1398 t_index = vid 1399 t_text = new name 1400 t_flags = d 1401 t_app = app 1402 t_format = fdef; format = fdef 1403 subatom = x 1404 1405 %IF new >= 0 %START; !insert into hash table 1406 t_link = dict(new); dict(new) = x 1407 %IF gmin = max grammar %START; !proc param params 1408 tmin = tmin-1; subatom = tmin 1409 tag(tmin) = t 1410 %FINISH 1411 %FINISH 1412 abandon(3) %IF tmax >= tmin 1413 %END ?K2 unused 1414 1415 1416 1417 top: pos1 = pos 1418 subatom = 0; pend quote = 0; atom flags = 0 1419 1420 !app and format must be left for assigning to papp & pformat 1421 1422 ->name %IF symtype = -2; !letter 1423 ->number %IF symtype < 0; !digit 1424 %IF symtype = 0 %START 1425 atom1 = termin; atom2 = 0 1426 %RETURN 1427 %FINISH 1428 %IF symtype # 2 %START; !catch keywords here 1429 ->text %IF quote # 0; !completion of text 1430 ->strings %IF sym = squote; !start of string 1431 ->symbols %IF sym = cquote; !start of symbol 1432 ->number %IF sym = '.' %AND '0' <= nextsymbol %AND nextsymbol <= '9' 1433 %FINISH 1434 1435 !locate atom in fixed dict 1436 k = key>>2; read sym 1437 %CYCLE 1438 j = kdict(k) 1439 %EXIT %IF j&16_4000 # 0 1440 %IF j&127 # sym %OR symtype < 0 %START 1441 ->err %UNLESS j < 0 1442 k = k+1 1443 %FINISH %ELSE %START 1444 l = j>>7&127; read sym 1445 %IF j > 0 %START 1446 %IF l # 0 %START 1447 ->err %IF l # sym %OR symtype < 0 1448 read sym 1449 %FINISH 1450 l = 1 1451 %FINISH 1452 k = k+l 1453 %FINISH 1454 %REPEAT 1455 atom1 = j&127 1456 %IF atom1 = 0 %START; !comma 1457 atom1 = 19; subatom = 19; atom2 = 0 1458 %IF sym = nl %START 1459 %RETURN %IF ocount >= 0 1460 1461 !special action needs to be taken with as 1462 !const array lists can be enormous 1463 1464 read sym 1465 %FINISH 1466 %RETURN 1467 %FINISH 1468 atom2 = j>>7&127 1469 subatom = kdict(k+1)&16_3fff 1470 !!!!!cont = ' ' 1471 %RETURN 1472 1473 !report an error. adjust the error marker (pos1) to point 1474 !to the faulty character in an atom, but care needs to be taken 1475 !to prevent misleading reports in cases like ...????? 1476 1477 err: atom1 = error+1; atom2 = 0 1478 pos1 = pos %IF pos-pos1 > 2 1479 %RETURN 1480 1481 !take care with strings and symbol constants. 1482 !make sure the constant is valid here before sucking it in 1483 !(and potentially loosing many lines) 1484 1485 symbols:atom1 = var; atom2 = const; type = integer 1486 map gg = const; protection = prot 1487 subatom = lp; abandon(3) %IF lp >= lit max 1488 quote = \pend quote 1489 %RETURN 1490 1491 !an integer constant is acceptable so get it in and 1492 !get the next atom 1493 1494 chars:n = 0; cont = cquote 1495 %CYCLE 1496 read sym 1497 %IF sym = cquote %START 1498 %EXIT %IF nextsymbol # cquote 1499 read sym 1500 %FINISH 1501 %IF n&(\((-1)>>byte size)) # 0 %START; ! overflow 1502 pos1 = pos; atom1 = error+10; %RETURN 1503 %FINISH 1504 ->err %IF quote = 0 1505 n = n<top 1512 1513 !sniff the grammar before getting the string 1514 1515 strings:atom1 = var; atom2 = const; type = stringv 1516 subatom = strp!16_4000 1517 map gg = const; protection = prot 1518 quote = subatom 1519 text line = lines; !in case of errors 1520 %RETURN 1521 1522 !a string constant is ok here, so pull it in and get 1523 !the next atom 1524 1525 ! ABD - temp variable to help pack bytes into words 1526 %INTEGER flipflop 1527 1528 text: ->chars %IF quote < 0; !character consts 1529 l = strp; !point to beginning 1530 k = 0; !length so far 1531 flipflop = 0; !space for the length is up the spout 1532 1533 %CYCLE 1534 cont = squote; quote = 1 1535 %CYCLE 1536 read sym 1537 %IF sym = squote %START; !terminator? 1538 %EXIT %IF nextsymbol # squote; !yes -> 1539 read sym; ! skip quote 1540 %FINISH 1541 %IF flipflop >= 0 %START 1542 glink(strp) = sym<<8 + flipflop 1543 strp = strp+1 1544 flipflop = -1 1545 %ELSE 1546 flipflop = sym 1547 %FINISH 1548 k = k+1 1549 lines = text line %AND abandon(7) %IF k > 255; !too many chars 1550 %REPEAT 1551 %IF flipflop >=0 %START; !tail-end charlie 1552 glink(strp) = flipflop 1553 strp = strp+1 1554 %FINISH 1555 glink(l) = glink(l)!k; !plug in length 1556 1557 quote = 0; cont = ' '; read sym 1558 code atom(target) 1559 %RETURN %UNLESS atom1 = 48 %AND sym = squote; !fold "???"."+++" 1560 %REPEAT 1561 1562 %ROUTINE get(%INTEGER limit) 1563 %INTEGER s, shift 1564 shift = 0 1565 %IF base # 10 %START 1566 %IF base = 16 %START 1567 shift = 4 1568 %FINISH %ELSE %START 1569 %IF base = 8 %START 1570 shift = 3 1571 %FINISH %ELSE %START 1572 %IF base = 2 %START 1573 shift = 1 1574 %FINISH 1575 %FINISH 1576 %FINISH 1577 %FINISH 1578 n = 0 1579 %CYCLE 1580 %IF symtype = -1 %START; !digit 1581 s = sym-'0' 1582 %FINISH %ELSE %START 1583 %IF symtype < 0 %START; !letter 1584 s = sym-'A'+10 1585 %FINISH %ELSE %START 1586 %RETURN 1587 %FINISH 1588 %FINISH 1589 %RETURN %IF s >= limit 1590 pt = pt+1; glink(pt) = sym 1591 %IF base = 10 %START; !check overflow 1592 %IF n >= max int %AND (s > max dig %OR n > max int) %START 1593 1594 !too big for an integer, 1595 !so call it a real 1596 base = 0; type = real; n = 0 1597 %FINISH 1598 %FINISH 1599 %IF shift = 0 %START 1600 n = n*base+s 1601 %FINISH %ELSE %START 1602 n = n<= lit max 1612 pt = strp; mul = 0 1613 %CYCLE 1614 get(base) 1615 %EXIT %UNLESS sym = '_' %AND base # 0 %AND pend quote = 0; !change of base 1616 pt = pt+1; glink(pt) = '_' 1617 read sym 1618 base = n 1619 %REPEAT 1620 1621 %IF pend quote # 0 %START 1622 ->err %IF sym # cquote 1623 readsym 1624 %FINISH 1625 %IF sym = '.' %START; !a real constant 1626 pt = pt+1; glink(pt) = '.' 1627 read sym 1628 type = real; n = base; base = 0; get(n) 1629 %FINISH 1630 1631 %IF sym = '@' %START; !an exponent 1632 pt = pt+1; glink(pt) = '@'; k = pt 1633 readsym 1634 type = integer; base = 10 1635 %IF sym = '-' %START 1636 read sym; get(10); n = -n 1637 %FINISH %ELSE %START 1638 get(10) 1639 %FINISH 1640 pt = k+1; glink(pt) = lp; litpool(lp) = n; lp = lp+1 1641 atom1 = error+10 %IF base = 0 1642 type = real; !exponents force the type 1643 %FINISH 1644 1645 %IF type = real %START 1646 glink(strp) = pt 1647 subatom = (strp)!16_2000; strp = pt+1 1648 %FINISH %ELSE %START 1649 litpool(lp) = n 1650 lp = lp+1 1651 %FINISH 1652 %RETURN 1653 1654 name: atom1 = 0 %AND %RETURN %IF 27 <= target %AND target <= 41 1655 hash value = 0 1656 1657 ! ABD changed to remove dependency on direct addressing 1658 1659 dp = dmax+1 1660 dbase = dp 1661 n = 0 1662 dict(dp) = 0 1663 %CYCLE 1664 hash value = hash value+(hash value+sym); !is this good enough? 1665 dict(dp) = dict(dp) ! (sym << 8); 1666 n = n+1 1667 dp = dp+1 1668 read sym 1669 %EXIT %IF symtype >= 0 1670 dict(dp) = sym; 1671 n = n+1 1672 read sym 1673 %EXIT %IF symtype >= 0 1674 %REPEAT 1675 %IF sym = cquote %START 1676 pend quote = 100 1677 ->symbols %IF hash value = 'M' 1678 read sym 1679 %IF hash value = 'X' %THEN base = 16 %AND ->bxk 1680 %IF hash value = 'K' %C 1681+ %OR hash value = 'O' %THEN base = 8 %AND ->bxk 1682 %IF hash value = 'B' %THEN base = 2 %AND ->bxk 1683 ->err 1684 %FINISH 1685 dict(dbase) = dict(dbase)!n 1686 %IF n&1 = 0 %THEN dp = dp+1 1687 abandon(8) %IF dp >= dmin 1688 1689 atom2 = 90; !ident 1690 %IF last1 = 0 %AND sym = ':' %START; !label 1691 limit = local; lookup(lab); %RETURN 1692 %FINISH 1693 %IF last1 = jump %START; !->label 1694 limit = local; lookup(lab+spec+used bit); %RETURN 1695 %FINISH 1696 %IF decl # 0 %AND target = 90 %START; !identifier 1697 search base = fm base 1698 limit = local; lookup(decl) 1699 search base = 0 1700 %FINISH %ELSE %START 1701 limit = 0; lookup(0) 1702 %FINISH 1703 %END ?DA unused 1704 1705 %INTEGERFN parsed machine code 1706 ! *opcode_?????????? 1707 %routine octal(%integer n) 1708 %integer m 1709 m = n>>3 1710 octal(m) %if m # 0 1711 bp = bp+1; buff(bp) = n&7+'0' 1712 %end 1713 atom1 = error %AND %RESULT=0 %UNLESS symtype = -2; !starts with letter 1714 flush buffer %IF bp >= 128 1715 bp=bp+1 %AND buff(bp)='w' 1716 %CYCLE 1717 bp=bp+1 %AND buff(bp)=sym 1718 read sym 1719 %EXIT %IF symtype >= 0; !pull in letters and digits 1720 %REPEAT 1721 bp=bp+1 %AND buff(bp)='_' 1722 %IF symtype # 0 %START; !not terminator 1723 atom1 = error %AND %result=0 %UNLESS sym = '_' 1724 read sym 1725 %WHILE symtype # 0 %CYCLE 1726 %IF symtype < 0 %START; !complex 1727 code atom(0); %result=0 %IF atom1&error # 0 1728 %IF atom2 = const %AND type = integer %START 1729 %IF subatom < 0 %THEN octal(tag(-subatom)_format) %C 1730+ %ELSE octal(litpool(subatom)) 1731 %FINISH %ELSE %START 1732 %IF 91 <= atom1 %AND atom1 <= 109 %START 1733 %if atom1 = 104 %and %c 1734+ Tag(Subatom)_Flags&Closed = 0 %start 1735 This = Subatom; Atom1 = Error+21 1736 %result = 0 1737 %finish 1738 op(' ', tag(subatom)_index) 1739 %FINISH %ELSE %START 1740 atom1 = error; %result=0 1741 %FINISH 1742 %FINISH 1743 %FINISH %ELSE %START 1744 bp=bp+1 %AND buff(bp)=sym; read sym 1745 %FINISH 1746 %REPEAT 1747 %FINISH 1748 bp=bp+1 %AND buff(bp)=';' 1749 %RESULT=1 1750 %END 1751 1752 cont = ' ' %IF gg = 0 1753 last1 = 0; mapgg = 0 1754 s = 0; ss = 0; sstype = -1; fdef = 0 1755 fm base = 0 1756 app = 0 1757 1758 !deal with alignment following an error in one statement 1759 !of several on a line 1760 1761 margin = column; !start of statement 1762 1763 pos = 0 1764 strp = gmax+1; lp = 0 1765 tbase = tstart; !?????????????? 1766 local = tbase 1767 1768 %IF gg = 0 %or ocount >= 0 %START; !data or not continuation(z) 1769 again:%WHILE sym type = 0 %CYCLE; !skip redundant terminators 1770 c = cont 1771 cont = ' '; cont = '+' %IF ocount >= 0 1772 read sym 1773 cont = c 1774 %REPEAT 1775 ->skip %IF sym = '!'; !comment 1776 this = -1 1777 code atom(0) 1778 %IF atom1 = comment %START 1779 skip: quote = 1 1780 c = cont 1781 read sym %AND cont = c %WHILE sym # nl; !skip to end of line 1782 quote = 0; symtype = 0 1783 ->again 1784 %FINISH 1785 %FINISH 1786 decl = 0; mark = 0 1787 gentype = 0; force = 0 1788 dim = 0; prot err = 0 1789 node = 0; nmax = 0; nmin = rec size+1 1790 order = 1; gmin = max grammar+1 1791 sstype = 0 %AND ->more %IF gg # 0; !continuation 1792 ptype = 0; spec given = 0 1793 1794 stats = stats+1; op('O', lines) %IF perm = 0 1795 1796 ->fail1 %IF atom1&error # 0; !first atom faulty 1797 1798 %IF escape class # 0 %START; !enter the hard way after 1799 g = imp phrase; sstype = -1; ->a3 1800 %FINISH 1801 1802 g = initial(atom1); !pick up entry point 1803 %IF g = 0 %START; !invalid first atom 1804 g = initial(0); sstype = 0; ->a3; !declarator? 1805 %FINISH 1806 %IF g < 0 %START; !phrase imp 1807 g = g&255 1808 nmax = 1 1809 ar(1)_class = 0; ar(1)_link = 0; ar(1)_sub = imp phrase 1810 %FINISH 1811 1812 gg = gram(g); class = gg&255; sstype = gg>>12&3-1 1813 ->a1 1814 1815 act(194): ptype = type; papp = app; pformat = format; ->more 1816 act(196):k =g+1; ->a610 1817 act(188):k = ar(nmax)_sub+1 1818 a610: papp = glink(k) 1819 k = gram(k) 1820 ->more %IF k = 0; !%NAME 1821 ptype = k&7; pformat = k>>3 1822 act(183):k = type; gentype = k %IF gentype = 0 %OR k = real 1823 %IF pformat < 0 %START; !general type 1824 app = papp; format = pformat 1825 k = real %IF ptype = real %AND type = integer 1826 k = force %AND force = 0 %IF force # 0 1827 %FINISH 1828 ->fail2 %UNLESS papp = app %AND (ptype = k %OR ptype = 0) 1829 ->more %IF pformat=format %OR pformat = 0 %OR format = 0 1830 ->fail2 1831 act(197):arp == ar(nmin) 1832 k = arp_sub 1833 ->fail3 %UNLESS block form = k&15 1834 arp_sub = k>>4 1835 1836 type = block type 1837 ptype = block type; pformat = block fm; papp = app 1838 pformat = -1 %IF ptype # record 1839 ->more 1840 act(195):->Fail2 %if Type # 0 %and Type # Integer %and %c 1841+ Type # Real 1842 arp == ar(nmin) 1843 k = arp_sub 1844 arp_sub = k>>2 1845 k = k&3 1846 !1 = check integer 1847 !2 = check real 1848 !3 = check real + int 1849 ->more %IF k = 0; !0 = no action 1850 %IF k = 1 %START 1851 force = integer 1852 ->more %IF type = integer %OR type = 0 1853 ->fail2 1854 %FINISH 1855 ->fail2 %UNLESS ptype = real %or ptype = 0 ;!{or added?} 1856 force = integer %IF k = 3 1857 ->more 1858 act(198):;!%OTHER 1859 k = gg>>8&15 1860 %IF k = 0 %START; !restore atom 1861 atom1 = last1 1862 ->more 1863 %FINISH 1864 %IF k = 1 %START; !test string 1865 ->fail2 %UNLESS type = stringv 1866 ->more 1867 %FINISH 1868 %if k = 2 %start ;!{fault record comparisons} 1869 ->fail2 %if type = record 1870 ->more 1871 %finish 1872 %if k = 3 %start; !check OWN variable coming 1873 code atom(0) 1874 ->A7 %if atom flags&own bit = 0 1875 ->more 1876 %finish 1877 for warn = pos1 %IF x <= local; !%FORTEST 1878 ->more 1879 paction(1):%IF type = record %THEN g = phrase(242) %ELSE pformat = -1 1880 ->a3 1881 paction(2):ptype = real; pformat = -1; ->a3 1882 paction(3):ptype = stringv; pformat = -1; ->a3 1883 paction(4):ptype = integer; pformat = -1; ->a3 1884 paction(5):->a3 %if ptype = integer 1885 g = phrase(212) %AND pformat=-1 %IF ptype = real 1886 g = phrase(213) %IF ptype = stringv 1887 ->a3 1888 paction(6):ptype = gram(ar(nmax)_sub+1)&7; pformat = -1; ->a3 1889 paction(7):ptype=real %IF ptype = integer; pformat = -1; ->a3 1890 1891 a1: last1 = class; atom1 = 0; s = subatom 1892 1893 a2: %IF gg&trans bit = 0 %START; !insert into analysis record 1894 z == node 1895 %CYCLE; !insert cell in order 1896 k = z 1897 %EXIT %IF gg&order bits = 0 %OR k = 0 1898 gg = gg-order bit; z == ar(k)_link 1899 %REPEAT 1900 gg = map gg %IF map gg # 0 %AND gg&255 = var 1901 nmin = nmin-1; ->fail0 %IF nmin = nmax 1902 z = nmin 1903 arp == ar(nmin) 1904 arp_sub = s; arp_class = (gg&255)!mark 1905 arp_link = k 1906 %FINISH 1907 mark = 0; map gg = 0 1908 1909 more: g = glink(g); !chain down the grammar 1910 1911 paction(0): 1912 a3: gg = gram(g); class = gg&255 1913 trace analysis %IF diag&1 # 0 1914 ->a5 %IF class = 0; !end of phrase 1915 1916 %IF class < actions %START; !not a phrase or an action 1917 class = atomic(class) %IF class >= figurative 1918 ->a2 %IF class >= manifest 1919 code atom(class) %IF atom1 = 0 1920 %IF escape class # 0 %START; !escape to new grammar 1921 class = escape class; escape class = 0 1922 g = g+escape 1923 1924 !note that following an escape the next item is 1925 !forced to be transparent! 1926 1927 esc: gg = 0 1928 arp == ar(nmax+1) 1929 arp_papp = papp; arp_x = x; ->a4 1930 %FINISH 1931 1932 ->a1 %IF class = atom1 %OR class = atom2 1933 1934 a7: ->fail1 %IF gg >= 0; !no alternative 1935 g = g+1 1936 ->a3 1937 %FINISH 1938 1939 %IF class >= phrasal %START; !a phrase 1940 a4: nmax = nmax+1; ->fail0 %IF nmax = nmin 1941 arp == ar(nmax) 1942 arp_ptype = ptype 1943 arp_pos = pos1 1944 arp_pformat = pformat 1945 arp_link = gentype 1946 arp_class = node 1947 arp_sub = g 1948 node = 0 1949 g = phrase(class) 1950 ptype = force %AND force = 0 %IF force # 0 1951 gentype = 0 1952 ->paction(gg>>8&15) 1953 %FINISH 1954 1955 ->act(class); !only actions left 1956 1957 a5: ;!reverse links 1958 1959 s = 0 1960 %WHILE node # 0 %CYCLE 1961 z == ar(node)_link 1962 k = z; z = s; s = node; node = k 1963 %REPEAT 1964 ss = s 1965 1966 a6: %IF nmax # 0 %START 1967 k = gentype; !type of phrase 1968 arp == ar(nmax); nmax = nmax-1 1969 node = arp_class 1970 gentype = arp_link 1971 ptype = arp_ptype 1972 pformat = arp_pformat 1973 g = arp_sub 1974 %IF g&escape # 0 %START 1975 g = g-escape 1976 papp = arp_papp 1977 mark = 255 1978 subatom = s 1979 ->a3 1980 %FINISH 1981 gentype = k %IF gentype = 0 %OR k = real 1982 type = gen type 1983 1984 k = gg; !exit-point code 1985 %CYCLE 1986 gg = gram(g) 1987 ->a2 %IF k = 0 1988 ->fail1 %IF gg >= 0; !no alternative phrase 1989 k = k-order bit 1990 g = g+1; !sideways step 1991 %REPEAT 1992 1993 %FINISH 1994 1995 Fault(4) %IF copy # 0 1996 fault(13) %IF order = 0 1997 fault(-4) %IF for warn # 0 1998 pos1 = 0 1999 fault rate = fault rate-1 2000 %RETURN 2001 2002 act(193):gg = 0 %AND ->a5 %UNLESS sym = '=' %or sym = '<'; !cdummy 2003 act(181):atom1 = amap(decl&15); !dummy 2004 ->more 2005 2006 act(182):class = escdec; g = glink(g)!escape 2007 decl = 0; otype = 0; ->esc; !decl 2008 2009 act(199):; !compile 2010 2011 s = 0 2012 %WHILE node # 0 %CYCLE 2013 z == ar(node)_link 2014 k = z; z = s; s = node; node = k 2015 %repeat 2016 ss = s 2017 2018 code atom(28) %IF quote # 0; !expend 2019 compile; ->more %IF atom1&error = 0 2020 ->fail1 2021 2022 act(184):->fail4 %UNLESS type = integer 2023 %IF subatom < 0 %THEN lit = tag(-subatom)_format %C 2024+ %ELSE lit = lit pool(subatom) 2025 ->fail4 %IF lit # 0 2026 ->more 2027 act(185):; !apply parameters 2028 s = 0 2029 %WHILE node # 0 %CYCLE 2030 z == ar(node)_link 2031 k = z; z = s; s = node; node = k 2032 %REPEAT 2033 ss = s 2034 2035 atom1 = ar(s)_class; atom2 = 0 2036 atom1 = var %IF atom1 = 97 %OR atom1 = 98 2037 arp == ar(nmax) 2038 x = arp_x 2039 pos1 = arp_pos 2040 pos2 = 0 2041 app = 0 2042 format = tag(x)_format 2043 flags = tag(x)_flags 2044 type = flags>>4&7 2045 protection = flags&prot 2046 protection = 0 %IF flags&aname # 0 2047 2048 %IF flags&subname # 0 %AND format # 0 %START 2049 ->fail1 %if format selected = 0 2050 %FINISH 2051 2052 ->a6 2053 2054 act(187):protection = prot; ->more; !%SETPROT 2055 act(186):->More %if protection&prot = 0 2056 prot err = nmin 2057 ->A7 2058 act(191):k = protection; !%GUARD 2059 code atom(0) 2060 protection = k %IF atom flags&aname = 0 2061 ->more 2062 2063 act(192):->fail1 %IF parsed machine code=0 2064 ->more 2065 2066 act(189):k = gapp; !%GAPP 2067 delete names(1) 2068 tmax = tbase; tbase = gram (gmin); !restore tmax 2069 local= tbase 2070 gmin = gmin+1 2071 2072 x = ar(ar(nmax)_class)_sub 2073 tag(x)_app = k; !update app 2074 ->more 2075 2076 act(190):gmin = gmin-1; !%LOCAL 2077 abandon(2) %IF gmin <= gmax 2078 gram (gmin) = tbase; tbase = tmax 2079 local = tbase 2080 ->more 2081 2082 ! errors 2083 2084 fail4:k = error+10; ->failed; !*size 2085 fail3:k = error+7; ->failed; !*context 2086 fail2:k = error+5; pos2 = 0; ->failed; !*type 2087 fail0:k = error+3; ->failed; !*too complex 2088 fail1:k = atom1; pos2 = 0 2089 2090 failed: 2091 %IF diag&32 # 0 %START 2092 printstring("Atom1 ="); write(atom1, 3) 2093 printstring(" Atom2 ="); write(atom2, 3) 2094 printstring(" subatom ="); write(subatom, 3); newline 2095 printstring("Type ="); write(type, 1) 2096 printstring(" Ptype ="); write(ptype, 1); newline 2097 printstring("App ="); write(app, 1) 2098 printstring(" Papp ="); write(papp, 1); newline 2099 printstring("Format ="); write(format, 1) 2100 printstring(" Pformat ="); write(pformat, 1); newline 2101 !%SIGNAL 13,15 2102 %FINISH 2103 2104 quote = 0 %AND readsym %WHILE sym # nl %AND sym # ';' 2105 %IF k&error # 0 %START 2106 fault(k&255) 2107 %FINISH %ELSE %START 2108 %IF prot err = nmin %THEN fault(14) %ELSE fault(0) 2109 %FINISH 2110 gg = 0; ss = 0; symtype = 0 2111 %END; !of analyse 2112 2113 %ROUTINE compile 2114 2115 %CONSTINTEGER then = 4, else = 8, loop = 16 2116 2117 %SWITCH c(0:actions), litop(1:12) 2118 2119 %CONSTBYTEINTEGERARRAY operator(1:14) = %C 2120+ '[', ']', 'X', '/', '&', '!', '%', '+', 2121+ '-', '*', 'Q', 'x', '.', 'v' 2122 2123 %CONSTBYTEINTEGERARRAY cc(0 : 7) = '#','=',')','<','(','>', 'k','t' 2124 2125 %CONSTBYTEINTEGERARRAY anyform(0:15) = 1,0,1,1,1,1,1,1,0,1,1,0,1,1,1,1 2126 2127 %CONSTINTEGERARRAY decmap(0:15) = %C 2128+ 1, 2, 2129+ 16_100B, 16_100D, 16_140C, 16_140E, 2130+ 3, 4, 2131+ 16_1007, 16_1008, 16_1009, 16_100A, 2132+ 6, 0, 0, 0 2133 %OWNBYTEINTEGERARRAY cnest(0:15) 2134 %INTEGER lmode, clab, dupid 2135 %INTEGER resln 2136 %OWNINTEGER last def = 0 2137 %OWNINTEGER lb, ub 2138 %INTEGER cp, ord 2139 %INTEGER next, link, j, k, n, done 2140 %INTEGER class 2141 %INTEGER lit2, defs, decs, cident 2142 %INTEGER pending; %OWNINTEGERARRAY pstack(1:40) 2143 %OWNSTRING(8) name = "" 2144 %OWNINTEGER count = 0 2145 2146 %ROUTINE def lab(%INTEGER l) 2147 op(':', l) 2148 access = 1 2149 %END 2150 2151 %ROUTINE get next 2152 %RECORD(arfm)%NAME p 2153 gn: %IF next = 0 %START; !end of phrase 2154 class = 0 %AND %RETURN %IF link = 0; !end of statement 2155 p == ar(link) 2156 next = p_link 2157 link = p_sub 2158 %FINISH 2159 %CYCLE 2160 p == ar(next) 2161 x = p_sub 2162 class = p_class 2163 %EXIT %IF class < actions; !an atom 2164 %IF x = 0 %START; !null phrase 2165 next = p_link; ->gn 2166 %FINISH 2167 %IF p_link # 0 %START; !follow a phrase 2168 p_sub = link; link = next 2169 %FINISH 2170 next = x 2171 %REPEAT 2172 next = p_link 2173 %IF diag&2 # 0 %START 2174 spaces(8-length(name)) %UNLESS length(name) = 0 2175 name = text(class) 2176 write(x, 2) 2177 space 2178 printstring(name) 2179 space 2180 count = count-1 2181 %IF count <= 0 %START 2182 count = 5 2183 name = "" 2184 newline 2185 %FINISH 2186 %FINISH 2187 %END 2188 2189 %ROUTINE set subs(%INTEGER n) 2190 2191 !update the app field in n array descriptors 2192 2193 %INTEGER p 2194 p = tmax 2195 %WHILE n > 0 %CYCLE 2196 !%SIGNAL 15,15 %IF p < tbase 2197 tag(p)_app = dimension 2198 p = p-1; n = n-1 2199 %REPEAT 2200 %END 2201 2202 %ROUTINE set bp 2203 2204 !define a constant bound pair from the last stacked constants 2205 2206 pending = pending-2 2207 lb = pstack(pending+1); ub = pstack(pending+2) 2208 %IF ub-lb+1 < 0 %START 2209 pos1 = 0; next = link; fault(11) 2210 ub = lb 2211 %FINISH 2212 set const(lb); set const(ub) 2213 bp=bp+1 %AND buff(bp)='b' %UNLESS class = 146 2214 %END 2215 2216 %ROUTINE compile end(%INTEGER type) 2217 2218 ! type = 0:eof, 1:eop, 2:end 2219 2220 %IF access # 0 %START 2221 open = 0 2222 fault(19) %IF block form > proc; !can reach end 2223 %FINISH 2224 2225 %WHILE dict(dmin) >= 0 %CYCLE; !finishes & repeats 2226 fault(17+dict(dmin)&1) 2227 dmin = dmin+1 2228 %REPEAT 2229 !{delete names(0)} 2230 bp=bp+1 %AND buff(bp)=';' 2231 bp=bp+1 %AND buff(bp)=';' %IF type = 1; !endofprogram 2232 2233 bflags = bflags!open; !show if it returns 2234 2235 def lab(0) %IF block tag # 0 %AND level # 1; !for jump around 2236 %IF type # 2 %START; !eop, eof 2237 fault(16) %IF level # type; !end missing 2238 %FINISH %ELSE %START 2239 %IF level = 0 %START 2240 fault(15); !spurious end 2241 %FINISH 2242 %FINISH 2243 2244 end mark = 11; !******Mouses specific****** 2245 %END 2246 2247 %ROUTINE def(%INTEGER p) 2248 2249 !dump a descriptor 2250 2251 %INTEGER t, f, type 2252 %RECORD(tagfm)%NAME v 2253 flush buffer %if bp # 0 2254 defs = defs+1 2255 v == tag(p) 2256 t = 0 2257 %UNLESS v_index < 0 %START; !no index for subnames 2258 id = id+1 %AND v_index = id %IF v_index = 0 2259 last def = v_index 2260 t = last def 2261 %FINISH 2262 op('$', t) 2263 print ident(p, 1); !output the name 2264 t = v_flags 2265 type = t 2266 type = type&(\(7<<4)) %IF type&(7<<4) >= 6<<4;!routine & pred 2267 op(',', type&2_1111111); !type & form 2268 f = v_format 2269 f = tag(f)_index %IF t&16_70 = record<<4 2270 f = v_index %IF f < 0 2271 op(',', f); !format 2272 f = otype+t>>4&2_1111000 2273 f = f!8 %IF class = 125; !add spec from %DUP 2274 dim = v_app; !dimension 2275 dim = 0 %unless 0 < dim %AND dim <= dim limit 2276 op(',', f+dim<<8); !otype & spec & prot 2277 defs = 0 %IF t¶meters = 0 2278 f = t&15 2279 %IF v_flags&spec # 0 %START 2280 v_flags = v_flags&(\spec) %UNLESS 3 <= f %AND f <= 10 2281 ocount = -1; !external specs have no constants 2282 %FINISH 2283 dimension = 0 2284 %if otype = 2 %and (f=2 %or f=12 %or f=14) %start 2285 v_flags = v_flags-1; !convert to simple 2286 %finish 2287 %END 2288 2289 %ROUTINE def s lab(%INTEGER n) 2290 2291 !define a switch label, x defines the switch tag 2292 2293 %INTEGER p, l, b, w, bit 2294 p = tag(x)_format; !pointer to table 2295 l = dict(p); !lower bound 2296 %IF l <= n %AND n <= dict(p+1) %START 2297 b = n-l 2298 w = b>>4+p 2299 bit = 1<<(b&15) 2300 %IF dict(w+2)&bit # 0 %START; !already set 2301 fault(4) %IF pending # 0 2302 %RETURN 2303 %FINISH 2304 dict(w+2) = dict(w+2)!bit %IF pending # 0 2305 set const(n) 2306 op('_', tag(x)_index) 2307 %FINISH %ELSE %START 2308 fault(12) 2309 %FINISH 2310 access = 1 2311 %END 2312 2313 %ROUTINE call 2314 %RECORD(tagfm)%NAME T 2315 t == tag(x) 2316 op('@', t_index) 2317 access = 0 %IF t_flags&closed # 0; !never comes back 2318 bp=bp+1 %AND buff(bp)='E' %IF t_app = 0; !no parameters 2319 %END 2320 2321 %ROUTINE pop def 2322 set const(pstack(pending)); pending = pending-1 2323 %END 2324 2325 %ROUTINE pop lit 2326 %IF pending = 0 %THEN lit = 0 %ELSE %START 2327 lit = pstack(pending); pending = pending-1 2328 %FINISH 2329 %END 2330 2331 2332 %IF sstype < 0 %START; !executable statement 2333 %IF level = 0 %START; !outermost level 2334 fault(13); !*order 2335 %FINISH %ELSE %START 2336 %IF access = 0 %START 2337 access = 1; fault(-1); !only a warning 2338 %FINISH 2339 %FINISH 2340 %FINISH 2341 2342 %IF diag&2 # 0 %START 2343 newline %IF sym # nl 2344 printstring("ss =") 2345 write(ss, 1) 2346 newline 2347 count = 5 2348 name = "" 2349 %FINISH 2350 2351 next = ss 2352 pending = 0; lmode = 0 2353 link = 0; decs = 0 2354 defs = 0; resln = 0; done = 0 2355 ord = level 2356 ord = 1 %IF this >= 0; !recordformat declarations 2357 c(0): 2358 top: %IF next # link %START 2359 get next; ->c(class) 2360 %FINISH 2361 2362 !all done, tidy up declarations and jumps 2363 2364 newline %IF diag&2 # 0 %AND count # 5 2365 2366 %IF lmode&(loop!then!else) # 0 %START; !pending labels and jumps 2367 op('B', label-1) %IF lmode&loop # 0; !repeat 2368 def lab(label) %IF lmode&then # 0; !entry from then 2369 def lab(label-1) %IF lmode&else # 0; !entry from else 2370 %FINISH 2371 2372 %RETURN %IF decs = 0 2373 atom1 = error %AND %RETURN %IF atom1 # 0; !%INTEGERROUTINE 2374 order = ord 2375 decl = decl&(\15)+decmap(decl&15); !construct declarator flags 2376 atom1 = atoms(decl&15); !generate class 2377 %IF otype # 0 %START; !own, const etc. 2378 atom1 = atom1+1 %IF atom1 # proc 2379 %IF otype = 2 %START; !const 2380 n = decl&15 2381 %if n&1 # 0 %start 2382 decl = decl!prot 2383 decl = decl!const bit %IF decl&2_1111111 = iform 2384 %finish 2385 %else 2386 decl = decl!own bit 2387 %FINISH 2388 %FINISH 2389 sstype = 1 %IF sstype = 0 %AND atom1 = proc 2390 atom1 = atom1+1 %IF decl&spec # 0; !onto spec variant 2391 ocount = 0 %AND cont = '+' %IF atom1 = 5; !own array 2392 %IF anyform(decl&15) = 0 %START; !check meaningful 2393 %IF decl>>4&7 = record %START 2394 this = fdef %IF tag(fdef)_flags&spec # 0 2395 atom1 = error+21 %IF fdef = this; !*context for format 2396 %FINISH 2397 atom1 = error+10 %IF fdef = 0; !*size 2398 %FINISH 2399 %RETURN 2400 2401 atop: access = 0; ->top 2402 2403 ! declarators 2404 2405 c(88): ; !rtype 2406 c(28): decl = x&(\7); !stype 2407 fdef = x&7; !precision 2408 fdef = reals ln %IF x&2_1110001 = real<<4+1; !convert to long 2409 decs = 1; ->top 2410 c(34): ; !own 2411 c(35): otype = x; ord = 1; ->top; !external 2412 c(152):decl = decl+x<<1; ->top; !xname 2413 c(31): ; !proc 2414 c(32): spec mode = level+1; !fn/map 2415 decl = decl!prot %IF x = 9; !function 2416 c(29): ord = 1; !array 2417 dim = 0 2418 c(30): decl = decl+x; !name 2419 decs = 1 2420 ->top 2421 c(27): lit = 0; ! arrayd 2422 %IF pending # 0 %START 2423 pop lit 2424 %UNLESS 0 top 2431 c(37): x = x!subname; !record 2432 c(36): lit = 0; !string 2433 %IF pending # 0 %START 2434 pop lit 2435 %UNLESS 0 < lit %AND lit <= 255 %START; !max length wrong 2436 atom1 = error+10; %RETURN 2437 %FINISH 2438 %FINISH 2439 fdef = lit; !format or length 2440 c(33): decl = x; !switch 2441 decs = 1 2442 ->top 2443 c(39): decl = decl!spec; !spec 2444 ocount = -1; !no initialisation 2445 spec mode = -1 2446 ->top 2447 c(38): decl = 64+4; !recordformat (spec) 2448 order = 1 2449 atom1 = x 2450 decl = decl!spec %if atom1 = 12; !formatspec 2451 fdef = tmax+1; !format tag 2452 %return 2453 c(175):id = id+1; tag(x)_index = id; %return; !FSID 2454 c(41): decs = 1; decl = x!spec!closed; ->top; !label 2455 c(133):recid = 0; rbase = tmin-1; !fname 2456 this = x 2457 fm base = fdef; format list = tmin 2458 def(this); ->top 2459 c(148):fdef = 0 %AND ->top %IF next = 0; !reclb 2460 get next; !skip name 2461 fdef = x 2462 ->top 2463 c(127):bp=bp+1 %AND buff(bp)='}'; ->top; !%POUT 2464 c(126):bp=bp+1 %AND buff(bp)='{'; ->top; !%PIN 2465 2466 c(174):set bp; !rangerb 2467 c(171):; !fmlb 2468 c(172):; !fmrb 2469 c(173):bp=bp+1 %AND buff(bp)='~'; bp=bp+1 %AND buff(bp)=class-171+'A'; ->top; !fmor 2470 c(168):rbase = -rbase; !orrb 2471 sstype = 0; spec mode = 0 2472 2473 c(147):search base = 0; !recrb 2474 tag(this)_app = tmin 2475 tag(this)_format = rbase 2476 ->top 2477 2478 c(45):bp=bp+1 %and buff(bp)='U' %IF x = 36; ->top; !sign 2479 c(46):bp=bp+1; buff(bp)='\'; ->top; !uop 2480 c(47):; !mod 2481 c(48):; !dot 2482 c(42):; !op1 2483 c(43):; !op2 2484 c(44):bp=bp+1; buff(bp)=operator(x); ->top; !op3 2485 2486 !conditions & jumps 2487 2488 %ROUTINE push(%INTEGER x) 2489 %IF cnest(cp)&2 # x %START 2490 cnest(cp) = cnest(cp)!1; x = x+4 2491 %FINISH 2492 clab = clab+1 %IF cnest(cp)&1 # 0 2493 cnest(cp+1) = x; cp = cp+1 2494 %END 2495 2496 %ROUTINE pop label(%INTEGER mode) 2497 lmode = dict(dmin) 2498 %IF lmode < 0 %OR lmode&1 # mode %START 2499 fault(mode+8) 2500 %FINISH %ELSE %START 2501 dmin = dmin+1; label = label-3 2502 %FINISH 2503 %END 2504 2505 c(56):; !and 2506 c(57):push(x); ->top; !or 2507 c(58):cnest(cp) = cnest(cp)!!2; ->top; !not 2508 2509 c(138):x = 128+32+16+4; !csep: treat like %WHILE 2510 c(59):; !while 2511 c(60):%IF class = 138 %THEN op('f', label-1) %C 2512+ %ELSE def lab(label-1); !until 2513 c(166):; !runtil 2514 c(62):lmode = (lmode&(else!loop)) !(x>>3); !cword 2515 clab = label; cp = 1; cnest(1) = x&7 2516 ->top 2517 c(72):pop label(0); !repeat 2518 def lab(label+1) %IF lmode&32 # 0; ->atop 2519 c(69):pop label(1); ->top; !finish 2520 c(163):; !xelse 2521 c(70):pop label(1); !finish else ... 2522 fault(7) %IF lmode&3 = 3; !dangling else 2523 c(68):lmode = (lmode&else)!3; !...else... 2524 %IF access # 0 %START 2525 op('F', label-1); lmode = else!3 2526 %FINISH 2527 def lab(label) 2528 ->top %IF next # 0 2529 2530 c(120):; !%MSTART 2531 c(67): ; !start 2532 c(71): ; !cycle 2533 stcy: def lab(label-1) %AND lmode = loop %IF lmode = 0;!cycle 2534 dmin = dmin-1; abandon(3) %IF dmin <= dmax 2535 dict(dmin) = lmode 2536 label = label+3 2537 %RETURN 2538 2539 c(64):fault(13) %IF dict(dmin) >= 0 %OR inhibit # 0; !on event 2540 inhibit = 1 2541 n = 0 2542 n = 16_FFFF %IF pending = 0; !* = all events 2543 %WHILE pending > 0 %CYCLE 2544 pop lit; fault(10) %IF lit&(\15) # 0;!too big 2545 j = 1<stcy 2551 2552 2553 c(104):op('J', tag(x)_index); !l 2554 inhibit = 1; ->atop 2555 c(149):stats = stats-1; !lab 2556 access = 1; inhibit = 1 2557 op('L', tag(x)_index); ->top 2558 2559 c(63):j = dmin; l = label-3; !exit, continue 2560 %CYCLE 2561 fault(7) %AND ->top %IF dict(j) < 0 2562 %EXIT %IF dict(j)&1 = 0 2563 j = j+1; l = l-3 2564 %REPEAT 2565 l = l+1 %IF x = 32; !continue 2566 op('F', l) 2567 dict(j) = dict(j)!x; !show given 2568 ->atop 2569 2570 c(50):bp=bp+1 %AND buff(bp)='C'; ->cop; !acomp 2571 2572 c(49): bp = bp+1 2573 %IF next # 0 %START; !comparator 2574 buff(bp)='"'; push(0); !double sided 2575 %FINISH %ELSE %START 2576 buff(bp)='?' 2577 %FINISH 2578 2579 cop: x = x!!1 %IF cnest(cp)&2 # 0; !invert the condition 2580 j = cp; l = clab 2581 %WHILE cnest(j)&4 = 0 %CYCLE 2582 j = j-1; l = l-cnest(j)&1 2583 %REPEAT 2584 op(cc(x), l) 2585 def lab(clab+1) %IF cnest(cp)&1 # 0 2586 cp = cp-1 2587 clab = clab-cnest(cp)&1 2588 ->top 2589 2590 c(78): ; !fresult 2591 c(79): ; !mresult 2592 c(80): open = 0; !return, true, false 2593 c(82): access = 0; !stop 2594 c(89): ; !addop 2595 c(81): bp=bp+1 %AND buff(bp)=x; ->top; !monitor 2596 2597 c(65): pop lit; op('e', lit); ->atop; !signal 2598 2599 c(51): bp=bp+1 %AND buff(bp)='S'; ->top; !eq 2600 c(53): bp=bp+1 %AND buff(bp)='j'; ->top; !jam transfer 2601 c(52): bp=bp+1 %AND buff(bp)='Z'; ->top; !eqeq 2602 2603 c(74):%IF level = 0 %START; !begin 2604 %IF progmode <= 0 %THEN progmode = 1 %ELSE fault(7) 2605 !{Permit BEGIN after external defs} 2606 %FINISH 2607 spec mode = level+1 2608 block x = 0 2609 bp=bp+1 %AND buff(bp)='H'; %RETURN 2610 c(77):perm = 0; lines = 0; stats = 0; !endofperm 2611 close input 2612 select input(source) 2613 list = list-1 2614 tbase = tmax; tstart = tmax 2615 %RETURN 2616 c(76):%IF include # 0 %AND x = 0 %START; !end of ... 2617 lines = include; sstype = 0; !include 2618 close input 2619 list = include list 2620 include level = 0 2621 include = 0; select input(source); %RETURN 2622 %FINISH 2623 ss = -1; !prog/file 2624 c(75):compile end(x); %RETURN; !%END 2625 2626 c(85):%IF x=0 %THEN control=lit %ELSE %START; !control 2627 diag = lit&16_3FFF %IF lit>>14&3 = 1 2628 %FINISH 2629 op('z'-x, lit) 2630 ->top 2631 c(83):list = list+x-2; ->top; !%LIST/%ENDOFLIST 2632 c(84):reals ln = x; ->top; !%REALS long/normal 2633 c(86):%IF include # 0 %START; !include "file" 2634 fault(7); %RETURN 2635 %FINISH 2636 get next; !sconst 2637 x = x-16_4000 2638 j = glink(x) 2639 k = j&255 2640 !ABD - another little copy loop because SKIMP can't do the string map 2641 include file = "" 2642 %CYCLE 2643 k = k-1; %EXIT %IF k < 0 2644 include file = include file.tostring(j>>8) 2645 x = x+1 2646 j = glink(x) 2647 k = k-1; %EXIT %IF k < 0 2648 include file = include file.tostring(j&255) 2649 %REPEAT 2650 !include file = string(x-16_4000+stbase) 2651 !%begin 2652 ! %on 9 %start; !Abandon(9); !%finish 2653 open input(3, include file) 2654 !%end 2655 include = lines; lines = 0 2656 include list = list; include level = level 2657 select input(3) 2658 ->top 2659 2660 c(154):dimension = dimension+1; !dbsep 2661 fault(11) %IF dimension = dim limit+1 2662 ->top 2663 c(145):set bp; ->top; !crb 2664 c(146):set bp; !rcrb 2665 c(142):; !bplrb 2666 dimension = 1 %IF dimension = 0 2667 op('d', dimension); op(',', defs) 2668 %IF class # 146 %START 2669 set subs(defs) 2670 fault(13) %IF dict(dmin) >= 0 %OR inhibit # 0 %OR level=0 2671 %FINISH 2672 dimension = 0; defs = 0 2673 ->top 2674 c(128):id = dupid; ->top; !EDUP 2675 c(130):block x = x 2676 op('F', 0) %IF decl&spec = 0 %AND level # 0; !jump round proc 2677 c(125):dupid = id; !%DUP 2678 %return %if Level < 0 ;!{spec about} 2679 c(90): def(x); ->top; !ident 2680 c(131):; !cident 2681 %IF tag(x)_flags&(2_1111111+const bit) = iform+const bit %START 2682 tag(x)_format = lit 2683 %FINISH %ELSE %START 2684 set const(lit) %IF pending # 0 2685 def(x) 2686 op('A', 1) 2687 %FINISH 2688 cident = x 2689 ->top 2690 c(124):dubious = 1 %IF tag(cident)_flags&prot # 0; !%DUBIOUS 2691 ->top 2692 c(97): ; !f 2693 c(98): ; !m 2694 c(99): ; !p 2695 c(96): call; ->top; !r 2696 2697 c(165):; !nlab 2698 c(100):; !rp 2699 c(101):; !fp 2700 c(102):; !mp 2701 c(103):; !pp 2702 c(91): ; !v 2703 c(92): ; !n 2704 c(106):; !a 2705 c(107):; !an 2706 c(108):; !na 2707 c(109):; !nan 2708 k = tag(x)_index 2709 %IF k < 0 %THEN op('n', -k) %ELSE op('@', k) 2710 ->top 2711 c(121):set const(0); ->top; !special for zero 2712 c(167):bp=bp+1; buff(bp)='G'; ->pstr; !aconst (alias) 2713 c(const):; !const 2714 %IF x < 0 %START; !constinteger 2715 set const(tag(-x)_format); ->top 2716 %FINISH 2717 %IF x&16_4000 # 0 %START; !strings 2718 bp=bp+1 %AND buff(bp)='''' 2719 pstr: x = x-16_4000 2720 j = glink(x) 2721 k = j&255 2722 bp=bp+1 %AND buff(bp)=k 2723 %CYCLE 2724 k = k-1; ->top %IF k < 0 2725 bp = bp+1; buff(bp) = j>>8; 2726 x = x+1 2727 j = glink(x) 2728 k = k-1; ->top %IF k < 0 2729 bp = bp+1; buff(bp) = j&255 2730 %REPEAT 2731 %FINISH 2732 %IF x&16_2000 # 0 %START; !real - ABD also string-like, but NOT packed 2733 x = x-16_2000 2734 k = glink(x) 2735 op('D', k); bp=bp+1 %AND buff(bp)=',' 2736 %CYCLE 2737 ->top %IF k = 0 2738 k = k-1 2739 x = x+1; j = glink(x) 2740 %IF j = '@' %START 2741 op('@', litpool(glink(x+1))); ->top 2742 %FINISH 2743 bp=bp+1 %AND buff(bp)=j 2744 %REPEAT 2745 %FINISH 2746 set const(lit pool(x)) 2747 ->top 2748 2749 c(137):bp=bp+1 %AND buff(bp)='i'; ->top; !asep 2750 c(141):bp=bp+1 %AND buff(bp)='a'; ->top; !arb 2751 2752 !own arrays 2753 2754 c(132):ocount = ub-lb+1 2755 def(x); !oident 2756 dimension = 1; set subs(1) 2757 %IF next = 0 %START; !no initialisation 2758 op('A', ocount) %IF ocount > 0 2759 ocount = -1 2760 %FINISH %ELSE %START; !initialisation given 2761 get next 2762 %FINISH 2763 ->top 2764 c(162):lit = ocount; ->ins; !indef 2765 c(143):pop lit; !orb 2766 ins: fault(10) %AND lit = 0 %IF lit < 0 2767 get next 2768 ->inst 2769 c(139):; !osep (x=19) 2770 c(153):lit = 1 2771 inst: pop def %IF pending # 0; !ownt (x=0) 2772 op('A', lit) 2773 ocount = ocount-lit 2774 %IF ocount >= 0 %START 2775 ->top %IF x # 0; !more coming 2776 ocount = -1 %AND %RETURN %IF ocount = 0; !all done 2777 %FINISH 2778 fault(11); %RETURN 2779 2780 c(swit):op('W', tag(x)_index); inhibit = 1; ->atop 2781 c(134):def(x); !swid 2782 n = ub-lb+1 2783 n = (n+15)>>4; !slots needed (includes zero) 2784 j = dmax; dmax = dmax+n+2 2785 abandon(1) %IF dmax >= dmin 2786 tag(x)_format = j 2787 dict(j) = lb; dict(j+1) = ub 2788 %CYCLE 2789 n = n-1 2790 ->top %IF n < 0 2791 j = j+1; dict(j+1) = 0 2792 %REPEAT 2793 c(151):stats = stats-1; !slab 2794 fault(7) %AND %RETURN %IF x < tbase 2795 %IF pending # 0 %START; !explicit label 2796 def s lab(pstack(1)) 2797 %FINISH %ELSE %START 2798 fault(4) %AND %RETURN %IF tag(x)_app # 0 2799 tag(x)_app = 1 2800 n = tag(x)_format 2801 %FOR j = dict(n), 1, dict(n+1) %CYCLE 2802 def s lab(j) 2803 flush buffer %IF bp >= 128 2804 %REPEAT 2805 %FINISH 2806 inhibit = 1 2807 %RETURN 2808 2809 c(140):bp=bp+1 %AND buff(bp)='p'; ->top; !psep 2810 c(144):buff(bp+1)='p'; buff(bp+2)='E'; bp=bp+2; ->top; !prb 2811 2812 !constant expressions 2813 2814 c(155):; !pconst 2815 %IF x < 0 %THEN lit = tag(-x)_format %c 2816+ %ELSE lit = lit pool(x) 2817 pending = pending+1; pstack(pending) = lit; ->top 2818 c(156):lit = pstack(pending); lit = -lit %IF lit < 0 2819 pstack(pending) = lit; ->top; !cmod 2820 c(157):lit = -pstack(pending); pstack(pending) = lit; ->top; !csign 2821 c(158):lit = \pstack(pending); pstack(pending) = lit; ->top; !cuop 2822 c(159):; !cop1 2823 c(160):; !cop2 2824 c(161):pending = pending-1; !cop3 2825 lit2 = pstack(pending+1); lit = pstack(pending) 2826 ->litop(x>>2) 2827 litop(10):lit = lit*lit2; ->setl 2828 litop(12): 2829 litop(3):n = 1; !lit = lit\\lit2 2830 fault(10) %IF lit2 < 0 2831 %WHILE lit2 > 0 %CYCLE 2832 lit2 = lit2-1 2833 n = n*lit 2834 %REPEAT 2835 lit = n; ->setl 2836 litop(1):lit = lit<setl 2837 litop(2):lit = lit>>lit2; ->setl 2838 litop(5):lit = lit&lit2; ->setl 2839 litop(11): 2840 litop(4):%IF lit2 = 0 %THEN fault(10) %ELSE lit = lit//lit2 2841 ->setl 2842 litop(8):lit = lit+lit2; ->setl 2843 litop(9):lit = lit-lit2; ->setl 2844 litop(6):lit = lit!lit2; ->setl 2845 litop(7):lit = lit!!lit2 2846 2847 setl: pstack(pending) = lit; ->top 2848 2849 c(170):;!Fault(4) %if IMPCOM_Option # "" 2850 !IMPCOM_Option = String(x-x'4000'+Stbase); !Option string 2851 ->Top 2852 2853 !string resolution 2854 2855 c(135):resln = 2; ->top; !dotl 2856 c(136):resln = resln+1; ->top; !dotr 2857 c(55): op('r', resln); resln = 0; ->top; !resop 2858 c(164):op('r', resln+4); resln = 0; !cresop 2859 c(122):x = 6; ->cop; !%PRED 2860 c(87): set const(pstack(1)); !mass 2861 bp=bp+1 %AND buff(bp)='P'; ->top 2862 %END 2863 2864 %END; !of compile block 2865 2866 !%ON 9 %START 2867 ! abandon(5) 2868 !%FINISH 2869 2870 !list = 15 %IF Impcom_Flags&x'1000' # 0 2871 2872 selectinput(2); selectoutput(listing) 2873 tag(max tag) = 0; !%BEGIN defn 2874 tag(0) = 0; tag(0)_flags = 7; !%BEGIN tag! 2875 Hash(x) = 0 %FOR x = 0, 1, max names 2876 printstring(" Edinburgh IMP77 Compiler - Version ") 2877 printstring(version); newlines(2) 2878 op('l', 0) 2879 compile block(0, 0, max dict, 0, 0) 2880 bp=bp+1 %AND buff(bp)=nl ;!{for bouncing off} 2881 flush buffer 2882 !Impcom_Statements = stats 2883 !Impcom_Statements = -faulty %IF faulty # 0 2884 %ENDOFPROGRAM Program stopped