mim/development/mim/mimc/compdec.mima

   1
   2 <PACKAGE "COMPDEC">
   3
   4 <ENTRY CTLZ-PRINT RSUB-DEC TMPS-NEXT TMP-DEST NO-BQ EXTRA-CODE ALL-TEMPS-LIST MIM-OBL TMP-OBL DEATH HAIRY-ANALYSIS DEBUG-COMPILE CODE-START CODE-PTR FCNS TMPS IDT STYPES PLUSINF MINUSINF IPUT TEMPV DEBUGSW INSTRUCTION INTH FCN SNODES SNODES1 PSTACK DUMMY-MAPF INCONSISTENCY SEGS SPEC CODVEC QUOTE-CODE ADECL-CODE CALL-CODE APPLY-CODE RETURN-CODE IPUT-CODE SEG-CODE MULTI-RETURN-CODE PREDV SYM-SLOT STK STKTMP STK-CHARS7 STK-CHARS8 BINDING-LENGTH PARENT TYPE-INFO PROG-VARS CURRENT-TYPE NODE1 PUTR-CODE ISUBR-CODE EOF-CODE IREMAS-CODE GVAL-CODE SPARE4-CODE ADDVAR FSET-CODE OFFPTR PROG-CODE COMP-TYPES NODE-NAME AGND REQARGS DECL-SYM PUT-CODE FLVAL-CODE SETG-CODE BACK-CODE PUT-SAME-CODE RSUBR-DECLS NODEF AND-CODE MT-CODE BITS-CODE FPUTBITS-CODE COPY-LIST-CODE SPARE1-CODE ATAG ASSUM PURE-SYM NUM-SYM KID GNAME-SYM CHTYPE-CODE NODE SYMTAB GDECL-SYM MAP-CODE MARGS-CODE DATVAL NODE-SUBR LIVE-VARS SPEC-SYM AS-NXT-CODE SUBSTRUC-CODE BIT-TEST-CODE SPARE3-CODE NOT-CODE TEST-CODE MIN-MAX-CODE READ-EOF2-CODE KIDS PREDIC NODEPR NODEFM GNEXT-SYM FIX-CODE MFCN-CODE IRSUBR-CODE CASE-CODE SCL NODE-TYPE DEAD-VARS DEATH-LIST COMPOSIT-TYPE PRED COPY-CODE LENGTH?-CODE INIT-DECL-TYPE NODECOND FUNCTION-CODE AGAIN-CODE 0-TST-CODE FGETBITS-CODE MAPRET-STOP-CODE LSH-CODE SYMBOL NODEB SET-CODE ROT-CODE BINDING-STRUCTURE CDST VSPCD NAME-SYM INIT-SYM EQ-CODE ALL-REST-CODE DISPATCH DST RTAG ACCUM-TYPE DATUM ARGNUM-SYM ADDR-SYM USED-AT-ALL ARGNUM FGVAL-CODE ID-CODE FORM-F-CODE INFO-CODE TEMP CLAUSES TRG VARTBL LVARTBL SUBR-CODE LNTH-CODE ASSIGNED?-CODE GET2-CODE AS-IT-IND-VAL-CODE COMMON DATTYP RET-AGAIN-ONLY SEGMENT-CODE FSETG-CODE ISTRUC-CODE MFIRST-CODE CODE-SYM BST RSUBR-CODE 1?-CODE REST-CODE ABS-CODE MPSBR-CODE UNWIND-CODE PRINT-CODE OBLIST?-CODE STACKS ASS? BRANCH-CODE LVAL-CODE OR-CODE ISTRUC2-CODE READ-EOF-CODE MAPLEAVE-CODE MEMQ-CODE RESULT-TYPE SIDE-EFFECTS NEXT-SYM FORM-CODE TY?-CODE FLOAT-CODE GET-CODE SPECS-START RES-TYP BITL-CODE TOP-CODE SPARE2-CODE ACTIVATED TOTARGS VTB RQRG COND-CODE ARITH-CODE NTH-CODE MOD-CODE IND ALL NOTE WARNING PRIM-CODE CAREFUL REASONABLE DONT-CARE FLUSHED NO-RETURN NO-DATUM MESSAGE GROUP-NAME COMMON-TYPE COMMON-SYMTAB COMMON-ITEM COMMON-PRIMTYPE COMMON-DATUM COMMON-SYMT TRANSFORM TRANS N0? POPWR2 DEALLOCATE SRC-FLG BIN-FLG GLOSP ANALY-OK VERBOSE COMPILER INDARGL-ACT ARGL-IAUX ARGL-AUX ARGL-TUPLE ARGL-ARGS ARGL-QIOPT ARGL-IOPT ARGL-QOPT ARGL-OPT ARGL-CALL ARGL-BIND ARGL-QUOTE ARGL-ACT ARGL-ARG TAG-COUNT TEMP-NAME-SYM ARG-NAME-SYM ARGS-NEXT SPCS-X POP-STACK TOP-STACK TEMP-NAME TEMP-REFS TEMP-FRAME TEMP-ALLOC TEMP-NO-RECYCLE TEMP-TYPE FREE-TEMPS EVERY-TEMP MIM-SPECIAL MONAD-CODE GASSIGNED?-CODE GLN USAGE-SYM =?-STRING-CODE TYPE-C-CODE ANALYSIS VALID-CODE LIST-TUPLE FCN-ATOM STACK-CODE CHANNEL-OP-CODE RET-OR-AGAIN DONT-FLUSH-ME ATOM-PART-CODE OFFSET-PART-CODE PUT-GET-DECL-CODE THE-BOOL THE-BIT SPECD MULTI-SET-CODE MAX-LENGTH>
   5
   6 <SETG MAX-LENGTH 65535>
   7
   8 <MANIFEST MAX-LENGTH>
   9
  10 <GDECL (SNODES SNODES1) <UVECTOR [REST FIX]>>
  11
  12 <NEWTYPE STACK WORD>
  13
  14 <BLOCK (<ROOT>)>
  15
  16 <NEWTYPE I$TERMIN WORD>
  17
  18 <NEWTYPE ADECL VECTOR>
  19
  20 =
  21
  22 LBIND
  23
  24 <NEWTYPE T$UNBOUND WORD>
  25
  26 <ENDBLOCK>
  27
  28 <SETG DEATH <>>
  29
  30 <SETG BQ+1 <+ <ASCII !\`> 1>>
  31
  32 <COND (<OR <NOT <ASSIGNED? READ-TABLE>> <L? <LENGTH .READ-TABLE> ,BQ+1>> <COND (<==? <TYPEPRIM FIX> WORD> <SETG READ-TABLE <SET READ-TABLE <IVECTOR ,BQ+1 0>>>) (ELSE <SETG READ-TABLE <SET READ-TABLE <IVECTOR ,BQ+1 <>>>>)>)>
  33
  34 <SETG MIM-OBL <MOBLIST MIM-OBL>>
  35
  36 <SETG TMP-OBL <MOBLIST TMPS>>
  37
  38 <SETG MIM-OBL-L (,MIM-OBL)>
  39
  40 #WORD *17227751330*
  41                     <GFCN \1aBQ-RD ("VALUE" ANY ANY "OPTIONAL" ANY) X6 Y7>
  42                     <OPT-DISPATCH 1 %<> OPT4 OPT5>
  43 OPT4
  44                     <PUSH #T$UNBOUND 0>
  45 OPT5
  46                     <TEMP O8:LIST TEMP3:LBIND TEMP12 TEMP17:LBIND>
  47                     <INTGO>
  48                     <GEN-LVAL 'OBLIST = O8>
  49                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
  50                     <GVAL 'MIM-OBL-L = TEMP12>
  51                     <BBIND 'OBLIST 'ANY 'FIX TEMP12>
  52                     <DEAD TEMP12>
  53                     <FRAME '\1aREAD>
  54                     <CALL '\1aREAD 0 = X6>
  55                     <TYPE? X6 <TYPE-CODE ATOM> + PHRASE14 (DEAD-JUMP O8) (DEAD-FALL X6)>
  56                     <GETS 'BIND = TEMP17 (TYPE LBIND)>
  57                     <BBIND 'OBLIST 'ANY 'FIX O8>
  58                     <DEAD O8>
  59                     <FRAME '\1aERROR>
  60                     <PUSH 'BAD-BACK-Q-USAGE!-ERRORS>
  61                     <CALL '\1aERROR 1 = TEMP12>
  62                     <UNBIND TEMP17>
  63                     <DEAD TEMP17>
  64                     <ADJ -9>
  65                     <JUMP + PHRASE21>
  66 PHRASE14
  67                     <SET TEMP12 X6>
  68                     <DEAD X6>
  69 PHRASE21
  70                     <UNBIND TEMP3>
  71                     <DEAD TEMP3>
  72                     <ADJ -9>
  73                     <RETURN TEMP12>
  74                     <DEAD TEMP12>
  75                     <END \1aBQ-RD>
  76
  77 <COND (<AND <==? <TYPEPRIM FIX> WORD> <N==? <NTH .READ-TABLE ,BQ+1> 0>> <PUT .READ-TABLE ,BQ+1 ,BQ-RD>) (<AND <==? <TYPEPRIM FIX> FIX> <NOT <NTH .READ-TABLE ,BQ+1>>> <PUT .READ-TABLE ,BQ+1 [!\` <ASCII !\`> T ,BQ-RD <>]>)>
  78
  79 <SETG POP-STACK `STACK>
  80
  81 <SETG TOP-STACK `STACK>
  82
  83 <NEWTYPE FOOATOM ATOM>
  84
  85 <NEWTYPE FCN-ATOM ATOM>
  86
  87 <SETG OLD-ATOM <PRINTTYPE ATOM>>
  88
  89 <PRINTTYPE ATOM ,PRINT>
  90
  91 <PRINTTYPE FCN-ATOM>
  92
  93 <PRINTTYPE FOOATOM ATOM>
  94
  95 #WORD *27225372751*
  96                     <FCN \1aATOM-PRINT ("VALUE" ANY ANY) X4>
  97                     <TEMP TEMP3:LBIND TEMP6 TEMP9 TEMP47>
  98                     <INTGO>
  99                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
 100                     <CFRAME = TEMP6 (TYPE FRAME)>
 101                     <BBIND 'ACT 'ANY 'FIX TEMP6>
 102                     <DEAD TEMP6>
 103                     <ACTIVATION>
 104                     <NTHR X4 4 = TEMP6 (RECORD-TYPE ATOM)>
 105                     <GVAL 'MIM-OBL = TEMP9>
 106                     <EQUAL? TEMP6 TEMP9 - PHRASE8>
 107                     <DEAD TEMP6 TEMP9>
 108                     <GEN-ASSIGNED? 'NO-BQ - BOOL12>
 109                     <GEN-LVAL 'NO-BQ = TEMP6>
 110                     <TYPE? TEMP6 <TYPE-CODE FALSE> - PEEP68>
 111                     <DEAD TEMP6>
 112 BOOL12
 113                     <FRAME '\1aPRINC>
 114                     <PUSH "`">
 115                     <GEN-LVAL 'OUTCHAN = STACK>
 116                     <CALL '\1aPRINC 2>
 117                     <JUMP + PEEP68>
 118 PHRASE8
 119                     <NTHR X4 4 = TEMP6 (RECORD-TYPE ATOM)>
 120                     <GVAL 'TMP-OBL = TEMP9>
 121                     <EQUAL? TEMP6 TEMP9 - PHRASE24>
 122                     <DEAD TEMP6 TEMP9>
 123 PEEP68
 124                     <FRAME '\1aPRINC>
 125                     <NTHR X4 3 = STACK (RECORD-TYPE ATOM)>
 126                     <JUMP + PEEP65>
 127 PHRASE24
 128                     <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
 129                     <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE LBIND)>
 130                     <CHTYPE TEMP6 <TYPE-CODE FRAME> = TEMP6>
 131                     <NTHR 'ACT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
 132                     <PUTR TEMP9 1 TEMP6 (RECORD-TYPE LBIND)>
 133                     <DEAD TEMP9 TEMP6>
 134                     <LOOP>
 135 AGAIN37
 136                     <INTGO>
 137                     <FRAME '\1aFUNCT>
 138                     <NTHR 'ACT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
 139                     <NTHR TEMP9 1 = STACK (RECORD-TYPE LBIND)>
 140                     <DEAD TEMP9>
 141                     <CALL '\1aFUNCT 1 = TEMP9>
 142                     <SET TEMP6 [PRINT PPRINT PRIN1 TOPLEV PRINT-MANY FLATSIZE UNPARSE] (TYPE VECTOR)>
 143                     <LOOP (TEMP9 VALUE) (TEMP6 LENGTH VALUE)>
 144 TAG41
 145                     <NTHUV TEMP6 1 = TEMP47>
 146                     <VEQUAL? TEMP47 TEMP9 + TAG40 (DEAD-JUMP TEMP9 TEMP6)>
 147                     <DEAD TEMP47>
 148                     <RESTUV TEMP6 1 = TEMP6 (TYPE VECTOR)>
 149                     <EMPUV? TEMP6 - TAG41 (DEAD-FALL TEMP9 TEMP6)>
 150                     <JUMP + PHRASE39>
 151 TAG40
 152                     <FRAME '\1aPRIN1>
 153                     <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
 154                     <GEN-LVAL 'OUTCHAN = STACK>
 155                     <CALL '\1aPRIN1 2 = TEMP6 (DEAD-FALL X4)>
 156                     <JUMP + PHRASE58>
 157 PHRASE39
 158                     <FRAME '\1aFUNCT>
 159                     <NTHR 'ACT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
 160                     <NTHR TEMP9 1 = STACK (RECORD-TYPE LBIND)>
 161                     <DEAD TEMP9>
 162                     <CALL '\1aFUNCT 1 = TEMP9>
 163                     <VEQUAL? TEMP9 'PRINC - PHRASE51>
 164                     <DEAD TEMP9>
 165                     <FRAME '\1aPRINC>
 166                     <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
 167 PEEP65
 168                     <GEN-LVAL 'OUTCHAN = STACK>
 169                     <CALL '\1aPRINC 2 = TEMP6 (DEAD-FALL X4)>
 170                     <JUMP + PHRASE58>
 171 PHRASE51
 172                     <FRAME '\1aFRAME>
 173                     <NTHR 'ACT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 174                     <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
 175                     <DEAD TEMP47>
 176                     <CALL '\1aFRAME 1 = TEMP47>
 177                     <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
 178                     <PUTR TEMP6 1 TEMP47 (RECORD-TYPE LBIND)>
 179                     <DEAD TEMP6 TEMP47>
 180                     <JUMP + AGAIN37>
 181 PHRASE58
 182                     <UNBIND TEMP3>
 183                     <DEAD TEMP3>
 184                     <ADJ -9>
 185                     <RETURN TEMP6>
 186                     <DEAD TEMP6>
 187                     <END \1aATOM-PRINT>
 188
 189 #WORD *16134143374*
 190                     <FCN \1aFCN-ATOM-PRINT ("VALUE" ANY ANY) X4>
 191                     <TEMP TEMP3:LBIND TEMP6 TEMP18 TEMP31>
 192                     <INTGO>
 193                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
 194                     <CFRAME = TEMP6 (TYPE FRAME)>
 195                     <BBIND 'ACT 'ANY 'FIX TEMP6>
 196                     <DEAD TEMP6>
 197                     <ACTIVATION>
 198                     <NTHR 'CTLZ-PRINT 1 = TEMP6 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE8) (DEAD-JUMP TEMP6)>
 199                     <TYPE? TEMP6 <TYPE-CODE FALSE> + PHRASE8 (DEAD-JUMP TEMP6)>
 200                     <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE GBIND)>
 201                     <TYPE? TEMP6 <TYPE-CODE UNBOUND> + PHRASE8>
 202                     <DEAD TEMP6>
 203                     <GVAL 'CTLZ-PRINT = TEMP6>
 204                     <TYPE? TEMP6 <TYPE-CODE FALSE> + PHRASE8>
 205                     <DEAD TEMP6>
 206                     <FRAME '\1aPRINC>
 207                     <PUSH !\\1a>
 208                     <GEN-LVAL 'OUTCHAN = STACK>
 209                     <CALL '\1aPRINC 2>
 210 PHRASE8
 211                     <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
 212                     <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE LBIND)>
 213                     <CHTYPE TEMP6 <TYPE-CODE FRAME> = TEMP6>
 214                     <NTHR 'ACT 2 = TEMP18 (RECORD-TYPE ATOM) (TYPE LBIND)>
 215                     <PUTR TEMP18 1 TEMP6 (RECORD-TYPE LBIND)>
 216                     <DEAD TEMP18 TEMP6>
 217                     <LOOP>
 218 AGAIN20
 219                     <INTGO>
 220                     <FRAME '\1aFUNCT>
 221                     <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
 222                     <NTHR TEMP6 1 = STACK (RECORD-TYPE LBIND)>
 223                     <DEAD TEMP6>
 224                     <CALL '\1aFUNCT 1 = TEMP6>
 225                     <SET TEMP18 [PRINT PPRINT PRIN1 TOPLEVEL FLATSIZE UNPARSE] (TYPE VECTOR)>
 226                     <LOOP (TEMP6 VALUE) (TEMP18 LENGTH VALUE)>
 227 TAG24
 228                     <NTHUV TEMP18 1 = TEMP31>
 229                     <VEQUAL? TEMP31 TEMP6 + TAG23 (DEAD-JUMP TEMP18 TEMP6)>
 230                     <DEAD TEMP31>
 231                     <RESTUV TEMP18 1 = TEMP18 (TYPE VECTOR)>
 232                     <EMPUV? TEMP18 - TAG24 (DEAD-FALL TEMP18 TEMP6)>
 233                     <JUMP + PHRASE22>
 234 TAG23
 235                     <FRAME '\1aPRIN1>
 236                     <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
 237                     <GEN-LVAL 'OUTCHAN = STACK>
 238                     <CALL '\1aPRIN1 2 = TEMP6 (DEAD-FALL X4)>
 239                     <JUMP + PHRASE42>
 240 PHRASE22
 241                     <FRAME '\1aFUNCT>
 242                     <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
 243                     <NTHR TEMP6 1 = STACK (RECORD-TYPE LBIND)>
 244                     <DEAD TEMP6>
 245                     <CALL '\1aFUNCT 1 = TEMP6>
 246                     <VEQUAL? TEMP6 'PRINC - PHRASE35>
 247                     <DEAD TEMP6>
 248                     <FRAME '\1aPRINC>
 249                     <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
 250                     <GEN-LVAL 'OUTCHAN = STACK>
 251                     <CALL '\1aPRINC 2 = TEMP6 (DEAD-FALL X4)>
 252                     <JUMP + PHRASE42>
 253 PHRASE35
 254                     <FRAME '\1aFRAME>
 255                     <NTHR 'ACT 2 = TEMP31 (RECORD-TYPE ATOM) (TYPE LBIND)>
 256                     <NTHR TEMP31 1 = STACK (RECORD-TYPE LBIND)>
 257                     <DEAD TEMP31>
 258                     <CALL '\1aFRAME 1 = TEMP31>
 259                     <NTHR 'ACT 2 = TEMP18 (RECORD-TYPE ATOM) (TYPE LBIND)>
 260                     <PUTR TEMP18 1 TEMP31 (RECORD-TYPE LBIND)>
 261                     <DEAD TEMP18 TEMP31>
 262                     <JUMP + AGAIN20>
 263 PHRASE42
 264                     <UNBIND TEMP3>
 265                     <DEAD TEMP3>
 266                     <ADJ -9>
 267                     <RETURN TEMP6>
 268                     <DEAD TEMP6>
 269                     <END \1aFCN-ATOM-PRINT>
 270
 271 <COND (<==? ,OLD-ATOM ATOM> <PRINTTYPE ATOM ,ATOM-PRINT> <PRINTTYPE FCN-ATOM ,FCN-ATOM-PRINT>)>
 272
 273 <PRINTTYPE STACK <FUNCTION (X) <PRINC "#STACK "> <PRIN1 <CHTYPE .X FIX>>>>
 274
 275 <SETG PLUSINF <CHTYPE <MIN> FIX>>
 276
 277 <SETG MINUSINF <CHTYPE <MAX> FIX>>
 278
 279 "Type specification for NODE."
 280
 281 <NEWTYPE NODE VECTOR '<<PRIMTYPE VECTOR> FIX ANY ANY ANY <LIST [REST NODE]> <OR FALSE ATOM> [OPTIONAL LIST ANY ANY LIST SYMTAB <OR FALSE ATOM> ANY ANY ANY ANY ANY LIST <OR FALSE LIST> FIX FIX]>>
 282
 283 "Offsets into pass 1 structure entities and functions to create same."
 284
 285 <SETG NODE-TYPE <OFFSET 1 NODE>>
 286
 287 <SETG PARENT <OFFSET 2 NODE>>
 288
 289 <SETG RESULT-TYPE <OFFSET 3 NODE>>
 290
 291 <SETG NODE-NAME <OFFSET 4 NODE>>
 292
 293 <SETG KIDS <OFFSET 5 NODE>>
 294
 295 <SETG SEGS <OFFSET 6 NODE>>
 296
 297 <SETG TYPE-INFO <OFFSET 7 NODE>>
 298
 299 <SETG SIDE-EFFECTS <OFFSET 8 NODE>>
 300
 301 <SETG RSUBR-DECLS <OFFSET 9 NODE>>
 302
 303 <SETG BINDING-STRUCTURE <OFFSET 10 NODE>>
 304
 305 <SETG SYMTAB <OFFSET 11 NODE>>
 306
 307 <SETG ACTIVATED <OFFSET 12 NODE>>
 308
 309 <SETG SPCS-X <OFFSET 13 NODE>>
 310
 311 <SETG DST <OFFSET 14 NODE>>
 312
 313 <SETG CDST <OFFSET 15 NODE>>
 314
 315 <SETG ATAG <OFFSET 16 NODE>>
 316
 317 <SETG RTAG <OFFSET 17 NODE>>
 318
 319 <SETG ASSUM <OFFSET 18 NODE>>
 320
 321 <SETG AGND <OFFSET 19 NODE>>
 322
 323 <SETG TOTARGS <OFFSET 20 NODE>>
 324
 325 <SETG REQARGS <OFFSET 21 NODE>>
 326
 327 <SETG CLAUSES <OFFSET <1 ,KIDS> NODE>>
 328
 329 <SETG NODE-SUBR <OFFSET <1 ,RSUBR-DECLS> NODE>>
 330
 331 <SETG PREDIC <OFFSET <1 ,NODE-NAME> NODE>>
 332
 333 <SETG ACCUM-TYPE <OFFSET <1 ,DST> NODE>>
 334
 335 <SETG DEAD-VARS <OFFSET <1 ,CDST> NODE>>
 336
 337 <SETG LIVE-VARS <OFFSET <1 ,TYPE-INFO> NODE>>
 338
 339 <SETG VSPCD <OFFSET <1 ,ATAG> NODE>>
 340
 341 <SETG INIT-DECL-TYPE <OFFSET <1 ,RTAG> NODE>>
 342
 343 "       Definitions associated with compiler symbol tables."
 344
 345 "Offsets for variable description blocks"
 346
 347 <NEWTYPE TEMP VECTOR '!<<PRIMTYPE VECTOR> ATOM FIX ANY <OR ATOM FALSE> ANY ANY>>
 348
 349 <NEWTYPE SYMTAB VECTOR '<<PRIMTYPE VECTOR> <PRIMTYPE VECTOR> ATOM <OR FALSE ATOM> FIX <OR ATOM FIX> <OR FALSE ATOM> <OR ATOM SEGMENT FORM> ANY ANY ANY <OR FALSE NODE> <OR FALSE 'T> FIX <OR FALSE 'T> <OR FALSE 'T> LIST ANY ANY ANY>>
 350
 351 <SETG NEXT-SYM <OFFSET 1 SYMTAB>>
 352
 353 <SETG NAME-SYM <OFFSET 2 SYMTAB>>
 354
 355 <SETG SPEC-SYM <OFFSET 3 SYMTAB>>
 356
 357 <SETG CODE-SYM <OFFSET 4 SYMTAB>>
 358
 359 <SETG ARGNUM-SYM <OFFSET 5 SYMTAB>>
 360
 361 <SETG PURE-SYM <OFFSET 6 SYMTAB>>
 362
 363 <SETG DECL-SYM <OFFSET 7 SYMTAB>>
 364
 365 <SETG ADDR-SYM <OFFSET 8 SYMTAB>>
 366
 367 <SETG INIT-SYM <OFFSET 9 SYMTAB>>
 368
 369 <SETG TEMP-NAME-SYM <OFFSET 10 SYMTAB>>
 370
 371 <SETG RET-AGAIN-ONLY <OFFSET 11 SYMTAB>>
 372
 373 <SETG ASS? <OFFSET 12 SYMTAB>>
 374
 375 <SETG USAGE-SYM <OFFSET 13 SYMTAB>>
 376
 377 '<SETG STORED <OFFSET 14 SYMTAB>>
 378
 379 <SETG USED-AT-ALL <OFFSET 15 SYMTAB>>
 380
 381 <SETG DEATH-LIST <OFFSET 16 SYMTAB>>
 382
 383 <SETG CURRENT-TYPE <OFFSET 17 SYMTAB>>
 384
 385 <SETG COMPOSIT-TYPE <OFFSET 18 SYMTAB>>
 386
 387 <SETG ARG-NAME-SYM <OFFSET 19 SYMTAB>>
 388
 389 "How a variable is used in a loop."
 390
 391 #WORD *15631065707*
 392                     <GFCN \1aNODE1 ("VALUE" NODE ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8>
 393                     <TEMP TEMP10>
 394                     <INTGO>
 395                     <PUSH TYP4>
 396                     <DEAD TYP4>
 397                     <PUSH PAR5>
 398                     <DEAD PAR5>
 399                     <PUSH RES-TYP6>
 400                     <DEAD RES-TYP6>
 401                     <PUSH NAME7>
 402                     <DEAD NAME7>
 403                     <PUSH KID8>
 404                     <DEAD KID8>
 405                     <PUSH %<>>
 406                     <UBLOCK <TYPE-CODE VECTOR> 6 = TEMP10>
 407                     <CHTYPE TEMP10 <TYPE-CODE NODE> = TEMP10>
 408                     <RETURN TEMP10>
 409                     <DEAD TEMP10>
 410                     <END \1aNODE1>
 411
 412 "Create a function node with all its hair."
 413
 414 #WORD *23371000733*
 415                     <GFCN \1aNODEF ("VALUE" NODE ANY ANY ANY ANY ANY ANY ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8 RSD9 BST10 HAT11 VTB12 TRG13 RQRG14>
 416                     <TEMP TEMP16>
 417                     <INTGO>
 418                     <PUSH TYP4>
 419                     <DEAD TYP4>
 420                     <PUSH PAR5>
 421                     <DEAD PAR5>
 422                     <PUSH RES-TYP6>
 423                     <PUSH NAME7>
 424                     <DEAD NAME7>
 425                     <PUSH KID8>
 426                     <DEAD KID8>
 427                     <PUSH %<>>
 428                     <PUSH ()>
 429                     <PUSH %<>>
 430                     <PUSH RSD9>
 431                     <DEAD RSD9>
 432                     <PUSH BST10>
 433                     <DEAD BST10>
 434                     <PUSH VTB12>
 435                     <DEAD VTB12>
 436                     <PUSH %<>>
 437                     <PUSH %<>>
 438                     <PUSH %<>>
 439                     <PUSH ()>
 440                     <PUSH %<>>
 441                     <PUSH RES-TYP6>
 442                     <DEAD RES-TYP6>
 443                     <PUSH ()>
 444                     <PUSH %<>>
 445                     <PUSH TRG13>
 446                     <DEAD TRG13>
 447                     <PUSH RQRG14>
 448                     <DEAD RQRG14>
 449                     <UBLOCK <TYPE-CODE VECTOR> 21 = TEMP16>
 450                     <CHTYPE TEMP16 <TYPE-CODE NODE> = TEMP16>
 451                     <RETURN TEMP16>
 452                     <DEAD TEMP16>
 453                     <END \1aNODEF>
 454
 455 "Create a PROG/REPEAT node with nearly as much hair."
 456
 457 #WORD *11135071643*
 458                     <GFCN \1aNODEPR ("VALUE" NODE ANY ANY ANY ANY ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8 VL9 BST10 HAT11 VTB12>
 459                     <TEMP TEMP14>
 460                     <INTGO>
 461                     <PUSH TYP4>
 462                     <DEAD TYP4>
 463                     <PUSH PAR5>
 464                     <DEAD PAR5>
 465                     <PUSH RES-TYP6>
 466                     <PUSH NAME7>
 467                     <DEAD NAME7>
 468                     <PUSH KID8>
 469                     <DEAD KID8>
 470                     <PUSH %<>>
 471                     <PUSH ()>
 472                     <PUSH %<>>
 473                     <PUSH VL9>
 474                     <DEAD VL9>
 475                     <PUSH BST10>
 476                     <DEAD BST10>
 477                     <PUSH VTB12>
 478                     <DEAD VTB12>
 479                     <PUSH %<>>
 480                     <PUSH %<>>
 481                     <PUSH %<>>
 482                     <PUSH ()>
 483                     <PUSH %<>>
 484                     <PUSH RES-TYP6>
 485                     <DEAD RES-TYP6>
 486                     <PUSH ()>
 487                     <PUSH %<>>
 488                     <UBLOCK <TYPE-CODE VECTOR> 19 = TEMP14>
 489                     <CHTYPE TEMP14 <TYPE-CODE NODE> = TEMP14>
 490                     <RETURN TEMP14>
 491                     <DEAD TEMP14>
 492                     <END \1aNODEPR>
 493
 494 "Create a COND node."
 495
 496 #WORD *11170042227*
 497                     <GFCN \1aNODECOND ("VALUE" NODE ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 CLAU8>
 498                     <TEMP TEMP10>
 499                     <INTGO>
 500                     <PUSH TYP4>
 501                     <DEAD TYP4>
 502                     <PUSH PAR5>
 503                     <DEAD PAR5>
 504                     <PUSH RES-TYP6>
 505                     <DEAD RES-TYP6>
 506                     <PUSH NAME7>
 507                     <DEAD NAME7>
 508                     <PUSH CLAU8>
 509                     <DEAD CLAU8>
 510                     <PUSH %<>>
 511                     <PUSH ()>
 512                     <PUSH %<>>
 513                     <UBLOCK <TYPE-CODE VECTOR> 8 = TEMP10>
 514                     <CHTYPE TEMP10 <TYPE-CODE NODE> = TEMP10>
 515                     <RETURN TEMP10>
 516                     <DEAD TEMP10>
 517                     <END \1aNODECOND>
 518
 519 "Create a node for a COND clause."
 520
 521 #WORD *11751756122*
 522                     <GFCN \1aNODEB ("VALUE" NODE ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 PRED7 CLAU8>
 523                     <TEMP TEMP10>
 524                     <INTGO>
 525                     <PUSH TYP4>
 526                     <DEAD TYP4>
 527                     <PUSH PAR5>
 528                     <DEAD PAR5>
 529                     <PUSH RES-TYP6>
 530                     <DEAD RES-TYP6>
 531                     <PUSH PRED7>
 532                     <DEAD PRED7>
 533                     <PUSH CLAU8>
 534                     <DEAD CLAU8>
 535                     <PUSH %<>>
 536                     <PUSH ()>
 537                     <PUSH %<>>
 538                     <UBLOCK <TYPE-CODE VECTOR> 8 = TEMP10>
 539                     <CHTYPE TEMP10 <TYPE-CODE NODE> = TEMP10>
 540                     <RETURN TEMP10>
 541                     <DEAD TEMP10>
 542                     <END \1aNODEB>
 543
 544 "Create a node for a SUBR call etc."
 545
 546 #WORD *33557455354*
 547                     <GFCN \1aNODEFM ("VALUE" NODE ANY ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8 SUB9>
 548                     <TEMP TEMP11>
 549                     <INTGO>
 550                     <PUSH TYP4>
 551                     <DEAD TYP4>
 552                     <PUSH PAR5>
 553                     <DEAD PAR5>
 554                     <PUSH RES-TYP6>
 555                     <DEAD RES-TYP6>
 556                     <PUSH NAME7>
 557                     <DEAD NAME7>
 558                     <PUSH KID8>
 559                     <DEAD KID8>
 560                     <PUSH %<>>
 561                     <PUSH ()>
 562                     <PUSH %<>>
 563                     <PUSH SUB9>
 564                     <DEAD SUB9>
 565                     <UBLOCK <TYPE-CODE VECTOR> 9 = TEMP11>
 566                     <CHTYPE TEMP11 <TYPE-CODE NODE> = TEMP11>
 567                     <RETURN TEMP11>
 568                     <DEAD TEMP11>
 569                     <END \1aNODEFM>
 570
 571 #WORD *30012051121*
 572                     <GFCN \1aADDVAR ("VALUE" SYMTAB ANY ANY ANY ANY ANY ANY ANY ANY) NAM4 SPEC5 CODE6 ARGNUM7 PURE8 DCL9 ADDR10 INIT11>
 573                     <TEMP TEMP13>
 574                     <INTGO>
 575                     <GEN-LVAL 'VARTBL = STACK>
 576                     <PUSH NAM4>
 577                     <PUSH SPEC5>
 578                     <DEAD SPEC5>
 579                     <PUSH CODE6>
 580                     <DEAD CODE6>
 581                     <PUSH ARGNUM7>
 582                     <DEAD ARGNUM7>
 583                     <PUSH PURE8>
 584                     <DEAD PURE8>
 585                     <PUSH DCL9>
 586                     <DEAD DCL9>
 587                     <PUSH ADDR10>
 588                     <DEAD ADDR10>
 589                     <PUSH INIT11>
 590                     <DEAD INIT11>
 591                     <PUSH NAM4>
 592                     <DEAD NAM4>
 593                     <PUSH %<>>
 594                     <PUSH %<>>
 595                     <PUSH 0>
 596                     <PUSH 'T>
 597                     <PUSH %<>>
 598                     <PUSH ()>
 599                     <PUSH %<>>
 600                     <PUSH 'ANY>
 601                     <PUSH 'FOO!-IPASS1!-PASS1!-PACKAGE>
 602                     <UBLOCK <TYPE-CODE VECTOR> 19 = TEMP13>
 603                     <CHTYPE TEMP13 <TYPE-CODE SYMTAB> = TEMP13>
 604                     <GEN-SET 'VARTBL TEMP13>
 605                     <RETURN TEMP13>
 606                     <DEAD TEMP13>
 607                     <END \1aADDVAR>
 608
 609 "Some specialized decl stuff."
 610
 611 <SETG LVARTBL <PROG ((VARTBL [])) #DECL ((VARTBL) <SPECIAL ANY>) <ADDVAR OBLIST T -1 0 T <OR LIST OBLIST> <> <>> <ADDVAR OUTCHAN T -1 0 T CHANNEL <> <>> <ADDVAR INCHAN T -1 0 T CHANNEL <> <>> .VARTBL>>
 612
 613 <COND (<NOT ,MIM> <PUTPROP CHANNEL DECL '<CHANNEL FIX [11 ANY] [5 FIX]>>)>
 614
 615 <COND (,MIM <PUT-DECL STRING '<<PRIMTYPE STRING> [REST CHARACTER]>>) (ELSE <PUTPROP STRING DECL '<<PRIMTYPE STRING> [REST CHARACTER]>>)>
 616
 617 "Codes for the node types in the tree built by pass1 and modified by
 618 other passes."
 619
 620 "Give symbolic codes arbitrary increasing values."
 621
 622 <PROG ((N 1)) <SETG CODVEC <MAPF ,VECTOR <FUNCTION (ATM) <SETG .ATM .N> <SET N <+ .N 1>> .ATM> '[FUNCTION-CODE QUOTE-CODE SEGMENT-CODE FORM-CODE PROG-CODE SUBR-CODE COND-CODE BRANCH-CODE RSUBR-CODE LVAL-CODE SET-CODE OR-CODE AND-CODE RETURN-CODE COPY-CODE GO-CODE AGAIN-CODE ARITH-CODE 0-TST-CODE NOT-CODE 1?-CODE TEST-CODE EQ-CODE TY?-CODE LNTH-CODE MT-CODE NTH-CODE REST-CODE PUT-CODE PUTR-CODE FLVAL-CODE FSET-CODE FGVAL-CODE FSETG-CODE MIN-MAX-CODE STACKFORM-CODE CHTYPE-CODE ABS-CODE FIX-CODE FLOAT-CODE MOD-CODE ID-CODE ASSIGNED?-CODE ISTRUC-CODE ISTRUC2-CODE BITS-CODE BITL-CODE FGETBITS-CODE FPUTBITS-CODE MAP-CODE MFCN-CODE ISUBR-CODE READ-EOF-CODE READ-EOF2-CODE EOF-CODE GET-CODE GET2-CODE IPUT-CODE IREMAS-CODE IRSUBR-CODE MARGS-CODE MPSBR-CODE MAPLEAVE-CODE MAPRET-STOP-CODE UNWIND-CODE GVAL-CODE SETG-CODE SEG-CODE LENGTH?-CODE TAG-CODE MFIRST-CODE PRINT-CODE MEMQ-CODE FORM-F-CODE INFO-CODE OBLIST?-CODE AS-NXT-CODE AS-IT-IND-VAL-CODE ALL-REST-CODE CASE-CODE SUBSTRUC-CODE BACK-CODE TOP-CODE COPY-LIST-CODE PUT-SAME-CODE ROT-CODE LSH-CODE BIT-TEST-CODE ADECL-CODE CALL-CODE MONAD-CODE GASSIGNED?-CODE APPLY-CODE MULTI-RETURN-CODE =?-STRING-CODE TYPE-C-CODE VALID-CODE STACK-CODE CHANNEL-OP-CODE ATOM-PART-CODE OFFSET-PART-CODE PUT-GET-DECL-CODE MULTI-SET-CODE SPARE1-CODE SPARE2-CODE SPARE3-CODE SPARE4-CODE]>> <SETG COMP-TYPES .N>>
 623
 624 <USE "NPRINT">
 625
 626 "Build a dispatch table based on node types."
 627
 628 #WORD *15575416236*
 629                     <GFCN \1aDISPATCH ("VALUE" VECTOR ANY "TUPLE" <<PRIMTYPE VECTOR> [REST <LIST FIX ANY>]>) DEFAULT4>
 630                     <MAKTUP PAIRS5 TEMP7 TT6:VECTOR TEMP16:FIX = PAIRS5>
 631                     <INTGO>
 632                     <UUBLOCK <TYPE-CODE VECTOR> 108 = TT6>
 633                     <SET TEMP7 TT6>
 634                     <LOOP (TEMP7 VALUE LENGTH) (DEFAULT4 TYPE VALUE LENGTH)>
 635 ISTR8
 636                     <EMPUV? TEMP7 + ISTRE9 (DEAD-JUMP DEFAULT4 TEMP7)>
 637                     <PUTUV TEMP7 1 DEFAULT4>
 638                     <RESTUV TEMP7 1 = TEMP7>
 639                     <JUMP + ISTR8>
 640 ISTRE9
 641                     <LOOP>
 642 AGAIN13
 643                     <INTGO>
 644                     <EMPUV? PAIRS5 - PHRASE15 (DEAD-FALL PAIRS5)>
 645                     <RETURN TT6>
 646                     <DEAD TT6>
 647 PHRASE15
 648                     <NTHUV PAIRS5 1 = TEMP7 (TYPE LIST)>
 649                     <NTHL TEMP7 1 = TEMP16 (TYPE FIX)>
 650                     <RESTL TEMP7 1 = TEMP7 (TYPE LIST)>
 651                     <NTHL TEMP7 1 = TEMP7>
 652                     <PUTUV TT6 TEMP16 TEMP7>
 653                     <DEAD TEMP16 TEMP7>
 654                     <RESTUV PAIRS5 1 = PAIRS5 (TYPE VECTOR)>
 655                     <CHTYPE PAIRS5 <TYPE-CODE VECTOR> = PAIRS5>
 656                     <JUMP + AGAIN13>
 657                     <END \1aDISPATCH>
 658
 659 <SETG PREDV <IUVECTOR ,COMP-TYPES 0>>
 660
 661 <GDECL (PREDV) UVECTOR>
 662
 663 <MAPF <> <FUNCTION (N) <PUT ,PREDV .N 1>> [,0-TST-CODE ,1?-CODE ,NOT-CODE ,TEST-CODE ,EQ-CODE ,TY?-CODE ,MT-CODE ,ASSIGNED?-CODE ,MEMQ-CODE ,LENGTH?-CODE ,OBLIST?-CODE ,AS-NXT-CODE ,BIT-TEST-CODE ,GASSIGNED?-CODE ,VALID-CODE ,=?-STRING-CODE]>
 664
 665 <MAPF <> <FUNCTION (N) <PUT ,PREDV .N -1>> [,OR-CODE ,AND-CODE ,COND-CODE]>
 666
 667 "Predicate:  does this type have special predicate code?"
 668
 669 " Assign codes to differen types of argument in argument list"
 670
 671 <PROG ((N 1)) <MAPF <> <FUNCTION (TYP) <SETG .TYP .N> <MANIFEST .TYP> <SET N <+ .N 1>>> '(ARGL-ACT ARGL-IAUX ARGL-AUX ARGL-TUPLE ARGL-ARGS ARGL-QIOPT ARGL-IOPT ARGL-QOPT ARGL-OPT ARGL-CALL ARGL-BIND ARGL-QUOTE ARGL-ARG)>>
 672
 673 <COND (,MIM <PUT-DECL REP-STATE '<LIST [5 <LIST [REST SYMTAB DATUM <OR FALSE ATOM> <OR ATOM FALSE>]>]>>) (ELSE <PUTPROP REP-STATE DECL '<LIST [5 <LIST [REST SYMTAB DATUM <OR FALSE ATOM> <OR ATOM FALSE>]>]>>)>
 674
 675 <COND (,MIM <PUT-DECL SYMBOL '<OR SYMTAB TEMP COMMON>>) (ELSE <PUTPROP SYMBOL DECL '<OR SYMTAB TEMP COMMON>>)>
 676
 677 <SETG DATTYP <OFFSET 1 DATUM>>
 678
 679 <SETG DATVAL <OFFSET 2 DATUM>>
 680
 681 <NEWTYPE DATUM LIST '<<PRIMTYPE LIST> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>>>
 682
 683 <NEWTYPE OFFPTR LIST '<<PRIMTYPE LIST> FIX DATUM ATOM>>
 684
 685 <MANIFEST DATTYP DATVAL>
 686
 687 <MAPF <> ,MANIFEST ,CODVEC>
 688
 689 <MANIFEST USAGE-SYM TOT-MODES RESTS RMODES COMP-TYPES GDECL-SYM GNAME-SYM GNEXT-SYM INIT-SYM ADDR-SYM TOTARGS REQARGS DECL-SYM PURE-SYM ARGNUM-SYM CODE-SYM SPEC-SYM NAME-SYM TEMP-NAME-SYM ARG-NAME-SYM NEXT-SYM PREDIC NODE-SUBR CLAUSES ACTIVATED SYMTAB BINDING-STRUCTURE RSUBR-DECLS SEGS KIDS NODE-NAME RESULT-TYPE PARENT NODE-TYPE SIDE-EFFECTS RET-AGAIN-ONLY ASS? DST CDST ACCUM-TYPE INIT-DECL-TYPE VSPCD AGND ASSUM RTAG ATAG SPCS-X USED-AT-ALL CURRENT-TYPE DEATH-LIST COMPOSIT-TYPE TYPE-INFO LIVE-VARS DEAD-VARS>
 690
 691 <NEWTYPE COMMON VECTOR '<<PRIMTYPE VECTOR> ATOM <OR COMMON SYMTAB> FIX ANY <PRIMTYPE LIST>>>
 692
 693 <SETG COMMON-TYPE <OFFSET 1 COMMON>>
 694
 695 "TYPE OF COMMON (ATOM)"
 696
 697 <SETG COMMON-SYMT <OFFSET 2 COMMON>>
 698
 699 "POINTER TO OR COMMON SYMTAB"
 700
 701 <SETG COMMON-ITEM <OFFSET 3 COMMON>>
 702
 703 "3RD ARGUMENT TO NTH,REST,PUT ETC."
 704
 705 <SETG COMMON-PRIMTYPE <OFFSET 4 COMMON>>
 706
 707 "PRIMTYPE OF OBJECT IN COMMON"
 708
 709 <SETG COMMON-DATUM <OFFSET 5 COMMON>>
 710
 711 "DATUM FOR THIS COMMON"
 712
 713 <MANIFEST COMMON-TYPE COMMON-SYMTAB COMMON-ITEM COMMON-PRIMTYPE COMMON-DATUM>
 714
 715 <NEWTYPE TRANS VECTOR '<<PRIMTYPE VECTOR> NODE <UVECTOR [7 FIX]> <UVECTOR [7 FIX]>>>
 716
 717 <NEWTYPE MIM-SPECIAL ATOM>
 718
 719 <SETG TEMP-NAME <OFFSET 1 TEMP>>
 720
 721 <SETG TEMP-REFS <OFFSET 2 TEMP>>
 722
 723 <SETG TEMP-FRAME <OFFSET 3 TEMP>>
 724
 725 <SETG TEMP-ALLOC <OFFSET 4 TEMP>>
 726
 727 <SETG TEMP-NO-RECYCLE <OFFSET 5 TEMP>>
 728
 729 <SETG TEMP-TYPE <OFFSET 6 TEMP>>
 730
 731 <MANIFEST TEMP-NAME TEMP-REFS TEMP-FRAME TEMP-ALLOC TEMP-NO-RECYCLE TEMP-TYPE>
 732
 733 <COND (<N==? <TYPEPRIM FIX> FIX> <FLOAD "PS:<COMPIL>POPWR2.FBIN">)>
 734
 735 <SETG BINDING-LENGTH 9>
 736
 737 <MANIFEST BINDING-LENGTH>
 738
 739 <ENDPACKAGE>