mim/development/mim/mimc/pass1.mima

   1
   2 <PACKAGE "PASS1">
   3
   4 <ENTRY PASS1 PCOMP PMACRO PAPPLY-OBJECT PAPPLY-TYPE PTHIS-OBJECT PTHIS-TYPE GEN-D ACT-FIX FIND_DECL SEG? PSUBR-C>
   5
   6 <RENTRY REFERENCED>
   7
   8 <USE "GC-DUMP" "CHKDCL" "COMPDEC" "MIMGEN" "ADVMESS" "CDRIVE">
   9
  10 "       This file contains the first pass of the MUDDLE compiler.
  11 The functions therein take a MUDDLE function and build a more detailed
  12 model of it.  Each entity in the function is represented by an object
  13 of type NODE.  The entire function is represented by the functions node
  14 and it points to the rest of the nodes for the function."
  15
  16 "       Nodes vary in complexity and size depending on what they represent.
  17 A function or prog/repeat node is contains more information than a node
  18 for a quoted object.  All nodes have some fields in common to allow
  19 general programs to traverse the model."
  20
  21 "       The model built by PASS1 is used by the analyzer (SYMANA), the
  22 variable allocator (VARANA) and the code generator (CODGEN).  In some
  23 cases the analyzers and generators for certain classes of SUBRs are
  24 together in their own files (e.g.  CARITH, STRUCT, ISTRUC)."
  25
  26 "       This the top level program for PASS1.  It takes a function as
  27 input and returns the data structure representing the model."
  28
  29 <COND (<NOT ,MIM> <SETG PMAX ,NUMPRI!-MUDDLE>)>
  30
  31 <SETG MAX-DENSE 2>
  32
  33 <NEWTYPE ORQ LIST>
  34
  35 <COND (<NOT ,MIM> <FLOAD "PRCOD.NBIN">)>
  36
  37 #WORD *5563321353*
  38 <GFCN \1aPASS1 ("VALUE" NODE ATOM FUNCTION) FNAME4 FUNC5>
  39                     <TEMP (TEMP3 ()) TEMP16 (DCL8 #DECL ()) (ARGL9:LIST ()) (HATOM10 %<>) FCN12 TEMP47>
  40                     <INTGO>
  41                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
  42                     <BBIND 'FNAME 'ATOM %<> FNAME4>
  43                     <DEAD FNAME4>
  44                     <FIXBIND>
  45                     <BBIND 'RESULT 'NODE 'FIX>
  46                     <GVAL 'LVARTBL = TEMP16>
  47                     <BBIND 'VARTBL 'SYMTAB 'FIX TEMP16>
  48                     <DEAD TEMP16>
  49                     <SET FCN12 FUNC5>
  50                     <DEAD FUNC5>
  51                     <BBIND 'RQRG 'FIX 'FIX 0>
  52                     <BBIND 'TRG 'FIX 'FIX 0>
  53                     <EMPL? FCN12 - PHRASE18 (TYPE FUNCTION)>
  54                     <FRAME '\1aCOMPILE-ERROR>
  55                     <PUSH "Empty function:  ">
  56                     <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
  57                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
  58                     <DEAD TEMP16>
  59                     <CALL '\1aCOMPILE-ERROR 2>
  60 PHRASE18
  61                     <NTHL FCN12 1 = TEMP16>
  62                     <TYPE? TEMP16 <TYPE-CODE ATOM> + TAG24>
  63                     <TYPE? TEMP16 <TYPE-CODE ADECL> - PHRASE23>
  64                     <DEAD TEMP16>
  65 TAG24
  66                     <NTHL FCN12 1 = HATOM10>
  67                     <RESTL FCN12 1 = FCN12 (TYPE LIST)>
  68                     <CHTYPE FCN12 <TYPE-CODE LIST> = FCN12>
  69 PHRASE23
  70                     <EMPL? FCN12 - PHRASE26>
  71                     <FRAME '\1aCOMPILE-ERROR>
  72                     <PUSH "Empty function:  ">
  73                     <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
  74                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
  75                     <DEAD TEMP16>
  76                     <CALL '\1aCOMPILE-ERROR 2>
  77 PHRASE26
  78                     <NTHL FCN12 1 = ARGL9 (TYPE LIST)>
  79                     <RESTL FCN12 1 = FCN12 (TYPE LIST)>
  80                     <CHTYPE FCN12 <TYPE-CODE LIST> = FCN12>
  81                     <EMPL? FCN12 + PHRASE32 (TYPE LIST)>
  82                     <NTHL FCN12 1 = TEMP16>
  83                     <TYPE? TEMP16 <TYPE-CODE DECL> - PHRASE32>
  84                     <DEAD TEMP16>
  85                     <NTHL FCN12 1 = DCL8 (TYPE DECL)>
  86                     <RESTL FCN12 1 = FCN12 (TYPE LIST)>
  87 PHRASE32
  88                     <EMPL? FCN12 - PHRASE35 (TYPE LIST)>
  89                     <FRAME '\1aCOMPILE-ERROR>
  90                     <PUSH "Function has no body:  ">
  91                     <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
  92                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
  93                     <DEAD TEMP16>
  94                     <CALL '\1aCOMPILE-ERROR 2>
  95 PHRASE35
  96                     <FRAME '\1aNODEF>
  97                     <PUSH 1>
  98                     <PUSH ()>
  99                     <FRAME '\1aFIND_DECL>
 100                     <PUSH 'VALUE>
 101                     <PUSH DCL8>
 102                     <CALL '\1aFIND_DECL 2 = STACK>
 103                     <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 104                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
 105                     <DEAD TEMP16>
 106                     <PUSH ()>
 107                     <PUSH ()>
 108                     <PUSH ()>
 109                     <PUSH HATOM10>
 110                     <NTHR 'VARTBL 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 111                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
 112                     <DEAD TEMP16>
 113                     <PUSH 0>
 114                     <PUSH 0>
 115                     <CALL '\1aNODEF 11 = TEMP16>
 116                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 117                     <PUTR TEMP47 1 TEMP16 (RECORD-TYPE LBIND)>
 118                     <DEAD TEMP47 TEMP16>
 119                     <FRAME '\1aGEN-D>
 120                     <PUSH ARGL9>
 121                     <DEAD ARGL9>
 122                     <PUSH DCL8>
 123                     <DEAD DCL8>
 124                     <PUSH HATOM10>
 125                     <DEAD HATOM10>
 126                     <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 127                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
 128                     <DEAD TEMP16>
 129                     <CALL '\1aGEN-D 4>
 130                     <FRAME '\1aPUTPROP>
 131                     <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 132                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
 133                     <DEAD TEMP16>
 134                     <GEN-LVAL 'IND = STACK>
 135                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 136                     <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
 137                     <DEAD TEMP47>
 138                     <CALL '\1aPUTPROP 3>
 139                     <PUSH "VALUE">
 140                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 141                     <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
 142                     <NTHUV TEMP47 3 = STACK>
 143                     <DEAD TEMP47>
 144                     <SET DCL8 2 (TYPE FIX)>
 145                     <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 146                     <NTHR TEMP16 1 = TEMP16 (RECORD-TYPE LBIND)>
 147                     <NTHUV TEMP16 9 = TEMP47>
 148                     <DEAD TEMP16>
 149                     <TYPE TEMP47 = TEMP16>
 150                     <AND TEMP16 7 = TEMP16>
 151                     <VEQUAL? TEMP16 1 + TAG66>
 152                     <DEAD TEMP16>
 153                     <LOOP (TEMP47 TYPE VALUE LENGTH) (DCL8 VALUE)>
 154 TAG71
 155                     <INTGO>
 156                     <EMPTY? TEMP47 + TAG70>
 157                     <NTH1 TEMP47 = STACK>
 158                     <REST1 TEMP47 = TEMP47>
 159                     <ADD DCL8 1 = DCL8 (TYPE FIX)>
 160                     <JUMP + TAG71>
 161 TAG70
 162                     <LIST DCL8 = TEMP16 (TYPE LIST)>
 163                     <DEAD DCL8>
 164                     <JUMP + TAG67>
 165 TAG66
 166                     <LOOP>
 167 TAG69
 168                     <VEQUAL? DCL8 0 + TAG68>
 169                     <POP = TEMP16>
 170                     <CONS TEMP16 TEMP47 = TEMP47 (TYPE LIST)>
 171                     <DEAD TEMP16>
 172                     <SUB DCL8 1 = DCL8 (TYPE FIX)>
 173                     <JUMP + TAG69>
 174 TAG68
 175                     <SET TEMP16 TEMP47>
 176                     <DEAD TEMP47>
 177 TAG67
 178                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 179                     <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
 180                     <PUTUV TEMP47 9 TEMP16>
 181                     <DEAD TEMP47 TEMP16>
 182                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 183                     <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
 184                     <SET HATOM10 () (TYPE LIST)>
 185                     <SET DCL8 () (TYPE LIST)>
 186                     <SET TEMP16 FCN12 (TYPE LIST)>
 187                     <DEAD FCN12>
 188                     <LOOP>
 189 MAP77
 190                     <INTGO>
 191                     <EMPL? TEMP16 + MAPAP80>
 192                     <NTHL TEMP16 1 = FCN12>
 193                     <FRAME '\1aPCOMP>
 194                     <PUSH FCN12>
 195                     <DEAD FCN12>
 196                     <NTHR 'RESULT 2 = FCN12 (RECORD-TYPE ATOM) (TYPE LBIND)>
 197                     <NTHR FCN12 1 = STACK (RECORD-TYPE LBIND)>
 198                     <DEAD FCN12>
 199                     <CALL '\1aPCOMP 2 = FCN12>
 200                     <CONS FCN12 () = FCN12 (TYPE LIST)>
 201                     <EMPL? HATOM10 - TAG91>
 202                     <SET HATOM10 FCN12 (TYPE LIST)>
 203                     <JUMP + TAG92>
 204 TAG91
 205                     <PUTREST DCL8 FCN12>
 206                     <DEAD DCL8>
 207 TAG92
 208                     <SET DCL8 FCN12 (TYPE LIST)>
 209                     <DEAD FCN12>
 210                     <RESTL TEMP16 1 = TEMP16 (TYPE LIST)>
 211                     <JUMP + MAP77>
 212 MAPAP80
 213                     <PUTUV TEMP47 5 HATOM10 (TYPE LIST)>
 214                     <DEAD TEMP47 HATOM10>
 215                     <FRAME '\1aACT-FIX>
 216                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 217                     <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
 218                     <DEAD TEMP47>
 219                     <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 220                     <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
 221                     <NTHUV TEMP47 10 = STACK (TYPE LIST)>
 222                     <DEAD TEMP47>
 223                     <CALL '\1aACT-FIX 2>
 224                     <FRAME '\1aPUTPROP>
 225                     <NTHR 'FNAME 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
 226                     <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
 227                     <DEAD TEMP47>
 228                     <GEN-LVAL 'IND = STACK>
 229                     <CALL '\1aPUTPROP 2>
 230                     <FRAME '\1aPUTPROP>
 231                     <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 232                     <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
 233                     <DEAD TEMP16>
 234                     <PUSH 'RSUB-DEC>
 235                     <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 236                     <NTHR TEMP16 1 = TEMP16 (RECORD-TYPE LBIND)>
 237                     <NTHUV TEMP16 9 = STACK>
 238                     <DEAD TEMP16>
 239                     <CALL '\1aPUTPROP 3>
 240                     <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
 241                     <NTHR TEMP16 1 = TEMP16 (RECORD-TYPE LBIND)>
 242                     <UNBIND TEMP3>
 243                     <DEAD TEMP3>
 244                     <ADJ -45>
 245                     <RETURN TEMP16>
 246                     <DEAD TEMP16>
 247                     <END \1aPASS1>
 248 "Vector of legal strings in decl list."
 249
 250 <SETG TOT-MODES ["BIND" "CALL" "OPT" "OPTIONAL" "ARGS" "TUPLE" "AUX" "EXTRA" "ACT" "NAME" "DECL" "VALUE"]>
 251
 252 <PROG ((N <LENGTH ,TOT-MODES>)) <MAPF <> <FUNCTION (S "AUX" (ATM <PARSE <STRING "ACODE-" .S>>)) <SETG .ATM .N> <MANIFEST .ATM> <SET N <- .N 1>>> ,TOT-MODES> <SET N <+ <LENGTH ,TOT-MODES> 1>> <MAPF <> <FUNCTION (ATM) <SETG .ATM .N> <MANIFEST .ATM> <SET N <+ .N 1>>> '[ACODE-INIT ACODE-INIT1 ACODE-ERR ACODE-NORM]>>
 253
 254 "Amount to rest off decl vector after each encounter."
 255
 256 <SETG RESTS ![1 1 1 2 1 2 1 2 1 2 1 1!]>
 257
 258 "       This function (and others on this page) take an arg list and
 259 decls and parses them.
 260
 261         1) An RSUBR decl list.
 262
 263         2) A machine readable binding specification.
 264
 265 Atoms are also entered into the symbol table."
 266
 267 #WORD *17311645252*
 268 <GFCN \1aGEN-D ("VALUE" NODE LIST <PRIMTYPE LIST> ANY ANY) ARGL4 DCL5 HATOM6 FCNNOD7>
 269                     <TEMP TEMP3:LBIND TEMP22 RES_TOP9:LIST BNDL_TOP12:LIST TEMP25 (ST17 %<>) TEMP34 TIX14 TEMP53 TEMP66>
 270                     <INTGO>
 271                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
 272                     <BBIND 'DCL <PRIMTYPE LIST> %<> DCL5>
 273                     <DEAD DCL5>
 274                     <FIXBIND>
 275                     <GEN-LVAL 'VARTBL = TEMP22>
 276                     <CONS () () = RES_TOP9>
 277                     <BBIND 'RES_BOT 'LIST 'FIX RES_TOP9>
 278                     <BBIND 'ARGN 'FIX 'FIX 1>
 279                     <CONS () () = BNDL_TOP12>
 280                     <BBIND 'BNDL_BOT 'LIST 'FIX BNDL_TOP12>
 281                     <GVAL 'TOT-MODES = TEMP25>
 282                     <BBIND 'MODE <VECTOR [REST STRING]> 'FIX TEMP25>
 283                     <DEAD TEMP25>
 284                     <BBIND 'IX 'FIX 'FIX 13>
 285                     <LOOP>
 286 AGAIN27
 287                     <INTGO>
 288                     <EMPL? ARGL4 + EXIT26 (TYPE LIST)>
 289                     <NTHL ARGL4 1 = TEMP25>
 290                     <TYPE? TEMP25 <TYPE-CODE ATOM> + TAG32>
 291                     <TYPE? TEMP25 <TYPE-CODE FORM> + TAG32>
 292                     <TYPE? TEMP25 <TYPE-CODE LIST> + TAG32>
 293                     <TYPE? TEMP25 <TYPE-CODE ADECL> - PHRASE31>
 294 TAG32
 295                     <SET ST17 %<> (TYPE FALSE)>
 296                     <FRAME '\1aRUN-ARGER>
 297                     <NTHR 'IX 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
 298                     <NTHR TEMP34 1 = STACK (RECORD-TYPE LBIND)>
 299                     <DEAD TEMP34>
 300                     <PUSH TEMP25>
 301                     <DEAD TEMP25>
 302                     <PUSH FCNNOD7>
 303                     <CALL '\1aRUN-ARGER 3>
 304                     <JUMP + PHRASE69>
 305 PHRASE31
 306                     <TYPE? TEMP25 <TYPE-CODE STRING> - PHRASE37>
 307                     <TYPE? ST17 <TYPE-CODE FALSE> + PHRASE39>
 308                     <FRAME '\1aCOMPILE-ERROR>
 309                     <PUSH "Two arg list strings in a row:  ">
 310                     <PUSH ST17>
 311                     <DEAD ST17>
 312                     <PUSH TEMP25>
 313                     <CALL '\1aCOMPILE-ERROR 3>
 314 PHRASE39
 315                     <SET ST17 TEMP25>
 316                     <FRAME '\1aMEMBER>
 317                     <PUSH TEMP25>
 318                     <NTHR 'MODE 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
 319                     <NTHR TEMP34 1 = STACK (RECORD-TYPE LBIND)>
 320                     <DEAD TEMP34>
 321                     <CALL '\1aMEMBER 2 = TIX14>
 322                     <TYPE? TIX14 <TYPE-CODE FALSE> - PHRASE42>
 323                     <FRAME '\1aCOMPILE-ERROR>
 324                     <PUSH "Unrecognized arg list string:  ">
 325                     <PUSH TEMP25>
 326                     <DEAD TEMP25>
 327                     <CALL '\1aCOMPILE-ERROR 2>
 328 PHRASE42
 329                     <NTHR 'MODE 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
 330                     <NTHR TEMP34 1 = TEMP34 (RECORD-TYPE LBIND)>
 331                     <GVAL 'RESTS = TEMP25>
 332                     <LENUV TIX14 = TIX14 (TYPE FIX)>
 333                     <NTHR 'IX 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
 334                     <PUTR TEMP53 1 TIX14 (RECORD-TYPE LBIND)>
 335                     <DEAD TEMP53>
 336                     <NTHUU TEMP25 TIX14 = TEMP53 (TYPE FIX)>
 337                     <DEAD TEMP25 TIX14>
 338                     <RESTUV TEMP34 TEMP53 = TEMP53 (TYPE VECTOR)>
 339                     <DEAD TEMP34>
 340                     <NTHR 'MODE 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
 341                     <PUTR TEMP34 1 TEMP53 (RECORD-TYPE LBIND)>
 342                     <DEAD TEMP34 TEMP53>
 343                     <NTHR 'IX 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
 344                     <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
 345                     <LESS? TEMP53 7 + PHRASE69 (TYPE FIX)>
 346                     <DEAD TEMP53>
 347                     <NTHR 'IX 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
 348                     <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
 349                     <GRTR? TEMP53 11 + PHRASE69 (TYPE FIX)>
 350                     <DEAD TEMP53>
 351                     <FRAME '\1aPUT-RES>
 352                     <NTHL ARGL4 1 = TEMP53>
 353                     <TYPE? TEMP53 <TYPE-CODE STRING> - PHRASE65>
 354                     <IFCAN "STRING-EQUAL?">
 355                     <STRING-EQUAL? TEMP53 "OPT" - PHRASE65>
 356                     <ENDIF "STRING-EQUAL?">
 357                     <IFCANNOT "STRING-EQUAL?">
 358                     <SET TEMP34 "OPT" (TYPE STRING)>
 359                     <LENUS TEMP53 = TIX14 (TYPE FIX)>
 360                     <VEQUAL? TIX14 3 - PHRASE65>
 361                     <LOOP (TEMP53 VALUE LENGTH) (TEMP34 VALUE LENGTH) (TIX14 VALUE)>
 362 TAG67
 363                     <NTHUS TEMP53 1 = TEMP25>
 364                     <NTHUS TEMP34 1 = TEMP66>
 365                     <VEQUAL? TEMP25 TEMP66 - PHRASE65>
 366                     <DEAD TEMP25 TEMP66>
 367                     <RESTUS TEMP53 1 = TEMP53 (TYPE STRING)>
 368                     <RESTUS TEMP34 1 = TEMP34 (TYPE STRING)>
 369                     <SUB TIX14 1 = TIX14 (TYPE FIX)>
 370                     <GRTR? TIX14 0 + TAG67 (TYPE FIX)>
 371                     <ENDIF "STRING-EQUAL?">
 372                     <SET TEMP34 "OPTIONAL" (TYPE STRING)>
 373                     <JUMP + PHRASE68>
 374 PHRASE65
 375                     <NTHL ARGL4 1 = TEMP34>
 376 PHRASE68
 377                     <CONS TEMP34 () = STACK>
 378                     <DEAD TEMP34>
 379                     <CALL '\1aPUT-RES 1>
 380                     <JUMP + PHRASE69>
 381 PHRASE37
 382                     <FRAME '\1aCOMPILE-ERROR>
 383                     <PUSH "Unknown type of object in arglist ">
 384                     <PUSH TEMP25>
 385                     <DEAD TEMP25>
 386                     <CALL '\1aCOMPILE-ERROR 2>
 387 PHRASE69
 388                     <RESTL ARGL4 1 = ARGL4 (TYPE LIST)>
 389                     <JUMP + AGAIN27>
 390 EXIT26
 391                     <TYPE? HATOM6 <TYPE-CODE FALSE> + PHRASE72>
 392                     <FRAME '\1aACT-D>
 393                     <PUSH HATOM6>
 394                     <DEAD HATOM6>
 395                     <CALL '\1aACT-D 1>
 396 PHRASE72
 397                     <LOOP>
 398 AGAIN77
 399                     <INTGO>
 400                     <NTHR 'DCL 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
 401                     <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
 402                     <EMPL? TEMP53 + EXIT74>
 403                     <DEAD TEMP53>
 404                     <NTHR 'DCL 2 = TEMP66 (RECORD-TYPE ATOM) (TYPE LBIND)>
 405                     <NTHR TEMP66 1 = TEMP66 (RECORD-TYPE LBIND)>
 406                     <RESTL TEMP66 1 = TEMP53 (TYPE LIST)>
 407                     <DEAD TEMP66>
 408                     <CHTYPE TEMP53 <TYPE-CODE LIST> = TEMP53>
 409                     <EMPL? TEMP53 - PHRASE82 (TYPE LIST)>
 410                     <DEAD TEMP53>
 411                     <FRAME '\1aCOMPILE-ERROR>
 412                     <PUSH "DECL in bad format (no DECL for):  ">
 413                     <NTHR 'DCL 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
 414                     <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
 415                     <NTHL TEMP53 1 = STACK>
 416                     <DEAD TEMP53>
 417                     <CALL '\1aCOMPILE-ERROR 2>
 418 PHRASE82
 419                     <NTHR 'DCL 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
 420                     <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
 421                     <RESTL TEMP53 1 = TEMP53 (TYPE LIST)>
 422                     <NTHL TEMP53 1 = ST17>
 423                     <DEAD TEMP53>
 424                     <TYPE? ST17 <TYPE-CODE FORM> - PHRASE91>
 425                     <SET TEMP25 ST17>
 426                     <EMPL? TEMP25 + PHRASE91>
 427                     <RESTL TEMP25 1 = TEMP53 (TYPE LIST)>
 428                     <EMPL? TEMP53 + PHRASE91>
 429                     <RESTL TEMP53 1 = TEMP53 (TYPE LIST)>
 430                     <EMPL? TEMP53 - PHRASE91>
 431                     <DEAD TEMP53>
 432                     <NTHL TEMP25 1 = TEMP53>
 433                     <EQUAL? TEMP53 'SPECIAL + BOOL93>
 434                     <DEAD TEMP53>
 435                     <NTHL TEMP25 1 = TEMP53>
 436                     <EQUAL? TEMP53 'UNSPECIAL - PHRASE91>
 437                     <DEAD TEMP53>
 438 BOOL93
 439                     <RESTL TEMP25 1 = TEMP53 (TYPE LIST)>
 440                     <DEAD TEMP25>
 441                     <NTHL TEMP53 1 = ST17>
 442                     <DEAD TEMP53>
 443 PHRASE91
 444                     <NTHR 'DCL 2 = TEMP25 (RECORD-TYPE ATOM) (TYPE LBIND)>
 445                     <NTHR TEMP25 1 = TEMP25 (RECORD-TYPE LBIND)>
 446                     <NTHL TEMP25 1 = TEMP25>
 447                     <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
 448                     <LOOP>
 449 MAP95
 450                     <INTGO>
 451                     <EMPL? TEMP25 + MAPAP98>
 452                     <NTHL TEMP25 1 = TEMP34>
 453                     <EQUAL? TEMP34 'VALUE + PHRASE107>
 454                     <FRAME '\1aSRCH-SYM>
 455                     <PUSH TEMP34>
 456                     <CALL '\1aSRCH-SYM 1 = TIX14>
 457                     <VEQUAL? TIX14 0 - PHRASE107>
 458                     <DEAD TIX14>
 459                     <FRAME '\1aADDVAR>
 460                     <PUSH TEMP34>
 461                     <DEAD TEMP34>
 462                     <PUSH 'T>
 463                     <PUSH -1>
 464                     <PUSH 0>
 465                     <PUSH 'T>
 466                     <PUSH ST17>
 467                     <PUSH %<>>
 468                     <PUSH %<>>
 469                     <CALL '\1aADDVAR 8>
 470 PHRASE107
 471                     <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
 472                     <JUMP + MAP95>
 473 MAPAP98
 474                     <NTHR 'DCL 2 = ST17 (RECORD-TYPE ATOM) (TYPE LBIND)>
 475                     <NTHR ST17 1 = ST17 (RECORD-TYPE LBIND)>
 476                     <RESTL ST17 1 = ST17 (TYPE LIST)>
 477                     <RESTL ST17 1 = TEMP25 (TYPE LIST)>
 478                     <DEAD ST17>
 479                     <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
 480                     <NTHR 'DCL 2 = ST17 (RECORD-TYPE ATOM) (TYPE LBIND)>
 481                     <PUTR ST17 1 TEMP25 (RECORD-TYPE LBIND)>
 482                     <DEAD ST17 TEMP25>
 483                     <JUMP + AGAIN77>
 484 EXIT74
 485                     <GEN-LVAL 'VARTBL = ST17>
 486                     <GEN-SET 'VARTBL TEMP22>
 487                     <VEQUAL? TEMP22 ST17 + EXIT122>
 488                     <SET TEMP25 ST17>
 489                     <LOOP>
 490 AGAIN124
 491                     <INTGO>
 492                     <NTHUV TEMP25 1 = TEMP66>
 493                     <EQUAL? TEMP66 TEMP22 - PHRASE126>
 494                     <DEAD TEMP66>
 495                     <GEN-LVAL 'VARTBL = TEMP66>
 496                     <PUTUV TEMP25 1 TEMP66>
 497                     <DEAD TEMP25 TEMP66>
 498                     <GEN-SET 'VARTBL ST17>
 499                     <DEAD ST17>
 500                     <JUMP + EXIT122>
 501 PHRASE126
 502                     <NTHUV TEMP25 1 = TEMP25 (TYPE SYMTAB)>
 503                     <JUMP + AGAIN124>
 504 EXIT122
 505                     <NTHR 'ARGN 2 = TEMP66 (RECORD-TYPE ATOM) (TYPE LBIND)>
 506                     <NTHR TEMP66 1 = TEMP66 (RECORD-TYPE LBIND)>
 507                     <SUB TEMP66 1 = TEMP66 (TYPE FIX)>
 508                     <GEN-SET 'TRG TEMP66>
 509                     <LESS? TEMP66 0 - BOOL132 (TYPE FIX)>
 510                     <DEAD TEMP66>
 511                     <GEN-SET 'RQRG -1>
 512 BOOL132
 513                     <RESTL BNDL_TOP12 1 = TEMP66 (TYPE LIST)>
 514                     <DEAD BNDL_TOP12>
 515                     <PUTUV FCNNOD7 10 TEMP66 (TYPE LIST)>
 516                     <DEAD TEMP66>
 517                     <NTHUV FCNNOD7 1 = TEMP66 (TYPE FIX)>
 518                     <VEQUAL? TEMP66 1 - PHRASE142 (TYPE FIX)>
 519                     <DEAD TEMP66>
 520                     <GEN-LVAL 'RQRG = TEMP66>
 521                     <PUTUV FCNNOD7 21 TEMP66>
 522                     <DEAD TEMP66>
 523                     <GEN-LVAL 'TRG = TEMP66>
 524                     <PUTUV FCNNOD7 20 TEMP66>
 525                     <DEAD TEMP66>
 526                     <RESTL RES_TOP9 1 = TEMP66 (TYPE LIST)>
 527                     <DEAD RES_TOP9>
 528                     <PUTUV FCNNOD7 9 TEMP66>
 529                     <DEAD TEMP66>
 530 PHRASE142
 531                     <GEN-LVAL 'VARTBL = TEMP66>
 532                     <PUTUV FCNNOD7 11 TEMP66>
 533                     <DEAD TEMP66>
 534                     <UNBIND TEMP3>
 535                     <DEAD TEMP3>
 536                     <ADJ -54>
 537                     <RETURN FCNNOD7>
 538                     <DEAD FCNNOD7>
 539                     <END \1aGEN-D>\r\r
 540 "RUN-ARGER dispatches to different arg handlers"
 541
 542 #WORD *25027635603*
 543 <GFCN \1aRUN-ARGER ("VALUE" ANY FIX ANY ANY) INDX4 ARG5 N6>
 544                     <TEMP TEMP25>
 545                     <INTGO>
 546                     <DISPATCH INDX4 1 CASE23 CASE22 CASE18 CASE17 CASE16 CASE15 CASE14 CASE13 CASE12 CASE11 CASE10 CASE9 CASE19 CASE20 CASE24 CASE21>
 547                     <DEAD INDX4>
 548                     <RETURN %<>>
 549 CASE9
 550                     <FRAME '\1aBIND-D>
 551                     <PUSH ARG5>
 552                     <DEAD ARG5>
 553                     <CALL '\1aBIND-D 1 = TEMP25>
 554                     <RETURN TEMP25>
 555                     <DEAD TEMP25>
 556 CASE10
 557                     <FRAME '\1aCALL-D>
 558                     <PUSH ARG5>
 559                     <DEAD ARG5>
 560                     <CALL '\1aCALL-D 1 = TEMP25>
 561                     <RETURN TEMP25>
 562                     <DEAD TEMP25>
 563 CASE11
 564                     <FRAME '\1aOPT-D>
 565                     <PUSH ARG5>
 566                     <DEAD ARG5>
 567                     <CALL '\1aOPT-D 1 = TEMP25>
 568                     <RETURN TEMP25>
 569                     <DEAD TEMP25>
 570 CASE12
 571                     <FRAME '\1aOPT-D>
 572                     <PUSH ARG5>
 573                     <DEAD ARG5>
 574                     <CALL '\1aOPT-D 1 = TEMP25>
 575                     <RETURN TEMP25>
 576                     <DEAD TEMP25>
 577 CASE13
 578                     <FRAME '\1aARGS-D>
 579                     <PUSH ARG5>
 580                     <DEAD ARG5>
 581                     <CALL '\1aARGS-D 1 = TEMP25>
 582                     <RETURN TEMP25>
 583                     <DEAD TEMP25>
 584 CASE14
 585                     <FRAME '\1aTUPL-D>
 586                     <PUSH ARG5>
 587                     <DEAD ARG5>
 588                     <CALL '\1aTUPL-D 1 = TEMP25>
 589                     <RETURN TEMP25>
 590                     <DEAD TEMP25>
 591 CASE15
 592                     <FRAME '\1aAUX-D>
 593                     <PUSH ARG5>
 594                     <DEAD ARG5>
 595                     <CALL '\1aAUX-D 1 = TEMP25>
 596                     <RETURN TEMP25>
 597                     <DEAD TEMP25>
 598 CASE16
 599                     <FRAME '\1aAUX-D>
 600                     <PUSH ARG5>
 601                     <DEAD ARG5>
 602                     <CALL '\1aAUX-D 1 = TEMP25>
 603                     <RETURN TEMP25>
 604                     <DEAD TEMP25>
 605 CASE17
 606                     <FRAME '\1aACT-D>
 607                     <PUSH ARG5>
 608                     <DEAD ARG5>
 609                     <CALL '\1aACT-D 1 = TEMP25>
 610                     <RETURN TEMP25>
 611                     <DEAD TEMP25>
 612 CASE18
 613                     <FRAME '\1aACT-D>
 614                     <PUSH ARG5>
 615                     <DEAD ARG5>
 616                     <CALL '\1aACT-D 1 = TEMP25>
 617                     <RETURN TEMP25>
 618                     <DEAD TEMP25>
 619 CASE19
 620                     <FRAME '\1aINIT-D>
 621                     <PUSH ARG5>
 622                     <DEAD ARG5>
 623                     <CALL '\1aINIT-D 1 = TEMP25>
 624                     <RETURN TEMP25>
 625                     <DEAD TEMP25>
 626 CASE20
 627                     <FRAME '\1aINIT1-D>
 628                     <PUSH ARG5>
 629                     <DEAD ARG5>
 630                     <CALL '\1aINIT1-D 1 = TEMP25>
 631                     <RETURN TEMP25>
 632                     <DEAD TEMP25>
 633 CASE21
 634                     <FRAME '\1aNORM-D>
 635                     <PUSH ARG5>
 636                     <DEAD ARG5>
 637                     <CALL '\1aNORM-D 1 = TEMP25>
 638                     <RETURN TEMP25>
 639                     <DEAD TEMP25>
 640 CASE22
 641                     <FRAME '\1aDECL-D>
 642                     <PUSH ARG5>
 643                     <DEAD ARG5>
 644                     <CALL '\1aDECL-D 1 = TEMP25>
 645                     <RETURN TEMP25>
 646                     <DEAD TEMP25>
 647 CASE23
 648                     <FRAME '\1aVDECL-D>
 649                     <PUSH ARG5>
 650                     <DEAD ARG5>
 651                     <PUSH N6>
 652                     <DEAD N6>
 653                     <CALL '\1aVDECL-D 2 = TEMP25>
 654                     <RETURN TEMP25>
 655                     <DEAD TEMP25>
 656 CASE24
 657                     <FRAME '\1aERR-D>
 658                     <PUSH ARG5>
 659                     <DEAD ARG5>
 660                     <CALL '\1aERR-D 1 = TEMP25>
 661                     <RETURN TEMP25>
 662                     <DEAD TEMP25>
 663                     <END \1aRUN-ARGER>\r\r
 664 #WORD *13154210207*
 665 <GFCN \1aSRCH-SYM ("VALUE" <OR !<FALSE> <<PRIMTYPE VECTOR> ANY ATOM>> ATOM) ATM4>
 666                     <TEMP TEMP6 TEMP17:ATOM>
 667                     <INTGO>
 668                     <GEN-LVAL 'VARTBL = TEMP6>
 669                     <LOOP>
 670 AGAIN12
 671                     <INTGO>
 672                     <EMPUV? TEMP6 - PHRASE14>
 673                     <RETURN %<>>
 674 PHRASE14
 675                     <NTHUV TEMP6 2 = TEMP17 (TYPE ATOM)>
 676                     <VEQUAL? TEMP17 ATM4 - PHRASE16>
 677                     <DEAD TEMP17>
 678                     <RETURN TEMP6>
 679                     <DEAD TEMP6>
 680 PHRASE16
 681                     <NTHUV TEMP6 1 = TEMP6>
 682                     <JUMP + AGAIN12>
 683                     <END \1aSRCH-SYM>
 684 "This function used for normal args when \"BIND\" and \"CALL\" still possible."
 685
 686 #WORD *32344334262*
 687 <GFCN \1aINIT-D ("VALUE" <OR FALSE FIX> ANY) OBJ4>
 688                     <TEMP TEMP5>
 689                     <INTGO>
 690                     <GEN-LVAL 'MODE = TEMP5>
 691                     <RESTUV TEMP5 1 = TEMP5 (TYPE VECTOR)>
 692                     <GEN-SET 'MODE TEMP5>
 693                     <DEAD TEMP5>
 694                     <FRAME '\1aINIT1-D>
 695                     <PUSH OBJ4>
 696                     <DEAD OBJ4>
 697                     <CALL '\1aINIT1-D 1 = TEMP5>
 698                     <RETURN TEMP5>
 699                     <DEAD TEMP5>
 700                     <END \1aINIT-D>
 701 "This function for normal args when \"CALL\" still possible."
 702
 703 #WORD *12614350776*
 704 <GFCN \1aINIT1-D ("VALUE" <OR FALSE FIX> ANY) OBJ4>
 705                     <TEMP TEMP5>
 706                     <INTGO>
 707                     <GEN-LVAL 'MODE = TEMP5>
 708                     <RESTUV TEMP5 1 = TEMP5 (TYPE VECTOR)>
 709                     <GEN-SET 'MODE TEMP5>
 710                     <DEAD TEMP5>
 711                     <GEN-SET 'IX 16>
 712                     <FRAME '\1aNORM-D>
 713                     <PUSH OBJ4>
 714                     <DEAD OBJ4>
 715                     <CALL '\1aNORM-D 1 = TEMP5>
 716                     <RETURN TEMP5>
 717                     <DEAD TEMP5>
 718                     <END \1aINIT1-D>
 719 "Handle a normal argument or quoted normal argument."
 720
 721 #WORD *24732503627*
 722 <GFCN \1aNORM-D ("VALUE" <OR FALSE FIX> ANY "OPTIONAL" ANY) OBJ6 DC7>
 723                     <OPT-DISPATCH 1 %<> OPT4 OPT5>
 724 OPT4
 725                     <PUSH #T$UNBOUND 0>
 726 OPT5
 727                     <TEMP DC1-8 TEMP18>
 728                     <INTGO>
 729                     <TYPE? OBJ6 <TYPE-CODE LIST> - PHRASE10>
 730                     <FRAME '\1aCOMPILE-ERROR>
 731                     <PUSH "LIST not in OPT(IONAL) or AUX:  ">
 732                     <PUSH OBJ6>
 733                     <CALL '\1aCOMPILE-ERROR 2>
 734 PHRASE10
 735                     <TYPE? OBJ6 <TYPE-CODE ATOM> - PHRASE13>
 736                     <FRAME '\1aPUT-RES>
 737                     <FRAME '\1aPUT-DCL>
 738                     <PUSH 13>
 739                     <PUSH OBJ6>
 740                     <PUSH %<>>
 741                     <TYPE? DC7 <TYPE-CODE UNBOUND> + PHRASE17>
 742                     <SET TEMP18 DC7>
 743                     <JUMP + PHRASE19>
 744 PHRASE17
 745                     <FRAME '\1aFIND_DECL>
 746                     <PUSH OBJ6>
 747                     <DEAD OBJ6>
 748                     <GEN-LVAL 'DCL = STACK>
 749                     <CALL '\1aFIND_DECL 2 = TEMP18>
 750 PHRASE19
 751                     <PUSH TEMP18>
 752                     <DEAD TEMP18>
 753                     <PUSH 'T>
 754                     <CALL '\1aPUT-DCL 5 = TEMP18>
 755                     <CONS TEMP18 () = STACK>
 756                     <DEAD TEMP18>
 757                     <CALL '\1aPUT-RES 1>
 758                     <JUMP + PHRASE29>
 759 PHRASE13
 760                     <TYPE? OBJ6 <TYPE-CODE ADECL> - PHRASE24>
 761                     <LENUV OBJ6 = TEMP18 (TYPE FIX)>
 762                     <VEQUAL? TEMP18 2 + PHRASE26 (TYPE FIX)>
 763                     <DEAD TEMP18>
 764                     <FRAME '\1aCOMPILE-ERROR>
 765                     <PUSH "Bad ADECL:  ">
 766                     <PUSH OBJ6>
 767                     <CALL '\1aCOMPILE-ERROR 2>
 768 PHRASE26
 769                     <FRAME '\1aNORM-D>
 770                     <NTHUV OBJ6 1 = STACK>
 771                     <NTHUV OBJ6 2 = STACK>
 772                     <DEAD OBJ6>
 773                     <CALL '\1aNORM-D 2>
 774                     <JUMP + PHRASE29>
 775 PHRASE24
 776                     <FRAME '\1aQUOTCH>
 777                     <PUSH OBJ6>
 778                     <DEAD OBJ6>
 779                     <CALL '\1aQUOTCH 1 = OBJ6>
 780                     <TYPE? OBJ6 <TYPE-CODE ADECL> - PHRASE32>
 781                     <LENUV OBJ6 = TEMP18 (TYPE FIX)>
 782                     <VEQUAL? TEMP18 2 + PHRASE34 (TYPE FIX)>
 783                     <DEAD TEMP18>
 784                     <FRAME '\1aCOMPILE-ERROR>
 785                     <PUSH "Bad ADECL:  ">
 786                     <PUSH OBJ6>
 787                     <CALL '\1aCOMPILE-ERROR 2>
 788 PHRASE34
 789                     <NTHUV OBJ6 2 = DC1-8>
 790                     <NTHUV OBJ6 1 = OBJ6>
 791 PHRASE32
 792                     <FRAME '\1aPUT-RES>
 793                     <CONS "QUOTE" () = TEMP18>
 794                     <FRAME '\1aPUT-DCL>
 795                     <PUSH 12>
 796                     <PUSH OBJ6>
 797                     <PUSH %<>>
 798                     <TYPE? DC7 <TYPE-CODE UNBOUND> + PHRASE39>
 799                     <SET DC1-8 DC7>
 800                     <JUMP + PHRASE42>
 801 PHRASE39
 802                     <TYPE? DC1-8 <TYPE-CODE UNBOUND> - PHRASE42>
 803                     <FRAME '\1aFIND_DECL>
 804                     <PUSH OBJ6>
 805                     <DEAD OBJ6>
 806                     <GEN-LVAL 'DCL = STACK>
 807                     <CALL '\1aFIND_DECL 2 = DC1-8>
 808 PHRASE42
 809                     <PUSH DC1-8>
 810                     <DEAD DC1-8>
 811                     <PUSH 'T>
 812                     <CALL '\1aPUT-DCL 5 = DC1-8>
 813                     <CONS DC1-8 () = DC1-8>
 814                     <PUTREST TEMP18 DC1-8>
 815                     <DEAD DC1-8>
 816                     <PUSH TEMP18>
 817                     <DEAD TEMP18>
 818                     <CALL '\1aPUT-RES 1>
 819 PHRASE29
 820                     <TYPE? DC7 <TYPE-CODE UNBOUND> + TAG49>
 821                     <DEAD DC7>
 822                     <RETURN %<>>
 823 TAG49
 824                     <GEN-LVAL 'ARGN = DC1-8>
 825                     <ADD DC1-8 1 = DC1-8 (TYPE FIX)>
 826                     <GEN-SET 'ARGN DC1-8>
 827                     <DEAD DC1-8>
 828                     <GEN-LVAL 'RQRG = DC1-8>
 829                     <ADD DC1-8 1 = TEMP18 (TYPE FIX)>
 830                     <DEAD DC1-8>
 831                     <GEN-SET 'RQRG TEMP18>
 832                     <RETURN TEMP18>
 833                     <DEAD TEMP18>
 834                     <END \1aNORM-D>
 835 "Handle \"BIND\" decl."
 836
 837 #WORD *13677320114*
 838 <GFCN \1aBIND-D ("VALUE" FIX ANY) OBJ4>
 839                     <TEMP DC5>
 840                     <INTGO>
 841                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
 842                     <LENUV OBJ4 = DC5 (TYPE FIX)>
 843                     <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
 844                     <DEAD DC5>
 845                     <FRAME '\1aCOMPILE-ERROR>
 846                     <PUSH "Bad ADECL:  ">
 847                     <PUSH OBJ4>
 848                     <CALL '\1aCOMPILE-ERROR 2>
 849 PHRASE9
 850                     <NTHUV OBJ4 1 = OBJ4>
 851                     <FRAME '\1aNTH>
 852                     <PUSH OBJ4>
 853                     <PUSH 2>
 854                     <CALL '\1aNTH 2 = DC5>
 855 PHRASE7
 856                     <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE14>
 857                     <FRAME '\1aCOMPILE-ERROR>
 858                     <PUSH "Bad object after \"BIND\":  ">
 859                     <PUSH OBJ4>
 860                     <CALL '\1aCOMPILE-ERROR 2>
 861 PHRASE14
 862                     <FRAME '\1aPUT-DCL>
 863                     <PUSH 11>
 864                     <PUSH OBJ4>
 865                     <PUSH %<>>
 866                     <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE19>
 867                     <FRAME '\1aFIND_DECL>
 868                     <PUSH OBJ4>
 869                     <GEN-LVAL 'DCL = STACK>
 870                     <CALL '\1aFIND_DECL 2 = DC5>
 871 PHRASE19
 872                     <PUSH DC5>
 873                     <DEAD DC5>
 874                     <PUSH 'T>
 875                     <CALL '\1aPUT-DCL 5 = DC5>
 876                     <FRAME '\1aTYPE-ATOM-OK?>
 877                     <PUSH DC5>
 878                     <DEAD DC5>
 879                     <PUSH 'FRAME>
 880                     <PUSH OBJ4>
 881                     <DEAD OBJ4>
 882                     <CALL '\1aTYPE-ATOM-OK? 3>
 883                     <GEN-SET 'IX 14>
 884                     <RETURN 14>
 885                     <END \1aBIND-D>
 886 "Handle \"CALL\" decl."
 887
 888 #WORD *11152003471*
 889 <GFCN \1aCALL-D ("VALUE" FIX ANY) OBJ4>
 890                     <TEMP DC5 TEMP6>
 891                     <INTGO>
 892                     <GEN-LVAL 'RQRG = TEMP6>
 893                     <ADD TEMP6 1 = TEMP6 (TYPE FIX)>
 894                     <GEN-SET 'RQRG TEMP6>
 895                     <DEAD TEMP6>
 896                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE12>
 897                     <LENUV OBJ4 = TEMP6 (TYPE FIX)>
 898                     <VEQUAL? TEMP6 2 + PHRASE14 (TYPE FIX)>
 899                     <DEAD TEMP6>
 900                     <FRAME '\1aCOMPILE-ERROR>
 901                     <PUSH "Bad ADECL:  ">
 902                     <PUSH OBJ4>
 903                     <CALL '\1aCOMPILE-ERROR 2>
 904 PHRASE14
 905                     <NTHUV OBJ4 2 = DC5>
 906                     <NTHUV OBJ4 1 = OBJ4>
 907 PHRASE12
 908                     <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE17>
 909                     <FRAME '\1aCOMPILE-ERROR>
 910                     <PUSH "Bad object after \"CALL\":  ">
 911                     <PUSH OBJ4>
 912                     <CALL '\1aCOMPILE-ERROR 2>
 913 PHRASE17
 914                     <FRAME '\1aPUT-RES>
 915                     <FRAME '\1aPUT-DCL>
 916                     <PUSH 10>
 917                     <PUSH OBJ4>
 918                     <PUSH %<>>
 919                     <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE22>
 920                     <SET TEMP6 DC5>
 921                     <DEAD DC5>
 922                     <JUMP + PHRASE23>
 923 PHRASE22
 924                     <FRAME '\1aFIND_DECL>
 925                     <PUSH OBJ4>
 926                     <GEN-LVAL 'DCL = STACK>
 927                     <CALL '\1aFIND_DECL 2 = TEMP6>
 928 PHRASE23
 929                     <PUSH TEMP6>
 930                     <DEAD TEMP6>
 931                     <PUSH 'T>
 932                     <CALL '\1aPUT-DCL 5 = DC5>
 933                     <CONS DC5 () = STACK>
 934                     <CALL '\1aPUT-RES 1>
 935                     <FRAME '\1aTYPE-ATOM-OK?>
 936                     <PUSH DC5>
 937                     <DEAD DC5>
 938                     <PUSH 'FORM>
 939                     <PUSH OBJ4>
 940                     <DEAD OBJ4>
 941                     <CALL '\1aTYPE-ATOM-OK? 3>
 942                     <GEN-LVAL 'ARGN = TEMP6>
 943                     <ADD TEMP6 1 = TEMP6 (TYPE FIX)>
 944                     <GEN-SET 'ARGN TEMP6>
 945                     <DEAD TEMP6>
 946                     <GEN-SET 'IX 15>
 947                     <RETURN 15>
 948                     <END \1aCALL-D>
 949 "Flush on extra atoms after \"CALL\", \"ARGS\" etc."
 950
 951 #WORD *1156071750*
 952 <GFCN \1aERR-D ("VALUE" ANY ANY) OBJ4>
 953                     <TEMP TEMP6>
 954                     <INTGO>
 955                     <FRAME '\1aCOMPILE-ERROR>
 956                     <PUSH "Bad DECL syntax:  ">
 957                     <PUSH OBJ4>
 958                     <DEAD OBJ4>
 959                     <CALL '\1aCOMPILE-ERROR 2 = TEMP6>
 960                     <RETURN TEMP6>
 961                     <DEAD TEMP6>
 962                     <END \1aERR-D>
 963 "Handle \"OPTIONAL\" decl."
 964
 965 #WORD *12724315732*
 966 <GFCN \1aOPT-D ("VALUE" FIX ANY) OBJ4>
 967                     <TEMP DC5 TEMP11 OBJ1-6 TEMP66>
 968                     <INTGO>
 969                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE8>
 970                     <LENUV OBJ4 = TEMP11 (TYPE FIX)>
 971                     <VEQUAL? TEMP11 2 + PHRASE10 (TYPE FIX)>
 972                     <DEAD TEMP11>
 973                     <FRAME '\1aCOMPILE-ERROR>
 974                     <PUSH "Bad ADECL:  ">
 975                     <PUSH OBJ4>
 976                     <CALL '\1aCOMPILE-ERROR 2>
 977 PHRASE10
 978                     <NTHUV OBJ4 2 = DC5>
 979                     <NTHUV OBJ4 1 = OBJ4>
 980 PHRASE8
 981                     <TYPE? OBJ4 <TYPE-CODE ATOM> - PHRASE14>
 982                     <FRAME '\1aPUT-RES>
 983                     <FRAME '\1aPUT-DCL>
 984                     <PUSH 9>
 985                     <PUSH OBJ4>
 986                     <PUSH %<>>
 987                     <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE18>
 988                     <SET TEMP11 DC5>
 989                     <DEAD DC5>
 990                     <JUMP + PHRASE19>
 991 PHRASE18
 992                     <FRAME '\1aFIND_DECL>
 993                     <PUSH OBJ4>
 994                     <DEAD OBJ4>
 995                     <GEN-LVAL 'DCL = STACK>
 996                     <CALL '\1aFIND_DECL 2 = TEMP11>
 997 PHRASE19
 998                     <PUSH TEMP11>
 999                     <DEAD TEMP11>
1000                     <PUSH %<>>
1001                     <CALL '\1aPUT-DCL 5 = TEMP11>
1002                     <CONS TEMP11 () = STACK>
1003                     <DEAD TEMP11>
1004                     <CALL '\1aPUT-RES 1>
1005                     <JUMP + PHRASE74>
1006 PHRASE14
1007                     <TYPE? OBJ4 <TYPE-CODE FORM> - PHRASE24>
1008                     <FRAME '\1aQUOTCH>
1009                     <PUSH OBJ4>
1010                     <DEAD OBJ4>
1011                     <CALL '\1aQUOTCH 1 = OBJ4>
1012                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE27>
1013                     <LENUV OBJ4 = TEMP11 (TYPE FIX)>
1014                     <VEQUAL? TEMP11 2 + PHRASE29 (TYPE FIX)>
1015                     <DEAD TEMP11>
1016                     <FRAME '\1aCOMPILE-ERROR>
1017                     <PUSH "Bad ADECL:  ">
1018                     <PUSH OBJ4>
1019                     <CALL '\1aCOMPILE-ERROR 2>
1020 PHRASE29
1021                     <NTHUV OBJ4 2 = DC5>
1022                     <NTHUV OBJ4 1 = OBJ4>
1023 PHRASE27
1024                     <FRAME '\1aPUT-RES>
1025                     <CONS "QUOTE" () = TEMP11>
1026                     <FRAME '\1aPUT-DCL>
1027                     <PUSH 8>
1028                     <PUSH OBJ4>
1029                     <PUSH %<>>
1030                     <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE36>
1031                     <FRAME '\1aFIND_DECL>
1032                     <PUSH OBJ4>
1033                     <DEAD OBJ4>
1034                     <GEN-LVAL 'DCL = STACK>
1035                     <CALL '\1aFIND_DECL 2 = DC5>
1036 PHRASE36
1037                     <PUSH DC5>
1038                     <DEAD DC5>
1039                     <PUSH %<>>
1040                     <CALL '\1aPUT-DCL 5 = DC5>
1041                     <CONS DC5 () = DC5>
1042                     <PUTREST TEMP11 DC5>
1043                     <DEAD DC5>
1044                     <PUSH TEMP11>
1045                     <DEAD TEMP11>
1046                     <CALL '\1aPUT-RES 1>
1047                     <JUMP + PHRASE74>
1048 PHRASE24
1049                     <FRAME '\1aLISTCH>
1050                     <PUSH OBJ4>
1051                     <CALL '\1aLISTCH 1 = OBJ1-6>
1052                     <TYPE? OBJ1-6 <TYPE-CODE ATOM> + TAG43>
1053                     <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE41>
1054 TAG43
1055                     <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE45>
1056                     <LENUV OBJ1-6 = TEMP11 (TYPE FIX)>
1057                     <VEQUAL? TEMP11 2 + PHRASE47 (TYPE FIX)>
1058                     <DEAD TEMP11>
1059                     <FRAME '\1aCOMPILE-ERROR>
1060                     <PUSH "Bad ADECL:  ">
1061                     <PUSH OBJ1-6>
1062                     <CALL '\1aCOMPILE-ERROR 2>
1063 PHRASE47
1064                     <NTHUV OBJ1-6 2 = DC5>
1065                     <NTHUV OBJ1-6 1 = OBJ1-6>
1066 PHRASE45
1067                     <FRAME '\1aPUT-RES>
1068                     <FRAME '\1aPAUX>
1069                     <PUSH OBJ1-6>
1070                     <RESTL OBJ4 1 = TEMP11 (TYPE LIST)>
1071                     <DEAD OBJ4>
1072                     <NTHL TEMP11 1 = STACK>
1073                     <DEAD TEMP11>
1074                     <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE52>
1075                     <SET TEMP11 DC5>
1076                     <DEAD DC5>
1077                     <JUMP + PHRASE53>
1078 PHRASE52
1079                     <FRAME '\1aFIND_DECL>
1080                     <PUSH OBJ1-6>
1081                     <DEAD OBJ1-6>
1082                     <GEN-LVAL 'DCL = STACK>
1083                     <CALL '\1aFIND_DECL 2 = TEMP11>
1084 PHRASE53
1085                     <PUSH TEMP11>
1086                     <DEAD TEMP11>
1087                     <PUSH 7>
1088                     <CALL '\1aPAUX 4 = TEMP11>
1089                     <CONS TEMP11 () = STACK>
1090                     <DEAD TEMP11>
1091                     <CALL '\1aPUT-RES 1>
1092                     <JUMP + PHRASE74>
1093 PHRASE41
1094                     <TYPE? OBJ1-6 <TYPE-CODE FORM> - PHRASE57>
1095                     <FRAME '\1aQUOTCH>
1096                     <PUSH OBJ1-6>
1097                     <DEAD OBJ1-6>
1098                     <CALL '\1aQUOTCH 1 = OBJ1-6>
1099                     <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE60>
1100                     <LENUV OBJ1-6 = TEMP11 (TYPE FIX)>
1101                     <VEQUAL? TEMP11 2 + PHRASE62 (TYPE FIX)>
1102                     <DEAD TEMP11>
1103                     <FRAME '\1aCOMPILE-ERROR>
1104                     <PUSH "Bad ADECL:  ">
1105                     <PUSH OBJ1-6>
1106                     <CALL '\1aCOMPILE-ERROR 2>
1107 PHRASE62
1108                     <NTHUV OBJ1-6 2 = DC5>
1109                     <NTHUV OBJ1-6 1 = OBJ1-6>
1110 PHRASE60
1111                     <FRAME '\1aPUT-RES>
1112                     <CONS "QUOTE" () = TEMP11>
1113                     <FRAME '\1aPAUX>
1114                     <PUSH OBJ1-6>
1115                     <RESTL OBJ4 1 = TEMP66 (TYPE LIST)>
1116                     <DEAD OBJ4>
1117                     <NTHL TEMP66 1 = STACK>
1118                     <DEAD TEMP66>
1119                     <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE68>
1120                     <SET TEMP66 DC5>
1121                     <DEAD DC5>
1122                     <JUMP + PHRASE69>
1123 PHRASE68
1124                     <FRAME '\1aFIND_DECL>
1125                     <PUSH OBJ1-6>
1126                     <DEAD OBJ1-6>
1127                     <GEN-LVAL 'DCL = STACK>
1128                     <CALL '\1aFIND_DECL 2 = TEMP66>
1129 PHRASE69
1130                     <PUSH TEMP66>
1131                     <DEAD TEMP66>
1132                     <PUSH 6>
1133                     <CALL '\1aPAUX 4 = TEMP66>
1134                     <CONS TEMP66 () = TEMP66>
1135                     <PUTREST TEMP11 TEMP66>
1136                     <DEAD TEMP66>
1137                     <PUSH TEMP11>
1138                     <DEAD TEMP11>
1139                     <CALL '\1aPUT-RES 1>
1140                     <JUMP + PHRASE74>
1141 PHRASE57
1142                     <FRAME '\1aCOMPILE-ERROR>
1143                     <PUSH "Bad use of \"OPT(IONAL)\":  ">
1144                     <PUSH OBJ4>
1145                     <DEAD OBJ4>
1146                     <CALL '\1aCOMPILE-ERROR 2>
1147 PHRASE74
1148                     <GEN-LVAL 'ARGN = TEMP11>
1149                     <ADD TEMP11 1 = TEMP11 (TYPE FIX)>
1150                     <GEN-SET 'ARGN TEMP11>
1151                     <RETURN TEMP11>
1152                     <DEAD TEMP11>
1153                     <END \1aOPT-D>\r\r
1154 "Handle \"ARGS\" decl."
1155
1156 #WORD *340177530*
1157 <GFCN \1aARGS-D ("VALUE" FIX ANY) OBJ4>
1158                     <TEMP DC5>
1159                     <INTGO>
1160                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
1161                     <LENUV OBJ4 = DC5 (TYPE FIX)>
1162                     <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
1163                     <DEAD DC5>
1164                     <FRAME '\1aCOMPILE-ERROR>
1165                     <PUSH "Bad ADECL:  ">
1166                     <PUSH OBJ4>
1167                     <CALL '\1aCOMPILE-ERROR 2>
1168 PHRASE9
1169                     <NTHUV OBJ4 2 = DC5>
1170                     <NTHUV OBJ4 1 = OBJ4>
1171 PHRASE7
1172                     <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE13>
1173                     <FRAME '\1aCOMPILE-ERROR>
1174                     <PUSH "Bad use of \"ARGS\":  ">
1175                     <PUSH OBJ4>
1176                     <CALL '\1aCOMPILE-ERROR 2>
1177 PHRASE13
1178                     <FRAME '\1aPUT-RES>
1179                     <FRAME '\1aPUT-DCL>
1180                     <PUSH 5>
1181                     <PUSH OBJ4>
1182                     <PUSH %<>>
1183                     <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE19>
1184                     <FRAME '\1aFIND_DECL>
1185                     <PUSH OBJ4>
1186                     <GEN-LVAL 'DCL = STACK>
1187                     <CALL '\1aFIND_DECL 2 = DC5>
1188 PHRASE19
1189                     <PUSH DC5>
1190                     <DEAD DC5>
1191                     <PUSH %<>>
1192                     <CALL '\1aPUT-DCL 5 = DC5>
1193                     <CONS DC5 () = STACK>
1194                     <CALL '\1aPUT-RES 1>
1195                     <FRAME '\1aTYPE-ATOM-OK?>
1196                     <PUSH DC5>
1197                     <DEAD DC5>
1198                     <PUSH 'LIST>
1199                     <PUSH OBJ4>
1200                     <DEAD OBJ4>
1201                     <CALL '\1aTYPE-ATOM-OK? 3>
1202                     <GEN-SET 'IX 15>
1203                     <GEN-LVAL 'ARGN = DC5>
1204                     <ADD DC5 1 = DC5 (TYPE FIX)>
1205                     <GEN-SET 'ARGN DC5>
1206                     <RETURN DC5>
1207                     <DEAD DC5>
1208                     <END \1aARGS-D>
1209 "Handle \"TUPLE\" decl."
1210
1211 #WORD *12450343172*
1212 <GFCN \1aTUPL-D ("VALUE" FIX ANY) OBJ4>
1213                     <TEMP DC5>
1214                     <INTGO>
1215                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
1216                     <LENUV OBJ4 = DC5 (TYPE FIX)>
1217                     <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
1218                     <DEAD DC5>
1219                     <FRAME '\1aCOMPILE-ERROR>
1220                     <PUSH "Bad ADECL:  ">
1221                     <PUSH OBJ4>
1222                     <CALL '\1aCOMPILE-ERROR 2>
1223 PHRASE9
1224                     <NTHUV OBJ4 2 = DC5>
1225                     <NTHUV OBJ4 1 = OBJ4>
1226 PHRASE7
1227                     <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE13>
1228                     <FRAME '\1aCOMPILE-ERROR>
1229                     <PUSH "Bad use of \"TUPLE\":  ">
1230                     <PUSH OBJ4>
1231                     <CALL '\1aCOMPILE-ERROR 2>
1232 PHRASE13
1233                     <FRAME '\1aPUT-RES>
1234                     <FRAME '\1aPUT-DCL>
1235                     <PUSH 4>
1236                     <PUSH OBJ4>
1237                     <PUSH %<>>
1238                     <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE19>
1239                     <FRAME '\1aFIND_DECL>
1240                     <PUSH OBJ4>
1241                     <GEN-LVAL 'DCL = STACK>
1242                     <CALL '\1aFIND_DECL 2 = DC5>
1243 PHRASE19
1244                     <PUSH DC5>
1245                     <DEAD DC5>
1246                     <PUSH %<>>
1247                     <CALL '\1aPUT-DCL 5 = DC5>
1248                     <CONS DC5 () = STACK>
1249                     <CALL '\1aPUT-RES 1>
1250                     <FRAME '\1aTYPE-ATOM-OK?>
1251                     <PUSH DC5>
1252                     <DEAD DC5>
1253                     <PUSH 'TUPLE>
1254                     <PUSH OBJ4>
1255                     <DEAD OBJ4>
1256                     <CALL '\1aTYPE-ATOM-OK? 3>
1257                     <GEN-SET 'IX 15>
1258                     <RETURN 15>
1259                     <END \1aTUPL-D>
1260 "Handle \"AUX\" decl."
1261
1262 #WORD *3000766575*
1263 <GFCN \1aAUX-D ("VALUE" ANY ANY) OBJ4>
1264                     <TEMP DC5 OBJ1-6 TEMP31>
1265                     <INTGO>
1266                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE8>
1267                     <LENUV OBJ4 = DC5 (TYPE FIX)>
1268                     <VEQUAL? DC5 2 + PHRASE10 (TYPE FIX)>
1269                     <DEAD DC5>
1270                     <FRAME '\1aCOMPILE-ERROR>
1271                     <PUSH "Bad ADECL:  ">
1272                     <PUSH OBJ4>
1273                     <CALL '\1aCOMPILE-ERROR 2>
1274 PHRASE10
1275                     <NTHUV OBJ4 2 = DC5>
1276                     <NTHUV OBJ4 1 = OBJ4>
1277 PHRASE8
1278                     <TYPE? OBJ4 <TYPE-CODE ATOM> - PHRASE14>
1279                     <FRAME '\1aPUT-DCL>
1280                     <PUSH 3>
1281                     <PUSH OBJ4>
1282                     <PUSH %<>>
1283                     <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE18>
1284                     <FRAME '\1aFIND_DECL>
1285                     <PUSH OBJ4>
1286                     <DEAD OBJ4>
1287                     <GEN-LVAL 'DCL = STACK>
1288                     <CALL '\1aFIND_DECL 2 = DC5>
1289 PHRASE18
1290                     <PUSH DC5>
1291                     <DEAD DC5>
1292                     <PUSH %<>>
1293                     <CALL '\1aPUT-DCL 5 = DC5>
1294                     <RETURN DC5>
1295                     <DEAD DC5>
1296 PHRASE14
1297                     <TYPE? OBJ4 <TYPE-CODE LIST> - PHRASE23>
1298                     <FRAME '\1aLISTCH>
1299                     <PUSH OBJ4>
1300                     <CALL '\1aLISTCH 1 = OBJ1-6>
1301                     <TYPE? OBJ1-6 <TYPE-CODE ADECL> + TAG26>
1302                     <TYPE? OBJ1-6 <TYPE-CODE ATOM> - PHRASE23>
1303 TAG26
1304                     <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE28>
1305                     <LENUV OBJ1-6 = TEMP31 (TYPE FIX)>
1306                     <VEQUAL? TEMP31 2 + PHRASE30 (TYPE FIX)>
1307                     <DEAD TEMP31>
1308                     <FRAME '\1aCOMPILE-ERROR>
1309                     <PUSH "Bad ADECL:  ">
1310                     <PUSH OBJ1-6>
1311                     <CALL '\1aCOMPILE-ERROR 2>
1312 PHRASE30
1313                     <NTHUV OBJ1-6 2 = DC5>
1314                     <NTHUV OBJ1-6 1 = OBJ1-6>
1315 PHRASE28
1316                     <FRAME '\1aPAUX>
1317                     <PUSH OBJ1-6>
1318                     <RESTL OBJ4 1 = TEMP31 (TYPE LIST)>
1319                     <DEAD OBJ4>
1320                     <NTHL TEMP31 1 = STACK>
1321                     <DEAD TEMP31>
1322                     <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE35>
1323                     <SET TEMP31 DC5>
1324                     <DEAD DC5>
1325                     <JUMP + PHRASE36>
1326 PHRASE35
1327                     <FRAME '\1aFIND_DECL>
1328                     <PUSH OBJ1-6>
1329                     <DEAD OBJ1-6>
1330                     <GEN-LVAL 'DCL = STACK>
1331                     <CALL '\1aFIND_DECL 2 = TEMP31>
1332 PHRASE36
1333                     <PUSH TEMP31>
1334                     <DEAD TEMP31>
1335                     <PUSH 2>
1336                     <CALL '\1aPAUX 4 = DC5>
1337                     <RETURN DC5>
1338                     <DEAD DC5>
1339 PHRASE23
1340                     <FRAME '\1aCOMPILE-ERROR>
1341                     <PUSH "Bad usage of \"AUX\" :  ">
1342                     <PUSH OBJ4>
1343                     <DEAD OBJ4>
1344                     <CALL '\1aCOMPILE-ERROR 2 = DC5>
1345                     <RETURN DC5>
1346                     <DEAD DC5>
1347                     <END \1aAUX-D>
1348 "Handle \"NAME\" and \"ACT\" decl."
1349
1350 #WORD *22266347075*
1351 <GFCN \1aACT-D ("VALUE" ANY ANY) OBJ4>
1352                     <TEMP DC5>
1353                     <INTGO>
1354                     <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
1355                     <LENUV OBJ4 = DC5 (TYPE FIX)>
1356                     <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
1357                     <DEAD DC5>
1358                     <FRAME '\1aCOMPILE-ERROR>
1359                     <PUSH "Bad ADECL:  ">
1360                     <PUSH OBJ4>
1361                     <CALL '\1aCOMPILE-ERROR 2>
1362 PHRASE9
1363                     <NTHUV OBJ4 2 = DC5>
1364                     <NTHUV OBJ4 1 = OBJ4>
1365 PHRASE7
1366                     <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE13>
1367                     <FRAME '\1aCOMPILE-ERROR>
1368                     <PUSH "Bad use of \"ACT\":  ">
1369                     <PUSH OBJ4>
1370                     <CALL '\1aCOMPILE-ERROR 2>
1371 PHRASE13
1372                     <FRAME '\1aPUT-DCL>
1373                     <PUSH 1>
1374                     <PUSH OBJ4>
1375                     <PUSH %<>>
1376                     <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE18>
1377                     <FRAME '\1aFIND_DECL>
1378                     <PUSH OBJ4>
1379                     <GEN-LVAL 'DCL = STACK>
1380                     <CALL '\1aFIND_DECL 2 = DC5>
1381 PHRASE18
1382                     <PUSH DC5>
1383                     <DEAD DC5>
1384                     <PUSH %<>>
1385                     <CALL '\1aPUT-DCL 5 = DC5>
1386                     <FRAME '\1aTYPE-ATOM-OK?>
1387                     <PUSH DC5>
1388                     <DEAD DC5>
1389                     <PUSH 'FRAME>
1390                     <PUSH OBJ4>
1391                     <DEAD OBJ4>
1392                     <CALL '\1aTYPE-ATOM-OK? 3 = DC5>
1393                     <RETURN DC5>
1394                     <DEAD DC5>
1395                     <END \1aACT-D>
1396 "Fixup activation atoms after node generated."
1397
1398 #WORD *23701426367*
1399 <GFCN \1aACT-FIX ("VALUE" <OR ATOM FALSE> NODE <LIST [REST SYMTAB]>) N4 L5>
1400                     <TEMP (FLG6 %<>) SYM10:SYMTAB TEMP17>
1401                     <INTGO>
1402                     <LOOP>
1403 AGAIN11
1404                     <INTGO>
1405                     <EMPL? L5 - PHRASE13 (TYPE LIST)>
1406                     <RETURN FLG6>
1407                     <DEAD FLG6>
1408 PHRASE13
1409                     <NTHL L5 1 = SYM10 (TYPE SYMTAB)>
1410                     <NTHUV SYM10 4 = TEMP17 (TYPE FIX)>
1411                     <VEQUAL? TEMP17 1 - PHRASE15 (TYPE FIX)>
1412                     <DEAD TEMP17>
1413                     <SET FLG6 'T (TYPE ATOM)>
1414                     <NTHUV SYM10 3 = TEMP17>
1415                     <TYPE? TEMP17 <TYPE-CODE FALSE> - PHRASE15>
1416                     <DEAD TEMP17>
1417                     <PUTUV SYM10 11 N4>
1418                     <DEAD SYM10>
1419 PHRASE15
1420                     <RESTL L5 1 = L5 (TYPE LIST)>
1421                     <JUMP + AGAIN11>
1422                     <END \1aACT-FIX>
1423 #WORD *26463156127*
1424 <GFCN \1aDECL-D ("VALUE" ANY ANY) ARG4>
1425                     <TEMP TEMP11>
1426                     <INTGO>
1427                     <TYPE? ARG4 <TYPE-CODE ADECL> - PHRASE6>
1428                     <FRAME '\1aSRCH-SYM>
1429                     <NTHUV ARG4 1 = STACK (TYPE ATOM)>
1430                     <CALL '\1aSRCH-SYM 1 = TEMP11>
1431                     <VEQUAL? TEMP11 0 + TAG12>
1432                     <DEAD TEMP11>
1433                     <RETURN %<>>
1434 TAG12
1435                     <FRAME '\1aADDVAR>
1436                     <NTHUV ARG4 1 = STACK>
1437                     <PUSH 'T>
1438                     <PUSH -1>
1439                     <PUSH 0>
1440                     <PUSH 'T>
1441                     <NTHUV ARG4 2 = STACK>
1442                     <DEAD ARG4>
1443                     <PUSH %<>>
1444                     <PUSH %<>>
1445                     <CALL '\1aADDVAR 8 = TEMP11>
1446                     <RETURN TEMP11>
1447                     <DEAD TEMP11>
1448 PHRASE6
1449                     <FRAME '\1aCOMPILE-ERROR>
1450                     <PUSH "DECL in bad format (no DECL for):  ">
1451                     <PUSH ARG4>
1452                     <DEAD ARG4>
1453                     <CALL '\1aCOMPILE-ERROR 2 = TEMP11>
1454                     <RETURN TEMP11>
1455                     <DEAD TEMP11>
1456                     <END \1aDECL-D>
1457 #WORD *2200435314*
1458 <GFCN \1aVDECL-D ("VALUE" NODE ANY NODE) ARG4 N5>
1459                     <TEMP>
1460                     <INTGO>
1461                     <PUTUV N5 3 ARG4>
1462                     <PUTUV N5 17 ARG4>
1463                     <DEAD ARG4>
1464                     <RETURN N5>
1465                     <DEAD N5>
1466                     <END \1aVDECL-D>
1467 <GDECL (TOT-MODES) <VECTOR [REST STRING]> (RESTS) <UVECTOR [REST FIX]>>
1468
1469 "Check for quoted arguments."
1470
1471 #WORD *6300631300*
1472 <GFCN \1aQUOTCH ("VALUE" <OR ADECL ATOM> FORM) OB4>
1473                     <TEMP TEMP8>
1474                     <INTGO>
1475                     <EMPL? OB4 + PHRASE6>
1476                     <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1477                     <EMPL? TEMP8 + PHRASE6>
1478                     <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
1479                     <EMPL? TEMP8 - PHRASE6>
1480                     <DEAD TEMP8>
1481                     <NTHL OB4 1 = TEMP8>
1482                     <EQUAL? TEMP8 'QUOTE - PHRASE6>
1483                     <DEAD TEMP8>
1484                     <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1485                     <NTHL TEMP8 1 = TEMP8>
1486                     <TYPE? TEMP8 <TYPE-CODE ATOM> + TAG9>
1487                     <TYPE? TEMP8 <TYPE-CODE ADECL> - PHRASE6>
1488                     <DEAD TEMP8>
1489 TAG9
1490                     <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1491                     <DEAD OB4>
1492                     <NTHL TEMP8 1 = TEMP8>
1493                     <RETURN TEMP8>
1494                     <DEAD TEMP8>
1495 PHRASE6
1496                     <FRAME '\1aCOMPILE-ERROR>
1497                     <PUSH "Bad form in argument list">
1498                     <PUSH OB4>
1499                     <DEAD OB4>
1500                     <CALL '\1aCOMPILE-ERROR 2>
1501                     <RETURN 'T>
1502                     <END \1aQUOTCH>
1503 "Chech for (arg init) or ('arg init)."
1504
1505 #WORD *21263377111*
1506 <GFCN \1aLISTCH ("VALUE" ANY LIST) OB4>
1507                     <TEMP TEMP8>
1508                     <INTGO>
1509                     <EMPL? OB4 + PHRASE6>
1510                     <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1511                     <EMPL? TEMP8 + PHRASE6>
1512                     <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
1513                     <EMPL? TEMP8 - PHRASE6>
1514                     <DEAD TEMP8>
1515                     <NTHL OB4 1 = TEMP8>
1516                     <TYPE? TEMP8 <TYPE-CODE ATOM> + BOOL9>
1517                     <TYPE? TEMP8 <TYPE-CODE ADECL> + BOOL9>
1518                     <DEAD TEMP8>
1519                     <NTHL OB4 1 = TEMP8>
1520                     <TYPE? TEMP8 <TYPE-CODE FORM> - PHRASE6>
1521                     <DEAD TEMP8>
1522                     <FRAME '\1aQUOTCH>
1523                     <NTHL OB4 1 = STACK (TYPE FORM)>
1524                     <CALL '\1aQUOTCH 1>
1525 BOOL9
1526                     <NTHL OB4 1 = TEMP8>
1527                     <DEAD OB4>
1528                     <RETURN TEMP8>
1529                     <DEAD TEMP8>
1530 PHRASE6
1531                     <FRAME '\1aCOMPILE-ERROR>
1532                     <PUSH "Bad list in arg list:  ">
1533                     <PUSH OB4>
1534                     <DEAD OB4>
1535                     <CALL '\1aCOMPILE-ERROR 2>
1536                     <RETURN 'T>
1537                     <END \1aLISTCH>
1538 "Add a decl to RSUBR decls and update AC call spec."
1539
1540 #WORD *10221127105*
1541 <GFCN \1aPUT-RES ("VALUE" ATOM LIST) L4>
1542                     <TEMP TEMP5 TEMP8:FIX>
1543                     <INTGO>
1544                     <GEN-LVAL 'RES_BOT = TEMP5>
1545                     <PUTREST TEMP5 L4>
1546                     <LENL L4 = TEMP8 (TYPE FIX)>
1547                     <DEAD L4>
1548                     <GRTR? TEMP8 0 - RESTL10 (TYPE FIX)>
1549                     <LOOP (TEMP5 VALUE) (TEMP8 VALUE)>
1550 RESTL9
1551                     <INTGO>
1552                     <RESTL TEMP5 1 = TEMP5 (TYPE LIST)>
1553                     <SUB TEMP8 1 = TEMP8 (TYPE FIX)>
1554                     <GRTR? TEMP8 0 + RESTL9 (TYPE FIX)>
1555 RESTL10
1556                     <GEN-SET 'RES_BOT TEMP5>
1557                     <DEAD TEMP5>
1558                     <RETURN 'T>
1559                     <END \1aPUT-RES>
1560 "Add code to set up a certain kind of argument."
1561
1562 #WORD *34156322543*
1563 <GFCN \1aPUT-DCL ("VALUE" ANY FIX ATOM ANY ANY ANY) COD4 ATM5 VAL6 DC7 COM8>
1564                     <TEMP DC1-10 TEMP16 SPC9>
1565                     <INTGO>
1566                     <TYPE? DC7 <TYPE-CODE FORM> - PHRASE14>
1567                     <SET DC1-10 DC7>
1568                     <EMPL? DC1-10 + PHRASE14>
1569                     <RESTL DC1-10 1 = TEMP16 (TYPE LIST)>
1570                     <EMPL? TEMP16 + PHRASE14>
1571                     <RESTL TEMP16 1 = TEMP16 (TYPE LIST)>
1572                     <EMPL? TEMP16 - PHRASE14>
1573                     <DEAD TEMP16>
1574                     <SET SPC9 %<> (TYPE FALSE)>
1575                     <NTHL DC1-10 1 = TEMP16>
1576                     <EQUAL? TEMP16 'SPECIAL - TAG18>
1577                     <DEAD TEMP16>
1578                     <SET SPC9 'T (TYPE ATOM)>
1579                     <JUMP + BOOL17>
1580 TAG18
1581                     <NTHL DC1-10 1 = TEMP16>
1582                     <EQUAL? TEMP16 'UNSPECIAL - PHRASE14>
1583                     <DEAD TEMP16>
1584 BOOL17
1585                     <RESTL DC1-10 1 = TEMP16 (TYPE LIST)>
1586                     <DEAD DC1-10>
1587                     <NTHL TEMP16 1 = DC7>
1588                     <DEAD TEMP16>
1589                     <JUMP + PHRASE19>
1590 PHRASE14
1591                     <GEN-LVAL 'GLOSP = SPC9>
1592 PHRASE19
1593                     <FRAME '\1aADDVAR>
1594                     <PUSH ATM5>
1595                     <DEAD ATM5>
1596                     <PUSH SPC9>
1597                     <DEAD SPC9>
1598                     <PUSH COD4>
1599                     <DEAD COD4>
1600                     <GEN-LVAL 'ARGN = STACK>
1601                     <PUSH 'T>
1602                     <PUSH DC7>
1603                     <PUSH %<>>
1604                     <PUSH VAL6>
1605                     <DEAD VAL6>
1606                     <CALL '\1aADDVAR 8 = TEMP16>
1607                     <GEN-LVAL 'BNDL_BOT = DC1-10>
1608                     <CONS TEMP16 () = TEMP16>
1609                     <PUTREST DC1-10 TEMP16>
1610                     <DEAD DC1-10>
1611                     <GEN-SET 'BNDL_BOT TEMP16>
1612                     <DEAD TEMP16>
1613                     <RETURN DC7>
1614                     <DEAD DC7>
1615                     <END \1aPUT-DCL>
1616 "Find decl associated with a variable, if none, use ANY."
1617
1618 #WORD *21213755333*
1619 <GFCN \1aFIND_DECL ("VALUE" ANY ATOM "OPTIONAL" <PRIMTYPE LIST>) ATM6 DC7>
1620                     <OPT-DISPATCH 1 %<> OPT4 OPT5>
1621 OPT4
1622                     <PUSH #T$UNBOUND 0>
1623 OPT5
1624                     <TEMP TEMP10 TT16:LIST TEMP30>
1625                     <INTGO>
1626                     <TYPE? DC7 <TYPE-CODE UNBOUND> - TAG8>
1627                     <GEN-LVAL 'DECLS = DC7>
1628 TAG8
1629                     <LOOP>
1630 AGAIN17
1631                     <INTGO>
1632                     <EMPL? DC7 + BOOL20>
1633                     <RESTL DC7 1 = TT16 (TYPE LIST)>
1634                     <CHTYPE TT16 <TYPE-CODE LIST> = TT16>
1635                     <EMPL? TT16 - PHRASE19 (TYPE LIST)>
1636 BOOL20
1637                     <RETURN 'ANY>
1638 PHRASE19
1639                     <NTHL DC7 1 = TEMP10>
1640                     <TYPE? TEMP10 <TYPE-CODE LIST> + PHRASE22>
1641                     <DEAD TEMP10>
1642                     <FRAME '\1aCOMPILE-ERROR>
1643                     <PUSH "Malformed DECL:  ">
1644                     <PUSH DC7>
1645                     <CALL '\1aCOMPILE-ERROR 2>
1646 PHRASE22
1647                     <NTHL DC7 1 = TEMP10>
1648                     <DEAD DC7>
1649                     <CHTYPE TEMP10 <TYPE-CODE LIST> = TEMP10>
1650                     <EMPL? TEMP10 + PHRASE26>
1651                     <LOOP (ATM6 VALUE) (TEMP10 VALUE)>
1652 TAG28
1653                     <NTHL TEMP10 1 = TEMP30>
1654                     <TYPE? TEMP30 <TYPE-CODE ATOM> - TAG29>
1655                     <VEQUAL? TEMP30 ATM6 + TAG27>
1656                     <DEAD TEMP30>
1657 TAG29
1658                     <RESTL TEMP10 1 = TEMP10 (TYPE LIST)>
1659                     <EMPL? TEMP10 - TAG28>
1660                     <JUMP + PHRASE26>
1661 TAG27
1662                     <NTHL TT16 1 = TEMP10>
1663                     <DEAD TT16>
1664                     <RETURN TEMP10>
1665                     <DEAD TEMP10>
1666 PHRASE26
1667                     <RESTL TT16 1 = DC7 (TYPE LIST)>
1668                     <DEAD TT16>
1669                     <JUMP + AGAIN17>
1670                     <END \1aFIND_DECL>
1671 "Add an AUX variable spec to structure."
1672
1673 <SETG OBJ-BUILDERS '[VECTOR UVECTOR STRING BYTES ISTRING IBYTES IVECTOR IUVECTOR]>
1674
1675 <GDECL (OBJ-BUILDERS) <VECTOR [REST ATOM]>>
1676
1677 #WORD *33016410307*
1678 <GFCN \1aPAUX ("VALUE" ANY ATOM ANY ANY FIX) ATM4 OBJ5 DC6 NTUP7>
1679                     <TEMP OBJ16 AP10 TEMP23 OBJ2-11 TEMP29 TEMP30 TT9:NODE>
1680                     <INTGO>
1681                     <SET OBJ16 OBJ5>
1682                     <LOOP>
1683 AGAIN17
1684                     <INTGO>
1685                     <TYPE? OBJ16 <TYPE-CODE FORM> - PHRASE63>
1686                     <EMPL? OBJ16 + PHRASE63 (TYPE FORM)>
1687                     <NTHL OBJ16 1 = AP10>
1688                     <EQUAL? AP10 'STACK - BOOL22>
1689                     <EMPL? OBJ16 + BOOL22>
1690                     <RESTL OBJ16 1 = TEMP23 (TYPE LIST)>
1691                     <EMPL? TEMP23 + BOOL22>
1692                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
1693                     <EMPL? TEMP23 - BOOL22>
1694                     <DEAD TEMP23>
1695                     <RESTL OBJ16 1 = TEMP23 (TYPE LIST)>
1696                     <NTHL TEMP23 1 = OBJ2-11>
1697                     <DEAD TEMP23>
1698                     <TYPE? OBJ2-11 <TYPE-CODE FORM> - TAG26>
1699                     <EMPL? OBJ2-11 + TAG26 (TYPE FORM)>
1700                     <NTHL OBJ2-11 1 = TEMP23>
1701                     <GVAL 'OBJ-BUILDERS = TEMP29>
1702                     <TYPE? TEMP23 <TYPE-CODE ATOM> - TAG26>
1703                     <EMPUV? TEMP29 + TAG26>
1704                     <LOOP (TEMP23 VALUE) (TEMP29 LENGTH VALUE)>
1705 TAG27
1706                     <NTHUV TEMP29 1 = TEMP30>
1707                     <VEQUAL? TEMP30 TEMP23 + BOOL21>
1708                     <DEAD TEMP30>
1709                     <RESTUV TEMP29 1 = TEMP29 (TYPE VECTOR)>
1710                     <EMPUV? TEMP29 - TAG27>
1711 TAG26
1712                     <TYPE? OBJ2-11 <TYPE-CODE VECTOR> + BOOL21>
1713                     <TYPE? OBJ2-11 <TYPE-CODE UVECTOR> + BOOL21>
1714 BOOL22
1715                     <EQUAL? AP10 'CHTYPE - PHRASE20>
1716                     <SET TEMP29 OBJ16>
1717                     <SET TEMP23 3 (TYPE FIX)>
1718                     <LOOP (TEMP29 VALUE) (TEMP23 VALUE)>
1719 TAG32
1720                     <EMPL? TEMP29 + PHRASE20>
1721                     <RESTL TEMP29 1 = TEMP29 (TYPE LIST)>
1722                     <SUB TEMP23 1 = TEMP23 (TYPE FIX)>
1723                     <GRTR? TEMP23 0 + TAG32 (TYPE FIX)>
1724                     <EMPL? TEMP29 - PHRASE20>
1725                     <DEAD TEMP29>
1726                     <RESTL OBJ16 1 = TEMP29 (TYPE LIST)>
1727                     <NTHL TEMP29 1 = OBJ2-11>
1728                     <DEAD TEMP29>
1729                     <TYPE? OBJ2-11 <TYPE-CODE FORM> - PHRASE20>
1730                     <EMPL? OBJ2-11 + PHRASE20>
1731                     <RESTL OBJ2-11 1 = TEMP29 (TYPE LIST)>
1732                     <EMPL? TEMP29 + PHRASE20>
1733                     <RESTL TEMP29 1 = TEMP29 (TYPE LIST)>
1734                     <EMPL? TEMP29 - PHRASE20>
1735                     <DEAD TEMP29>
1736                     <NTHL OBJ2-11 1 = TEMP29>
1737                     <EQUAL? TEMP29 'STACK - PHRASE20>
1738                     <DEAD TEMP29>
1739                     <RESTL OBJ2-11 1 = TEMP29 (TYPE LIST)>
1740                     <DEAD OBJ2-11>
1741                     <NTHL TEMP29 1 = OBJ2-11>
1742                     <DEAD TEMP29>
1743                     <TYPE? OBJ2-11 <TYPE-CODE FORM> - TAG35>
1744                     <EMPL? OBJ2-11 + TAG35 (TYPE FORM)>
1745                     <NTHL OBJ2-11 1 = TEMP29>
1746                     <GVAL 'OBJ-BUILDERS = TEMP30>
1747                     <TYPE? TEMP29 <TYPE-CODE ATOM> - TAG35>
1748                     <EMPUV? TEMP30 + TAG35>
1749                     <LOOP (TEMP29 VALUE) (TEMP30 LENGTH VALUE)>
1750 TAG36
1751                     <NTHUV TEMP30 1 = TEMP23>
1752                     <VEQUAL? TEMP23 TEMP29 + TAG39>
1753                     <DEAD TEMP23>
1754                     <RESTUV TEMP30 1 = TEMP30 (TYPE VECTOR)>
1755                     <EMPUV? TEMP30 - TAG36>
1756 TAG35
1757                     <TYPE? OBJ2-11 <TYPE-CODE VECTOR> + TAG39>
1758                     <TYPE? OBJ2-11 <TYPE-CODE UVECTOR> - PHRASE20>
1759 TAG39
1760                     <RESTL OBJ16 1 = TEMP30 (TYPE LIST)>
1761                     <DEAD OBJ16>
1762                     <RESTL TEMP30 1 = TEMP30 (TYPE LIST)>
1763                     <NTHL TEMP30 1 = TEMP30>
1764                     <CONS TEMP30 () = TEMP30>
1765                     <CONS OBJ2-11 TEMP30 = TEMP30>
1766                     <DEAD OBJ2-11>
1767                     <CONS 'CHTYPE TEMP30 = TEMP30>
1768                     <CHTYPE TEMP30 <TYPE-CODE FORM> = OBJ2-11>
1769                     <DEAD TEMP30>
1770 BOOL21
1771                     <FRAME '\1aNODEFM>
1772                     <PUSH 98>
1773                     <PUSH ()>
1774                     <PUSH %<>>
1775                     <PUSH 'STACK>
1776                     <PUSH ()>
1777                     <PUSH 'STACK>
1778                     <CALL '\1aNODEFM 6 = TT9>
1779                     <FRAME '\1aPCOMP>
1780                     <PUSH OBJ2-11>
1781                     <DEAD OBJ2-11>
1782                     <PUSH TT9>
1783                     <CALL '\1aPCOMP 2 = TEMP30>
1784                     <CONS TEMP30 () = TEMP30>
1785                     <PUTUV TT9 5 TEMP30 (TYPE LIST)>
1786                     <DEAD TEMP30>
1787                     <JUMP + PHRASE66>
1788 PHRASE20
1789                     <EQUAL? AP10 'TUPLE - PHRASE42>
1790                     <FRAME '\1aNODEFM>
1791                     <PUSH 15>
1792                     <PUSH ()>
1793                     <PUSH 'TUPLE>
1794                     <PUSH AP10>
1795                     <PUSH ()>
1796                     <PUSH AP10>
1797                     <DEAD AP10>
1798                     <CALL '\1aNODEFM 6 = TT9>
1799                     <SET AP10 () (TYPE LIST)>
1800                     <SET TEMP29 () (TYPE LIST)>
1801                     <RESTL OBJ16 1 = TEMP23 (TYPE LIST)>
1802                     <DEAD OBJ16>
1803                     <CHTYPE TEMP23 <TYPE-CODE LIST> = TEMP23>
1804                     <LOOP>
1805 MAP45
1806                     <INTGO>
1807                     <EMPL? TEMP23 + MAPAP48>
1808                     <NTHL TEMP23 1 = OBJ16>
1809                     <FRAME '\1aPCOMP>
1810                     <PUSH OBJ16>
1811                     <DEAD OBJ16>
1812                     <PUSH TT9>
1813                     <CALL '\1aPCOMP 2 = OBJ16>
1814                     <CONS OBJ16 () = OBJ16 (TYPE LIST)>
1815                     <EMPL? AP10 - TAG56>
1816                     <SET AP10 OBJ16 (TYPE LIST)>
1817                     <JUMP + TAG57>
1818 TAG56
1819                     <PUTREST TEMP29 OBJ16>
1820                     <DEAD TEMP29>
1821 TAG57
1822                     <SET TEMP29 OBJ16 (TYPE LIST)>
1823                     <DEAD OBJ16>
1824                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
1825                     <JUMP + MAP45>
1826 MAPAP48
1827                     <PUTUV TT9 5 AP10 (TYPE LIST)>
1828                     <DEAD AP10>
1829                     <JUMP + PHRASE66>
1830 PHRASE42
1831                     <EQUAL? AP10 'ITUPLE - PHRASE58>
1832                     <GETS 'BIND = TEMP23 (TYPE LBIND)>
1833                     <BBIND 'PARENT 'ANY 'FIX ()>
1834                     <FRAME '\1aPSTRUC>
1835                     <PUSH OBJ16>
1836                     <DEAD OBJ16>
1837                     <PUSH 'ITUPLE>
1838                     <PUSH 'ITUPLE>
1839                     <PUSH 'TUPLE>
1840                     <CALL '\1aPSTRUC 4 = TT9>
1841                     <UNBIND TEMP23>
1842                     <DEAD TEMP23>
1843                     <ADJ -9>
1844                     <JUMP + PHRASE66>
1845 PHRASE58
1846                     <TYPE? AP10 <TYPE-CODE ATOM> - PHRASE63>
1847                     <NTHR AP10 1 = TEMP23 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE63)>
1848                     <TYPE? TEMP23 <TYPE-CODE FALSE> + PHRASE63>
1849                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE GBIND)>
1850                     <TYPE? TEMP23 <TYPE-CODE UNBOUND> + PHRASE63>
1851                     <DEAD TEMP23>
1852                     <GVAL AP10 = TEMP23>
1853                     <DEAD AP10>
1854                     <TYPE? TEMP23 <TYPE-CODE MACRO> - PHRASE63>
1855                     <DEAD TEMP23>
1856                     <FRAME '\1aEXPAND>
1857                     <PUSH OBJ16>
1858                     <DEAD OBJ16>
1859                     <CALL '\1aEXPAND 1 = OBJ16>
1860                     <JUMP + AGAIN17>
1861 PHRASE63
1862                     <FRAME '\1aPCOMP>
1863                     <PUSH OBJ5>
1864                     <DEAD OBJ5>
1865                     <PUSH ()>
1866                     <CALL '\1aPCOMP 2 = TT9>
1867 PHRASE66
1868                     <FRAME '\1aPUT-DCL>
1869                     <PUSH NTUP7>
1870                     <DEAD NTUP7>
1871                     <PUSH ATM4>
1872                     <DEAD ATM4>
1873                     <PUSH TT9>
1874                     <DEAD TT9>
1875                     <PUSH DC6>
1876                     <DEAD DC6>
1877                     <PUSH %<>>
1878                     <CALL '\1aPUT-DCL 5 = TEMP23>
1879                     <RETURN TEMP23>
1880                     <DEAD TEMP23>
1881                     <END \1aPAUX>
1882 "Main dispatch function during pass1."
1883
1884 #WORD *24570470634*
1885 <GFCN \1aPCOMP ("VALUE" NODE ANY ANY) OBJ4 PARENT5>
1886                     <TEMP TEMP3:LBIND TEMP8>
1887                     <INTGO>
1888                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
1889                     <BBIND 'PARENT 'ANY %<> PARENT5>
1890                     <DEAD PARENT5>
1891                     <FIXBIND>
1892                     <FRAME>
1893                     <FRAME '\1aGETPROP>
1894                     <PUSH OBJ4>
1895                     <PUSH 'PTHIS-OBJECT>
1896                     <CALL '\1aGETPROP 2 = TEMP8>
1897                     <TYPE? TEMP8 <TYPE-CODE FALSE> - BOOL7>
1898                     <FRAME '\1aGETPROP>
1899                     <FRAME '\1aTYPE>
1900                     <PUSH OBJ4>
1901                     <CALL '\1aTYPE 1 = STACK>
1902                     <PUSH 'PTHIS-TYPE>
1903                     <CALL '\1aGETPROP 2 = TEMP8>
1904                     <TYPE? TEMP8 <TYPE-CODE FALSE> - BOOL7>
1905                     <GVAL 'PDEFAULT = TEMP8>
1906 BOOL7
1907                     <PUSH OBJ4>
1908                     <DEAD OBJ4>
1909                     <ACALL TEMP8 1 = TEMP8>
1910                     <UNBIND TEMP3>
1911                     <DEAD TEMP3>
1912                     <ADJ -9>
1913                     <RETURN TEMP8>
1914                     <DEAD TEMP8>
1915                     <END \1aPCOMP>
1916 "Build a node for <> or #FALSE ()."
1917
1918 #WORD *20431306702*
1919 <GFCN \1aFALSE-QT ("VALUE" NODE ANY) O4>
1920                     <TEMP TEMP6>
1921                     <INTGO>
1922                     <FRAME '\1aNODE1>
1923                     <PUSH 2>
1924                     <GEN-LVAL 'PARENT = STACK>
1925                     <PUSH 'BOOL-FALSE>
1926                     <PUSH %<>>
1927                     <PUSH ()>
1928                     <CALL '\1aNODE1 5 = TEMP6>
1929                     <RETURN TEMP6>
1930                     <DEAD TEMP6>
1931                     <END \1aFALSE-QT>
1932 <COND (<GASSIGNED? FALSE-QT> <PUTPROP '<> PTHIS-OBJECT ,FALSE-QT>)>
1933
1934 "Build a node for ()."
1935
1936 #WORD *7711342443*
1937 <GFCN \1aNIL-QT ("VALUE" NODE ANY) O4>
1938                     <TEMP TEMP6>
1939                     <INTGO>
1940                     <FRAME '\1aNODE1>
1941                     <PUSH 2>
1942                     <GEN-LVAL 'PARENT = STACK>
1943                     <PUSH 'LIST>
1944                     <PUSH ()>
1945                     <PUSH ()>
1946                     <CALL '\1aNODE1 5 = TEMP6>
1947                     <RETURN TEMP6>
1948                     <DEAD TEMP6>
1949                     <END \1aNIL-QT>
1950 <COND (<GASSIGNED? NIL-QT> <PUTPROP () PTHIS-OBJECT ,NIL-QT>)>
1951
1952 "Build a node for a LIST, VECTOR or UVECTOR."
1953
1954 #WORD *16043463236*
1955 <GFCN \1aPCOPY ("VALUE" NODE ANY) OBJ4>
1956                     <TEMP TEMP7 TT5:NODE TEMP19 TEMP18 O23>
1957                     <INTGO>
1958                     <FRAME '\1aNODEFM>
1959                     <PUSH 15>
1960                     <GEN-LVAL 'PARENT = STACK>
1961                     <FRAME '\1aTYPE>
1962                     <PUSH OBJ4>
1963                     <CALL '\1aTYPE 1 = STACK>
1964                     <FRAME '\1aTYPE>
1965                     <PUSH OBJ4>
1966                     <CALL '\1aTYPE 1 = STACK>
1967                     <PUSH ()>
1968                     <PUSH %<>>
1969                     <CALL '\1aNODEFM 6 = TT5>
1970                     <SET TEMP7 () (TYPE LIST)>
1971                     <SET TEMP19 () (TYPE LIST)>
1972                     <SET TEMP18 OBJ4>
1973                     <DEAD OBJ4>
1974                     <LOOP>
1975 MAP13
1976                     <INTGO>
1977                     <EMPTY? TEMP18 + MAPAP16>
1978                     <NTH1 TEMP18 = O23>
1979                     <FRAME '\1aPCOMP>
1980                     <PUSH O23>
1981                     <DEAD O23>
1982                     <PUSH TT5>
1983                     <CALL '\1aPCOMP 2 = O23>
1984                     <CONS O23 () = O23 (TYPE LIST)>
1985                     <EMPL? TEMP7 - TAG26>
1986                     <SET TEMP7 O23 (TYPE LIST)>
1987                     <JUMP + TAG27>
1988 TAG26
1989                     <PUTREST TEMP19 O23>
1990                     <DEAD TEMP19>
1991 TAG27
1992                     <SET TEMP19 O23 (TYPE LIST)>
1993                     <DEAD O23>
1994                     <REST1 TEMP18 = TEMP18>
1995                     <JUMP + MAP13>
1996 MAPAP16
1997                     <PUTUV TT5 5 TEMP7 (TYPE LIST)>
1998                     <DEAD TEMP7>
1999                     <RETURN TT5>
2000                     <DEAD TT5>
2001                     <END \1aPCOPY>
2002 <COND (<GASSIGNED? PCOPY> <PUTPROP VECTOR PTHIS-TYPE ,PCOPY> <PUTPROP UVECTOR PTHIS-TYPE ,PCOPY> <PUTPROP LIST PTHIS-TYPE ,PCOPY>)>
2003
2004 "Build a node for unknown things."
2005
2006 #WORD *15233363660*
2007 <GFCN \1aPDEFAULT ("VALUE" NODE ANY) OBJ4>
2008                     <TEMP TEMP6>
2009                     <INTGO>
2010                     <FRAME '\1aNODE1>
2011                     <PUSH 2>
2012                     <GEN-LVAL 'PARENT = STACK>
2013                     <FRAME '\1aTYPE>
2014                     <PUSH OBJ4>
2015                     <CALL '\1aTYPE 1 = STACK>
2016                     <PUSH OBJ4>
2017                     <DEAD OBJ4>
2018                     <PUSH ()>
2019                     <CALL '\1aNODE1 5 = TEMP6>
2020                     <RETURN TEMP6>
2021                     <DEAD TEMP6>
2022                     <END \1aPDEFAULT>
2023 "Further analyze a FORM and build appropriate node."
2024
2025 #WORD *27242350624*
2026 <GFCN \1aPFORM ("VALUE" NODE <FORM ANY>) OBJ4>
2027                     <TEMP TEMP5>
2028                     <INTGO>
2029                     <ICALL EXIT6 = TEMP5>
2030                     <TEMP TEMP7 TEMP11 TEMP12>
2031                     <INTGO>
2032                     <CFRAME = TEMP7>
2033                     <NTHR TEMP7 5 = TEMP7 (RECORD-TYPE FRAME)>
2034                     <SETLR TEMP12 TEMP7 OBJ4>
2035                     <NTHL TEMP12 1 = TEMP11>
2036                     <DEAD TEMP12>
2037                     <BBIND 'APPLY 'ANY 'FIX TEMP11>
2038                     <DEAD TEMP11>
2039                     <CFRAME = TEMP11 (TYPE FRAME)>
2040                     <BBIND 'APPLICATION 'ANY 'FIX TEMP11>
2041                     <DEAD TEMP11>
2042                     <ACTIVATION>
2043                     <FRAME>
2044                     <FRAME '\1aGETPROP>
2045                     <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2046                     <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2047                     <DEAD TEMP12>
2048                     <PUSH 'PAPPLY-OBJECT>
2049                     <CALL '\1aGETPROP 2 = TEMP11>
2050                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL15>
2051                     <FRAME '\1aGETPROP>
2052                     <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2053                     <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2054                     <DEAD TEMP12>
2055                     <PUSH 'ANALYSIS>
2056                     <CALL '\1aGETPROP 2 = TEMP12>
2057                     <TYPE? TEMP12 <TYPE-CODE FALSE> + BOOL19>
2058                     <DEAD TEMP12>
2059                     <GVAL 'PSUBR-C = TEMP11>
2060                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL15>
2061 BOOL19
2062                     <FRAME '\1aGETPROP>
2063                     <FRAME '\1aTYPE>
2064                     <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2065                     <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2066                     <DEAD TEMP12>
2067                     <CALL '\1aTYPE 1 = STACK>
2068                     <PUSH 'PAPPLY-TYPE>
2069                     <CALL '\1aGETPROP 2 = TEMP11>
2070                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL15>
2071                     <GVAL 'PAPDEF = TEMP11>
2072 BOOL15
2073                     <SETLR TEMP12 TEMP7 OBJ4>
2074                     <PUSH TEMP12>
2075                     <DEAD TEMP12>
2076                     <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2077                     <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2078                     <DEAD TEMP12>
2079                     <ACALL TEMP11 2 = TEMP11>
2080                     <RETURN TEMP11>
2081                     <DEAD TEMP11>
2082 EXIT6
2083                     <RETURN TEMP5>
2084                     <DEAD TEMP5>
2085                     <END \1aPFORM>
2086 <COND (<GASSIGNED? PFORM> <PUTPROP FORM PTHIS-TYPE ,PFORM>)>
2087
2088 "Build a SEGMENT node."
2089
2090 #WORD *31057654523*
2091 <GFCN \1aSEG-FCN ("VALUE" NODE ANY) OBJ4>
2092                     <TEMP TEMP7 TT5:NODE TEMP12:LBIND>
2093                     <INTGO>
2094                     <FRAME '\1aNODE1>
2095                     <PUSH 3>
2096                     <GEN-LVAL 'PARENT = STACK>
2097                     <PUSH %<>>
2098                     <PUSH %<>>
2099                     <PUSH ()>
2100                     <CALL '\1aNODE1 5 = TT5>
2101                     <GETS 'BIND = TEMP12 (TYPE LBIND)>
2102                     <BBIND 'PARENT 'NODE 'FIX TT5>
2103                     <FRAME '\1aPFORM>
2104                     <CHTYPE OBJ4 <TYPE-CODE FORM> = STACK>
2105                     <DEAD OBJ4>
2106                     <CALL '\1aPFORM 1 = TEMP7>
2107                     <CONS TEMP7 () = TEMP7>
2108                     <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2109                     <DEAD TEMP7>
2110                     <UNBIND TEMP12>
2111                     <DEAD TEMP12>
2112                     <ADJ -9>
2113                     <RETURN TT5>
2114                     <DEAD TT5>
2115                     <END \1aSEG-FCN>
2116 <COND (<GASSIGNED? SEG-FCN> <PUTPROP SEGMENT PTHIS-TYPE ,SEG-FCN>)>
2117
2118 "Analyze a form or the form <ATM .....>"
2119
2120 #WORD *35676301112*
2121                     <GFCN \1aATOM-FCN ("VALUE" ANY ANY ATOM) OB4 AP5>
2122                     <TEMP TEMP9 L6 TEMP29:FIX>
2123                     <INTGO>
2124                     <NTHR AP5 1 = TEMP9 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE8)>
2125                     <TYPE? TEMP9 <TYPE-CODE FALSE> + PHRASE8>
2126                     <NTHR TEMP9 1 = TEMP9 (RECORD-TYPE GBIND)>
2127                     <TYPE? TEMP9 <TYPE-CODE UNBOUND> + PHRASE8>
2128                     <DEAD TEMP9>
2129                     <GVAL AP5 = TEMP9>
2130                     <DEAD AP5>
2131                     <GEN-SET 'APPLY TEMP9>
2132                     <DEAD TEMP9>
2133                     <FRAME '\1aAGAIN>
2134                     <GEN-LVAL 'APPLICATION = STACK>
2135                     <CALL '\1aAGAIN 1 = TEMP9>
2136                     <RETURN TEMP9>
2137                     <DEAD TEMP9>
2138 PHRASE8
2139                     <GEN-LVAL 'REASONABLE = TEMP9>
2140                     <TYPE? TEMP9 <TYPE-CODE FALSE> + PHRASE16>
2141                     <DEAD TEMP9>
2142                     <NTHR 'REFERENCED 1 = TEMP9 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG22)>
2143                     <TYPE? TEMP9 <TYPE-CODE FALSE> + TAG22>
2144                     <NTHR TEMP9 1 = TEMP9 (RECORD-TYPE GBIND)>
2145                     <TYPE? TEMP9 <TYPE-CODE UNBOUND> - PHRASE21>
2146                     <DEAD TEMP9>
2147 TAG22
2148                     <CONS 1 () = TEMP9>
2149                     <CONS AP5 TEMP9 = TEMP9>
2150                     <DEAD AP5>
2151                     <SETG 'REFERENCED TEMP9>
2152                     <DEAD TEMP9>
2153                     <JUMP + PHRASE38>
2154 PHRASE21
2155                     <GVAL 'REFERENCED = L6>
2156                     <EMPL? L6 + TAG25>
2157                     <LOOP (AP5 VALUE) (L6 VALUE)>
2158 TAG26
2159                     <NTHL L6 1 = TEMP9>
2160                     <TYPE? TEMP9 <TYPE-CODE ATOM> - TAG27>
2161                     <VEQUAL? TEMP9 AP5 + PHRASE23>
2162                     <DEAD TEMP9>
2163 TAG27
2164                     <RESTL L6 1 = L6 (TYPE LIST)>
2165                     <EMPL? L6 - TAG26>
2166 TAG25
2167                     <PUSH AP5>
2168                     <DEAD AP5>
2169                     <PUSH 1>
2170                     <SET TEMP29 2 (TYPE FIX)>
2171                     <GVAL 'REFERENCED = TEMP9>
2172                     <TYPE TEMP9 = L6>
2173                     <AND L6 7 = L6>
2174                     <VEQUAL? L6 1 + TAG31>
2175                     <DEAD L6>
2176                     <LOOP (TEMP9 TYPE VALUE LENGTH) (TEMP29 VALUE)>
2177 TAG37
2178                     <INTGO>
2179                     <EMPTY? TEMP9 + TAG36>
2180                     <NTH1 TEMP9 = STACK>
2181                     <REST1 TEMP9 = TEMP9>
2182                     <ADD TEMP29 1 = TEMP29 (TYPE FIX)>
2183                     <JUMP + TAG37>
2184 TAG36
2185                     <LIST TEMP29 = TEMP9 (TYPE LIST)>
2186                     <DEAD TEMP29>
2187                     <JUMP + TAG33>
2188 TAG31
2189                     <LOOP>
2190 TAG34
2191                     <VEQUAL? TEMP29 0 + TAG33>
2192                     <POP = L6>
2193                     <CONS L6 TEMP9 = TEMP9 (TYPE LIST)>
2194                     <DEAD L6>
2195                     <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
2196                     <JUMP + TAG34>
2197 TAG33
2198                     <SETG 'REFERENCED TEMP9>
2199                     <DEAD TEMP9>
2200                     <JUMP + PHRASE38>
2201 PHRASE23
2202                     <RESTL L6 1 = TEMP9 (TYPE LIST)>
2203                     <NTHL TEMP9 1 = TEMP9 (TYPE FIX)>
2204                     <ADD TEMP9 1 = TEMP9 (TYPE FIX)>
2205                     <RESTL L6 1 = L6 (TYPE LIST)>
2206                     <PUTL L6 1 TEMP9>
2207                     <DEAD L6 TEMP9>
2208 PHRASE38
2209                     <FRAME '\1aPSUBR-C>
2210                     <PUSH OB4>
2211                     <DEAD OB4>
2212                     <PUSH 'DUMMY>
2213                     <CALL '\1aPSUBR-C 2 = TEMP9>
2214                     <RETURN TEMP9>
2215                     <DEAD TEMP9>
2216 PHRASE16
2217                     <FRAME '\1aCOMPILE-WARNING>
2218                     <PUSH "No value for:  ">
2219                     <PUSH AP5>
2220                     <PUSH " using EVAL">
2221                     <CALL '\1aCOMPILE-WARNING 3>
2222                     <FRAME '\1aPAPDEF>
2223                     <PUSH OB4>
2224                     <DEAD OB4>
2225                     <PUSH AP5>
2226                     <DEAD AP5>
2227                     <CALL '\1aPAPDEF 2 = TEMP9>
2228                     <RETURN TEMP9>
2229                     <DEAD TEMP9>
2230                     <END \1aATOM-FCN>
2231
2232 <COND (<GASSIGNED? ATOM-FCN> <PUTPROP ATOM PAPPLY-TYPE ,ATOM-FCN>)>
2233
2234 "Expand MACRO and process result."
2235
2236 <NEWTYPE FUNNY VECTOR>
2237
2238 #WORD *16333225151*
2239 <GFCN \1aPMACRO ("VALUE" ANY ANY ANY) OBJ4 AP5>
2240                     <TEMP ERR6 TEM7>
2241                     <INTGO>
2242                     <FRAME '\1aON>
2243                     <FRAME '\1aHANDLER>
2244                     <PUSH "ERROR">
2245                     <GVAL 'MACROERR = STACK>
2246                     <PUSH 100>
2247                     <CALL '\1aHANDLER 3 = ERR6>
2248                     <PUSH ERR6>
2249                     <CALL '\1aON 1>
2250                     <ICALL EXIT10 = TEM7>
2251                     <TEMP TEMP11 TEMP14>
2252                     <INTGO>
2253                     <CFRAME = TEMP11>
2254                     <NTHR TEMP11 5 = TEMP11 (RECORD-TYPE FRAME)>
2255                     <CFRAME = TEMP14 (TYPE FRAME)>
2256                     <BBIND 'MACACT 'ANY 'FIX TEMP14>
2257                     <DEAD TEMP14>
2258                     <ACTIVATION>
2259                     <SETLR TEMP14 TEMP11 ERR6>
2260                     <SETG 'ERR TEMP14>
2261                     <DEAD TEMP14>
2262                     <NTHR 'MACACT 2 = TEMP14 (RECORD-TYPE ATOM) (TYPE LBIND)>
2263                     <NTHR TEMP14 1 = TEMP14 (RECORD-TYPE LBIND)>
2264                     <SETG 'MACACT TEMP14>
2265                     <DEAD TEMP14>
2266                     <FRAME '\1aEXPAND>
2267                     <SETLR TEMP14 TEMP11 OBJ4>
2268                     <PUSH TEMP14>
2269                     <DEAD TEMP14>
2270                     <CALL '\1aEXPAND 1 = TEMP14>
2271                     <RETURN TEMP14>
2272                     <DEAD TEMP14>
2273 EXIT10
2274                     <FRAME '\1aOFF>
2275                     <PUSH ERR6>
2276                     <DEAD ERR6>
2277                     <CALL '\1aOFF 1>
2278                     <TYPE? TEM7 <TYPE-CODE FUNNY> - PHRASE21>
2279                     <FRAME '\1aCOMPILE-ERROR>
2280                     <PUSH "ERROR during macro expansion">
2281                     <GVAL 'CR = STACK>
2282                     <SET ERR6 2 (TYPE FIX)>
2283                     <LOOP (TEM7 VALUE LENGTH) (ERR6 VALUE)>
2284 TAG25
2285                     <INTGO>
2286                     <EMPUV? TEM7 + TAG22>
2287                     <NTHUV TEM7 1 = STACK>
2288                     <RESTUV TEM7 1 = TEM7 (TYPE VECTOR)>
2289                     <ADD ERR6 1 = ERR6 (TYPE FIX)>
2290                     <JUMP + TAG25>
2291 TAG22
2292                     <CALL '\1aCOMPILE-ERROR ERR6 = ERR6>
2293                     <RETURN ERR6>
2294                     <DEAD ERR6>
2295 PHRASE21
2296                     <FRAME '\1aPCOMP>
2297                     <PUSH TEM7>
2298                     <DEAD TEM7>
2299                     <GEN-LVAL 'PARENT = STACK>
2300                     <CALL '\1aPCOMP 2 = ERR6>
2301                     <RETURN ERR6>
2302                     <DEAD ERR6>
2303                     <END \1aPMACRO>
2304 <COND (<GASSIGNED? PMACRO> <PUTPROP MACRO PAPPLY-TYPE ,PMACRO>)>
2305
2306 #WORD *17241071460*
2307 <GFCN \1aMACROERR ("VALUE" ANY ANY ANY "TUPLE" TUPLE) IGN4 FR5>
2308                     <MAKTUP T6:TUPLE TEMP10 TEMP14 = T6>
2309                     <INTGO>
2310                     <EMPUV? T6 + PHRASE8 (TYPE TUPLE)>
2311                     <NTHUV T6 1 = TEMP10>
2312                     <EQUAL? TEMP10 'CONTROL-G!-ERRORS - PHRASE8>
2313                     <DEAD TEMP10>
2314                     <FRAME '\1aINT-LEVEL>
2315                     <PUSH 0>
2316                     <CALL '\1aINT-LEVEL 1>
2317                     <FRAME '\1aOFF>
2318                     <GVAL 'ERR = STACK>
2319                     <CALL '\1aOFF 1>
2320                     <FRAME '\1aERROR>
2321                     <SET TEMP14 0 (TYPE FIX)>
2322                     <SET TEMP10 T6>
2323                     <DEAD T6>
2324                     <LOOP (TEMP10 VALUE LENGTH) (TEMP14 VALUE)>
2325 TAG15
2326                     <INTGO>
2327                     <EMPUV? TEMP10 + TAG13>
2328                     <NTHUV TEMP10 1 = STACK>
2329                     <RESTUV TEMP10 1 = TEMP10 (TYPE VECTOR)>
2330                     <ADD TEMP14 1 = TEMP14 (TYPE FIX)>
2331                     <JUMP + TAG15>
2332 TAG13
2333                     <CALL '\1aERROR TEMP14>
2334                     <DEAD TEMP14>
2335                     <FRAME '\1aON>
2336                     <GVAL 'ERR = STACK>
2337                     <CALL '\1aON 1>
2338                     <FRAME '\1aERRET>
2339                     <PUSH 'T>
2340                     <PUSH FR5>
2341                     <DEAD FR5>
2342                     <CALL '\1aERRET 2 = TEMP14>
2343                     <RETURN TEMP14>
2344                     <DEAD TEMP14>
2345 PHRASE8
2346                     <NTHR 'MACACT 1 = TEMP10 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE19)>
2347                     <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE19>
2348                     <NTHR TEMP10 1 = TEMP10 (RECORD-TYPE GBIND)>
2349                     <TYPE? TEMP10 <TYPE-CODE UNBOUND> + PHRASE19>
2350                     <DEAD TEMP10>
2351                     <FRAME '\1aLEGAL?>
2352                     <GVAL 'MACACT = STACK>
2353                     <CALL '\1aLEGAL? 1 = TEMP10>
2354                     <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE19>
2355                     <DEAD TEMP10>
2356                     <FRAME '\1aDISMISS>
2357                     <SET TEMP14 0 (TYPE FIX)>
2358                     <SET TEMP10 T6>
2359                     <DEAD T6>
2360                     <LOOP (TEMP10 VALUE LENGTH) (TEMP14 VALUE)>
2361 TAG25
2362                     <INTGO>
2363                     <EMPUV? TEMP10 + TAG23>
2364                     <NTHUV TEMP10 1 = STACK>
2365                     <RESTUV TEMP10 1 = TEMP10 (TYPE VECTOR)>
2366                     <ADD TEMP14 1 = TEMP14 (TYPE FIX)>
2367                     <JUMP + TAG25>
2368 TAG23
2369                     <UBLOCK <TYPE-CODE VECTOR> TEMP14 = TEMP10>
2370                     <DEAD TEMP14>
2371                     <CHTYPE TEMP10 <TYPE-CODE FUNNY> = STACK>
2372                     <DEAD TEMP10>
2373                     <GVAL 'MACACT = STACK>
2374                     <CALL '\1aDISMISS 2 = TEMP14>
2375                     <RETURN TEMP14>
2376                     <DEAD TEMP14>
2377 PHRASE19
2378                     <FRAME '\1aOFF>
2379                     <GVAL 'ERR = STACK>
2380                     <CALL '\1aOFF 1>
2381                     <FRAME '\1aERROR>
2382                     <PUSH 'INTERNAL-COMPILER-LOSSAGE!-ERRORS>
2383                     <CALL '\1aERROR 1 = TEMP14>
2384                     <RETURN TEMP14>
2385                     <DEAD TEMP14>
2386                     <END \1aMACROERR>
2387 "Build a node for a form whose 1st element is a form (could be NTH)."
2388
2389 #WORD *13657631562*
2390 <GFCN \1aPFORM-FORM ("VALUE" NODE FORM ANY) OBJ4 AP5>
2391                     <TEMP TEMP10 TT6:NODE TEMP22 TEMP21 O26>
2392                     <INTGO>
2393                     <EMPL? OBJ4 + PHRASE8>
2394                     <RESTL OBJ4 1 = TEMP10 (TYPE LIST)>
2395                     <EMPL? TEMP10 + PHRASE8>
2396                     <RESTL TEMP10 1 = TEMP10 (TYPE LIST)>
2397                     <EMPL? TEMP10 - PHRASE8>
2398                     <DEAD TEMP10>
2399                     <FRAME '\1aSEG?>
2400                     <PUSH OBJ4>
2401                     <CALL '\1aSEG? 1 = TEMP10>
2402                     <VEQUAL? TEMP10 0 - PHRASE8>
2403                     <DEAD TEMP10>
2404                     <FRAME '\1aNODEFM>
2405                     <PUSH 74>
2406                     <GEN-LVAL 'PARENT = STACK>
2407                     <PUSH %<>>
2408                     <PUSH OBJ4>
2409                     <PUSH ()>
2410                     <PUSH AP5>
2411                     <DEAD AP5>
2412                     <CALL '\1aNODEFM 6 = TT6>
2413                     <SET TEMP10 () (TYPE LIST)>
2414                     <SET TEMP22 () (TYPE LIST)>
2415                     <CHTYPE OBJ4 <TYPE-CODE LIST> = TEMP21>
2416                     <DEAD OBJ4>
2417                     <LOOP>
2418 MAP16
2419                     <INTGO>
2420                     <EMPL? TEMP21 + MAPAP19>
2421                     <NTHL TEMP21 1 = O26>
2422                     <FRAME '\1aPCOMP>
2423                     <PUSH O26>
2424                     <DEAD O26>
2425                     <PUSH TT6>
2426                     <CALL '\1aPCOMP 2 = O26>
2427                     <CONS O26 () = O26 (TYPE LIST)>
2428                     <EMPL? TEMP10 - TAG29>
2429                     <SET TEMP10 O26 (TYPE LIST)>
2430                     <JUMP + TAG30>
2431 TAG29
2432                     <PUTREST TEMP22 O26>
2433                     <DEAD TEMP22>
2434 TAG30
2435                     <SET TEMP22 O26 (TYPE LIST)>
2436                     <DEAD O26>
2437                     <RESTL TEMP21 1 = TEMP21 (TYPE LIST)>
2438                     <JUMP + MAP16>
2439 MAPAP19
2440                     <PUTUV TT6 5 TEMP10 (TYPE LIST)>
2441                     <DEAD TEMP10>
2442                     <RETURN TT6>
2443                     <DEAD TT6>
2444 PHRASE8
2445                     <FRAME '\1aPAPDEF>
2446                     <PUSH OBJ4>
2447                     <DEAD OBJ4>
2448                     <PUSH AP5>
2449                     <DEAD AP5>
2450                     <CALL '\1aPAPDEF 2 = TEMP21>
2451                     <RETURN TEMP21>
2452                     <DEAD TEMP21>
2453                     <END \1aPFORM-FORM>
2454 <COND (<GASSIGNED? PFORM-FORM> <PUTPROP FORM PAPPLY-TYPE ,PFORM-FORM>)>
2455
2456 "Build a node for strange forms."
2457
2458 #WORD *37543221101*
2459 <GFCN \1aPAPDEF ("VALUE" NODE ANY ANY) OBJ4 AP5>
2460                     <TEMP TEMP9>
2461                     <INTGO>
2462                     <FRAME '\1aCOMPILE-WARNING>
2463                     <PUSH "Form not being compiled:  ">
2464                     <PUSH OBJ4>
2465                     <CALL '\1aCOMPILE-WARNING 2>
2466                     <FRAME '\1aSPECIALIZE>
2467                     <PUSH OBJ4>
2468                     <CALL '\1aSPECIALIZE 1>
2469                     <FRAME '\1aNODEFM>
2470                     <PUSH 4>
2471                     <GEN-LVAL 'PARENT = STACK>
2472                     <PUSH %<>>
2473                     <PUSH OBJ4>
2474                     <DEAD OBJ4>
2475                     <PUSH ()>
2476                     <PUSH AP5>
2477                     <DEAD AP5>
2478                     <CALL '\1aNODEFM 6 = TEMP9>
2479                     <RETURN TEMP9>
2480                     <DEAD TEMP9>
2481                     <END \1aPAPDEF>
2482 "For objects that require EVAL, make sure all atoms used are special."
2483
2484 #WORD *4543022214*
2485 <GFCN \1aSPECIALIZE ("VALUE" ANY ANY) OBJ4>
2486                     <TEMP OB8 T1-5:FIX TEMP15 SYM7>
2487                     <INTGO>
2488                     <TYPE? OBJ4 <TYPE-CODE FORM> + TAG12>
2489                     <TYPE? OBJ4 <TYPE-CODE SEGMENT> - PHRASE19>
2490 TAG12
2491                     <CHTYPE OBJ4 <TYPE-CODE FORM> = OB8>
2492                     <LENL OB8 = T1-5 (TYPE FIX)>
2493                     <VEQUAL? T1-5 2 - BOOL14 (TYPE FIX)>
2494                     <NTHL OB8 1 = TEMP15>
2495                     <EQUAL? TEMP15 'LVAL - BOOL14>
2496                     <DEAD TEMP15>
2497                     <RESTL OB8 1 = TEMP15 (TYPE LIST)>
2498                     <NTHL TEMP15 1 = SYM7>
2499                     <DEAD TEMP15>
2500                     <TYPE? SYM7 <TYPE-CODE ATOM> + BOOL13>
2501 BOOL14
2502                     <VEQUAL? T1-5 3 - PHRASE19 (TYPE FIX)>
2503                     <DEAD T1-5>
2504                     <NTHL OB8 1 = TEMP15>
2505                     <EQUAL? TEMP15 'SET - PHRASE19>
2506                     <DEAD TEMP15>
2507                     <RESTL OB8 1 = TEMP15 (TYPE LIST)>
2508                     <DEAD OB8>
2509                     <NTHL TEMP15 1 = SYM7>
2510                     <DEAD TEMP15>
2511                     <TYPE? SYM7 <TYPE-CODE ATOM> - PHRASE19>
2512 BOOL13
2513                     <FRAME '\1aSRCH-SYM>
2514                     <PUSH SYM7>
2515                     <CALL '\1aSRCH-SYM 1 = OB8>
2516                     <VEQUAL? OB8 0 + PHRASE19>
2517                     <NTHUV OB8 3 = TEMP15>
2518                     <TYPE? TEMP15 <TYPE-CODE FALSE> - PHRASE19>
2519                     <DEAD TEMP15>
2520                     <FRAME '\1aCOMPILE-NOTE>
2521                     <PUSH "Redclared special:  ">
2522                     <PUSH SYM7>
2523                     <DEAD SYM7>
2524                     <CALL '\1aCOMPILE-NOTE 2>
2525                     <PUTUV OB8 3 'T>
2526                     <DEAD OB8>
2527 PHRASE19
2528                     <FRAME '\1aPRIMTYPE>
2529                     <PUSH OBJ4>
2530                     <CALL '\1aPRIMTYPE 1 = SYM7>
2531                     <SET TEMP15 [FORM LIST UVECTOR VECTOR] (TYPE VECTOR)>
2532                     <LOOP (SYM7 VALUE) (TEMP15 LENGTH VALUE)>
2533 TAG25
2534                     <NTHUV TEMP15 1 = OB8>
2535                     <VEQUAL? OB8 SYM7 + TAG24>
2536                     <DEAD OB8>
2537                     <RESTUV TEMP15 1 = TEMP15 (TYPE VECTOR)>
2538                     <EMPUV? TEMP15 - TAG25>
2539                     <RETURN %<>>
2540 TAG24
2541                     <SET OB8 %<> (TYPE FALSE)>
2542                     <SET SYM7 OBJ4>
2543                     <DEAD OBJ4>
2544                     <LOOP>
2545 MAP31
2546                     <INTGO>
2547                     <EMPTY? SYM7 + MAP30>
2548                     <FRAME '\1aSPECIALIZE>
2549                     <NTH1 SYM7 = STACK>
2550                     <CALL '\1aSPECIALIZE 1 = OB8>
2551                     <REST1 SYM7 = SYM7>
2552                     <JUMP + MAP31>
2553 MAP30
2554                     <RETURN OB8>
2555                     <DEAD OB8>
2556                     <END \1aSPECIALIZE>
2557 "Build a MSUBR call node."
2558
2559 #WORD *25171440235*
2560 <GFCN \1aPSUBR-C ("VALUE" NODE FORM ANY) OBJ4 AP5>
2561                     <TEMP TEMP8 TT6:NODE TEMP21 TEMP25:LIST O26>
2562                     <INTGO>
2563                     <FRAME '\1aNODEFM>
2564                     <PUSH 6>
2565                     <GEN-LVAL 'PARENT = STACK>
2566                     <PUSH %<>>
2567                     <TYPE? AP5 <TYPE-CODE MSUBR> - PHRASE12>
2568                     <NTHUV AP5 2 = TEMP8>
2569                     <JUMP + PHRASE14>
2570 PHRASE12
2571                     <NTHL OBJ4 1 = TEMP8>
2572 PHRASE14
2573                     <PUSH TEMP8>
2574                     <DEAD TEMP8>
2575                     <PUSH ()>
2576                     <PUSH AP5>
2577                     <DEAD AP5>
2578                     <CALL '\1aNODEFM 6 = TT6>
2579                     <SET TEMP8 () (TYPE LIST)>
2580                     <SET TEMP21 () (TYPE LIST)>
2581                     <RESTL OBJ4 1 = TEMP25 (TYPE LIST)>
2582                     <DEAD OBJ4>
2583                     <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
2584                     <LOOP>
2585 MAP16
2586                     <INTGO>
2587                     <EMPL? TEMP25 + MAPAP19>
2588                     <NTHL TEMP25 1 = O26>
2589                     <FRAME '\1aPCOMP>
2590                     <PUSH O26>
2591                     <DEAD O26>
2592                     <PUSH TT6>
2593                     <CALL '\1aPCOMP 2 = O26>
2594                     <CONS O26 () = O26 (TYPE LIST)>
2595                     <EMPL? TEMP8 - TAG29>
2596                     <SET TEMP8 O26 (TYPE LIST)>
2597                     <JUMP + TAG30>
2598 TAG29
2599                     <PUTREST TEMP21 O26>
2600                     <DEAD TEMP21>
2601 TAG30
2602                     <SET TEMP21 O26 (TYPE LIST)>
2603                     <DEAD O26>
2604                     <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
2605                     <JUMP + MAP16>
2606 MAPAP19
2607                     <PUTUV TT6 5 TEMP8 (TYPE LIST)>
2608                     <DEAD TEMP8>
2609                     <RETURN TT6>
2610                     <DEAD TT6>
2611                     <END \1aPSUBR-C>
2612 #WORD *76207176*
2613 <GFCN \1aLVAL-FCN ("VALUE" NODE ANY) OBJ4>
2614                     <TEMP TEMP7 TT5:NODE>
2615                     <INTGO>
2616                     <FRAME '\1aNODEFM>
2617                     <PUSH 6>
2618                     <GEN-LVAL 'PARENT = STACK>
2619                     <PUSH %<>>
2620                     <PUSH 'LVAL>
2621                     <PUSH ()>
2622                     <GVAL 'LVAL = STACK>
2623                     <CALL '\1aNODEFM 6 = TT5>
2624                     <FRAME '\1aPCOMP>
2625                     <CHTYPE OBJ4 <TYPE-CODE ATOM> = STACK>
2626                     <DEAD OBJ4>
2627                     <PUSH TT5>
2628                     <CALL '\1aPCOMP 2 = TEMP7>
2629                     <CONS TEMP7 () = TEMP7>
2630                     <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2631                     <DEAD TEMP7>
2632                     <RETURN TT5>
2633                     <DEAD TT5>
2634                     <END \1aLVAL-FCN>
2635 #WORD *7076207177*
2636 <GFCN \1aGVAL-FCN ("VALUE" NODE ANY) OBJ4>
2637                     <TEMP TEMP7 TT5:NODE>
2638                     <INTGO>
2639                     <FRAME '\1aNODEFM>
2640                     <PUSH 6>
2641                     <GEN-LVAL 'PARENT = STACK>
2642                     <PUSH %<>>
2643                     <PUSH 'GVAL>
2644                     <PUSH ()>
2645                     <GVAL 'GVAL = STACK>
2646                     <CALL '\1aNODEFM 6 = TT5>
2647                     <FRAME '\1aPCOMP>
2648                     <CHTYPE OBJ4 <TYPE-CODE ATOM> = STACK>
2649                     <DEAD OBJ4>
2650                     <PUSH TT5>
2651                     <CALL '\1aPCOMP 2 = TEMP7>
2652                     <CONS TEMP7 () = TEMP7>
2653                     <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2654                     <DEAD TEMP7>
2655                     <RETURN TT5>
2656                     <DEAD TT5>
2657                     <END \1aGVAL-FCN>
2658 <COND (<GASSIGNED? LVAL-FCN> <PUTPROP LVAL PTHIS-TYPE ,LVAL-FCN> <PUTPROP GVAL PTHIS-TYPE ,GVAL-FCN>)>
2659
2660 #WORD *27240733145*
2661 <GFCN \1aFIX-FCN ("VALUE" NODE FORM ANY) OBJ4 AP5>
2662                     <TEMP LN7 TEMP13 TT6:NODE TEMP25>
2663                     <INTGO>
2664                     <LENL OBJ4 = LN7 (TYPE FIX)>
2665                     <VEQUAL? LN7 2 + PHRASE9 (TYPE FIX)>
2666                     <VEQUAL? LN7 3 + PHRASE9 (TYPE FIX)>
2667                     <FRAME '\1aCOMPILE-ERROR>
2668                     <PUSH "Number (FIX) applied to other than 2 or 3 args:  ">
2669                     <PUSH OBJ4>
2670                     <CALL '\1aCOMPILE-ERROR 2>
2671 PHRASE9
2672                     <FRAME '\1aNODEFM>
2673                     <PUSH 6>
2674                     <GEN-LVAL 'PARENT = STACK>
2675                     <PUSH %<>>
2676                     <VEQUAL? LN7 2 - PHRASE17 (TYPE FIX)>
2677                     <SET TEMP13 'INTH (TYPE ATOM)>
2678                     <JUMP + PHRASE19>
2679 PHRASE17
2680                     <SET TEMP13 'IPUT (TYPE ATOM)>
2681 PHRASE19
2682                     <PUSH TEMP13>
2683                     <DEAD TEMP13>
2684                     <PUSH ()>
2685                     <VEQUAL? LN7 2 - PHRASE21 (TYPE FIX)>
2686                     <GVAL 'NTH = TEMP13>
2687                     <JUMP + PHRASE22>
2688 PHRASE21
2689                     <GVAL 'PUT = TEMP13>
2690 PHRASE22
2691                     <PUSH TEMP13>
2692                     <DEAD TEMP13>
2693                     <CALL '\1aNODEFM 6 = TT6>
2694                     <FRAME '\1aPCOMP>
2695                     <RESTL OBJ4 1 = TEMP13 (TYPE LIST)>
2696                     <NTHL TEMP13 1 = STACK>
2697                     <DEAD TEMP13>
2698                     <PUSH TT6>
2699                     <CALL '\1aPCOMP 2 = TEMP13>
2700                     <CONS TEMP13 () = TEMP13>
2701                     <FRAME '\1aPCOMP>
2702                     <PUSH AP5>
2703                     <DEAD AP5>
2704                     <PUSH TT6>
2705                     <CALL '\1aPCOMP 2 = TEMP25>
2706                     <CONS TEMP25 () = TEMP25>
2707                     <PUTREST TEMP13 TEMP25>
2708                     <VEQUAL? LN7 2 - PHRASE27 (TYPE FIX)>
2709                     <DEAD LN7>
2710                     <SET LN7 () (TYPE LIST)>
2711                     <JUMP + PHRASE29>
2712 PHRASE27
2713                     <FRAME '\1aPCOMP>
2714                     <RESTL OBJ4 1 = LN7 (TYPE LIST)>
2715                     <DEAD OBJ4>
2716                     <RESTL LN7 1 = LN7 (TYPE LIST)>
2717                     <NTHL LN7 1 = STACK>
2718                     <DEAD LN7>
2719                     <PUSH TT6>
2720                     <CALL '\1aPCOMP 2 = LN7>
2721                     <CONS LN7 () = LN7>
2722 PHRASE29
2723                     <PUTREST TEMP25 LN7>
2724                     <DEAD TEMP25 LN7>
2725                     <PUTUV TT6 5 TEMP13 (TYPE LIST)>
2726                     <DEAD TEMP13>
2727                     <RETURN TT6>
2728                     <DEAD TT6>
2729                     <END \1aFIX-FCN>
2730 <COND (<GASSIGNED? FIX-FCN> <PUTPROP FIX PAPPLY-TYPE ,FIX-FCN> <PUTPROP OFFSET PAPPLY-TYPE ,FIX-FCN>)>
2731
2732 "PROG/REPEAT node."
2733
2734 #WORD *36177460175*
2735 <GFCN \1aPPROG-REPEAT ("VALUE" NODE <PRIMTYPE LIST> ANY) OBJ4 AP5>
2736                     <TEMP NAME6 (DCL8 #DECL ()) (HATOM9 %<>) TEMP3:LBIND TEMP13 ARGL10:LIST TT7:NODE>
2737                     <INTGO>
2738                     <NTHL OBJ4 1 = NAME6>
2739                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
2740                     <GEN-LVAL 'VARTBL = TEMP13>
2741                     <BBIND 'VARTBL 'SYMTAB 'FIX TEMP13>
2742                     <DEAD TEMP13>
2743                     <GEN-ASSIGNED? 'IN-IFSYS + TAG18>
2744                     <SET TEMP13 %<> (TYPE FALSE)>
2745                     <JUMP + PHRASE17>
2746 TAG18
2747                     <GEN-LVAL 'IN-IFSYS = TEMP13>
2748 PHRASE17
2749                     <BBIND 'IN-IFSYS 'ANY 'FIX TEMP13>
2750                     <DEAD TEMP13>
2751                     <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2752                     <CHTYPE OBJ4 <TYPE-CODE LIST> = OBJ4>
2753                     <EMPL? OBJ4 - PHRASE24 (TYPE LIST)>
2754                     <FRAME '\1aCOMPILE-ERROR>
2755                     <PUSH "Empty ">
2756                     <PUSH NAME6>
2757                     <PUSH " ">
2758                     <PUSH OBJ4>
2759                     <CALL '\1aCOMPILE-ERROR 4>
2760 PHRASE24
2761                     <NTHL OBJ4 1 = TEMP13>
2762                     <TYPE? TEMP13 <TYPE-CODE ATOM> + TAG28>
2763                     <TYPE? TEMP13 <TYPE-CODE ADECL> - PHRASE27>
2764                     <DEAD TEMP13>
2765 TAG28
2766                     <NTHL OBJ4 1 = HATOM9>
2767                     <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2768 PHRASE27
2769                     <NTHL OBJ4 1 = ARGL10 (TYPE LIST)>
2770                     <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2771                     <EMPL? OBJ4 + PHRASE30 (TYPE LIST)>
2772                     <NTHL OBJ4 1 = TEMP13>
2773                     <TYPE? TEMP13 <TYPE-CODE DECL> - PHRASE30>
2774                     <DEAD TEMP13>
2775                     <NTHL OBJ4 1 = DCL8 (TYPE DECL)>
2776                     <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2777 PHRASE30
2778                     <EMPL? OBJ4 - PHRASE34 (TYPE LIST)>
2779                     <FRAME '\1aCOMPILE-ERROR>
2780                     <PUSH "Empty body for ">
2781                     <PUSH NAME6>
2782                     <PUSH OBJ4>
2783                     <CALL '\1aCOMPILE-ERROR 3>
2784 PHRASE34
2785                     <FRAME '\1aNODEPR>
2786                     <PUSH 5>
2787                     <GEN-LVAL 'PARENT = STACK>
2788                     <FRAME '\1aFIND_DECL>
2789                     <PUSH 'VALUE>
2790                     <PUSH DCL8>
2791                     <CALL '\1aFIND_DECL 2 = STACK>
2792                     <PUSH NAME6>
2793                     <DEAD NAME6>
2794                     <PUSH ()>
2795                     <PUSH AP5>
2796                     <DEAD AP5>
2797                     <PUSH ()>
2798                     <PUSH HATOM9>
2799                     <NTHR 'VARTBL 2 = NAME6 (RECORD-TYPE ATOM) (TYPE LBIND)>
2800                     <NTHR NAME6 1 = STACK (RECORD-TYPE LBIND)>
2801                     <DEAD NAME6>
2802                     <CALL '\1aNODEPR 9 = TT7>
2803                     <FRAME '\1aGEN-D>
2804                     <EMPL? ARGL10 + PHRASE45 (TYPE LIST)>
2805                     <NTHL ARGL10 1 = NAME6>
2806                     <TYPE? NAME6 <TYPE-CODE STRING> - PHRASE45>
2807                     <DEAD NAME6>
2808                     <SET NAME6 ARGL10>
2809                     <DEAD ARGL10>
2810                     <JUMP + PHRASE47>
2811 PHRASE45
2812                     <CONS "AUX" ARGL10 = NAME6>
2813                     <DEAD ARGL10>
2814 PHRASE47
2815                     <PUSH NAME6>
2816                     <DEAD NAME6>
2817                     <PUSH DCL8>
2818                     <DEAD DCL8>
2819                     <PUSH HATOM9>
2820                     <DEAD HATOM9>
2821                     <PUSH TT7>
2822                     <CALL '\1aGEN-D 4>
2823                     <FRAME '\1aACT-FIX>
2824                     <PUSH TT7>
2825                     <NTHUV TT7 10 = STACK (TYPE LIST)>
2826                     <CALL '\1aACT-FIX 2>
2827                     <SET HATOM9 () (TYPE LIST)>
2828                     <SET TEMP13 () (TYPE LIST)>
2829                     <SET NAME6 OBJ4 (TYPE LIST)>
2830                     <DEAD OBJ4>
2831                     <LOOP>
2832 MAP50
2833                     <INTGO>
2834                     <EMPL? NAME6 + MAPAP53>
2835                     <NTHL NAME6 1 = DCL8>
2836                     <FRAME '\1aPCOMP>
2837                     <PUSH DCL8>
2838                     <DEAD DCL8>
2839                     <PUSH TT7>
2840                     <CALL '\1aPCOMP 2 = DCL8>
2841                     <CONS DCL8 () = DCL8 (TYPE LIST)>
2842                     <EMPL? HATOM9 - TAG62>
2843                     <SET HATOM9 DCL8 (TYPE LIST)>
2844                     <JUMP + TAG63>
2845 TAG62
2846                     <PUTREST TEMP13 DCL8>
2847                     <DEAD TEMP13>
2848 TAG63
2849                     <SET TEMP13 DCL8 (TYPE LIST)>
2850                     <DEAD DCL8>
2851                     <RESTL NAME6 1 = NAME6 (TYPE LIST)>
2852                     <JUMP + MAP50>
2853 MAPAP53
2854                     <PUTUV TT7 5 HATOM9 (TYPE LIST)>
2855                     <DEAD HATOM9>
2856                     <UNBIND TEMP3>
2857                     <DEAD TEMP3>
2858                     <ADJ -18>
2859                     <RETURN TT7>
2860                     <DEAD TT7>
2861                     <END \1aPPROG-REPEAT>
2862 <COND (<GASSIGNED? PPROG-REPEAT> <PUTPROP ,PROG PAPPLY-OBJECT ,PPROG-REPEAT> <PUTPROP ,REPEAT PAPPLY-OBJECT ,PPROG-REPEAT> <PUTPROP ,BIND PAPPLY-OBJECT ,PPROG-REPEAT>)>
2863
2864 "Unwind compiler."
2865
2866 #WORD *7746301725*
2867 <GFCN \1aUNWIND-FCN ("VALUE" NODE FORM ANY) OBJ4 AP5>
2868                     <TEMP TEMP8 TT6:NODE TEMP14>
2869                     <INTGO>
2870                     <FRAME '\1aNODEFM>
2871                     <PUSH 65>
2872                     <GEN-LVAL 'PARENT = STACK>
2873                     <PUSH %<>>
2874                     <NTHL OBJ4 1 = STACK>
2875                     <PUSH ()>
2876                     <PUSH AP5>
2877                     <DEAD AP5>
2878                     <CALL '\1aNODEFM 6 = TT6>
2879                     <SET TEMP8 OBJ4>
2880                     <SET TEMP14 3 (TYPE FIX)>
2881                     <LOOP (TEMP8 VALUE) (TEMP14 VALUE)>
2882 TAG15
2883                     <EMPL? TEMP8 + PHRASE12>
2884                     <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
2885                     <SUB TEMP14 1 = TEMP14 (TYPE FIX)>
2886                     <GRTR? TEMP14 0 + TAG15 (TYPE FIX)>
2887                     <EMPL? TEMP8 - PHRASE12>
2888                     <DEAD TEMP8>
2889                     <FRAME '\1aPCOMP>
2890                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
2891                     <NTHL TEMP8 1 = STACK>
2892                     <DEAD TEMP8>
2893                     <PUSH TT6>
2894                     <CALL '\1aPCOMP 2 = TEMP8>
2895                     <CONS TEMP8 () = TEMP8>
2896                     <FRAME '\1aPCOMP>
2897                     <RESTL OBJ4 1 = TEMP14 (TYPE LIST)>
2898                     <DEAD OBJ4>
2899                     <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
2900                     <NTHL TEMP14 1 = STACK>
2901                     <DEAD TEMP14>
2902                     <PUSH TT6>
2903                     <CALL '\1aPCOMP 2 = TEMP14>
2904                     <CONS TEMP14 () = TEMP14>
2905                     <PUTREST TEMP8 TEMP14>
2906                     <DEAD TEMP14>
2907                     <PUTUV TT6 5 TEMP8 (TYPE LIST)>
2908                     <DEAD TEMP8>
2909                     <RETURN TT6>
2910                     <DEAD TT6>
2911 PHRASE12
2912                     <FRAME '\1aCOMPILE-ERROR>
2913                     <PUSH "Wrong number of args to UNIWND: ">
2914                     <PUSH OBJ4>
2915                     <DEAD OBJ4>
2916                     <CALL '\1aCOMPILE-ERROR 2 = TEMP8>
2917                     <RETURN TEMP8>
2918                     <DEAD TEMP8>
2919                     <END \1aUNWIND-FCN>
2920 <COND (<AND <GASSIGNED? UNWIND-FCN> <GASSIGNED? UNWIND>> <PUTPROP ,UNWIND PAPPLY-OBJECT ,UNWIND-FCN>)>
2921
2922 "Build a node for a COND."
2923
2924 #WORD *5730246115*
2925 <GFCN \1aCOND-FCN ("VALUE" NODE <FORM ANY> ANY) OBJ4 AP5>
2926                     <TEMP TEMP3:LBIND TEMP8 TEMP11:NODE TEMP21 TEMP25:LIST CLA26 TEMP29 TT27 TEMP42 O47>
2927                     <INTGO>
2928                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
2929                     <FRAME '\1aNODECOND>
2930                     <PUSH 7>
2931                     <GEN-LVAL 'PARENT = STACK>
2932                     <PUSH %<>>
2933                     <PUSH 'COND>
2934                     <PUSH ()>
2935                     <CALL '\1aNODECOND 5 = TEMP11>
2936                     <BBIND 'PARENT 'NODE 'FIX TEMP11>
2937                     <DEAD TEMP11>
2938                     <NTHR 'PARENT 2 = TEMP8 (RECORD-TYPE ATOM) (TYPE LBIND)>
2939                     <NTHR TEMP8 1 = TEMP11 (RECORD-TYPE LBIND)>
2940                     <DEAD TEMP8>
2941                     <SET TEMP8 () (TYPE LIST)>
2942                     <SET TEMP21 () (TYPE LIST)>
2943                     <RESTL OBJ4 1 = TEMP25 (TYPE LIST)>
2944                     <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
2945                     <LOOP>
2946 MAP16
2947                     <INTGO>
2948                     <EMPL? TEMP25 + MAPAP19>
2949                     <NTHL TEMP25 1 = CLA26>
2950                     <FRAME '\1aNODEB>
2951                     <PUSH 8>
2952                     <NTHR 'PARENT 2 = TEMP29 (RECORD-TYPE ATOM) (TYPE LBIND)>
2953                     <NTHR TEMP29 1 = STACK (RECORD-TYPE LBIND)>
2954                     <DEAD TEMP29>
2955                     <PUSH %<>>
2956                     <PUSH %<>>
2957                     <PUSH ()>
2958                     <CALL '\1aNODEB 5 = TT27>
2959                     <TYPE? CLA26 <TYPE-CODE LIST> - PHRASE33>
2960                     <EMPL? CLA26 + PHRASE33 (TYPE LIST)>
2961                     <FRAME '\1aPCOMP>
2962                     <NTHL CLA26 1 = STACK>
2963                     <PUSH TT27>
2964                     <CALL '\1aPCOMP 2 = TEMP29>
2965                     <PUTUV TT27 4 TEMP29>
2966                     <DEAD TEMP29>
2967                     <SET TEMP29 () (TYPE LIST)>
2968                     <SET TEMP42 () (TYPE LIST)>
2969                     <RESTL CLA26 1 = CLA26 (TYPE LIST)>
2970                     <LOOP>
2971 MAP37
2972                     <INTGO>
2973                     <EMPL? CLA26 + MAPAP40>
2974                     <NTHL CLA26 1 = O47>
2975                     <FRAME '\1aPCOMP>
2976                     <PUSH O47>
2977                     <DEAD O47>
2978                     <PUSH TT27>
2979                     <CALL '\1aPCOMP 2 = O47>
2980                     <CONS O47 () = O47 (TYPE LIST)>
2981                     <EMPL? TEMP29 - TAG50>
2982                     <SET TEMP29 O47 (TYPE LIST)>
2983                     <JUMP + TAG51>
2984 TAG50
2985                     <PUTREST TEMP42 O47>
2986                     <DEAD TEMP42>
2987 TAG51
2988                     <SET TEMP42 O47 (TYPE LIST)>
2989                     <DEAD O47>
2990                     <RESTL CLA26 1 = CLA26 (TYPE LIST)>
2991                     <JUMP + MAP37>
2992 MAPAP40
2993                     <PUTUV TT27 5 TEMP29 (TYPE LIST)>
2994                     <DEAD TEMP29>
2995                     <SET CLA26 TT27>
2996                     <DEAD TT27>
2997                     <JUMP + PHRASE52>
2998 PHRASE33
2999                     <FRAME '\1aCOMPILE-ERROR>
3000                     <PUSH "COND clause not a LIST or empty:  ">
3001                     <PUSH OBJ4>
3002                     <CALL '\1aCOMPILE-ERROR 2 = CLA26>
3003 PHRASE52
3004                     <CONS CLA26 () = CLA26 (TYPE LIST)>
3005                     <EMPL? TEMP8 - TAG54>
3006                     <SET TEMP8 CLA26 (TYPE LIST)>
3007                     <JUMP + TAG55>
3008 TAG54
3009                     <PUTREST TEMP21 CLA26>
3010                     <DEAD TEMP21>
3011 TAG55
3012                     <SET TEMP21 CLA26 (TYPE LIST)>
3013                     <DEAD CLA26>
3014                     <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
3015                     <JUMP + MAP16>
3016 MAPAP19
3017                     <PUTUV TEMP11 5 TEMP8 (TYPE LIST)>
3018                     <DEAD TEMP8>
3019                     <UNBIND TEMP3>
3020                     <DEAD TEMP3>
3021                     <ADJ -9>
3022                     <RETURN TEMP11>
3023                     <DEAD TEMP11>
3024                     <END \1aCOND-FCN>
3025 <COND (<GASSIGNED? COND-FCN> <PUTPROP ,COND PAPPLY-OBJECT ,COND-FCN> <PUTPROP ,AND PAPPLY-OBJECT ,PSUBR-C> <PUTPROP ,OR PAPPLY-OBJECT ,PSUBR-C>)>
3026
3027 "Build a node for '<\b-object>\b-."
3028
3029 #WORD *25276330101*
3030 <GFCN \1aQUOTE-FCN ("VALUE" <OR FALSE NODE> FORM ANY) OBJ4 AP5>
3031                     <TEMP TEMP8 TT6:NODE>
3032                     <INTGO>
3033                     <FRAME '\1aNODE1>
3034                     <PUSH 2>
3035                     <GEN-LVAL 'PARENT = STACK>
3036                     <PUSH %<>>
3037                     <PUSH ()>
3038                     <PUSH ()>
3039                     <CALL '\1aNODE1 5 = TT6>
3040                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3041                     <CHTYPE TEMP8 <TYPE-CODE LIST> = TEMP8>
3042                     <EMPL? TEMP8 - TAG14 (TYPE LIST)>
3043                     <DEAD TEMP8>
3044                     <RETURN %<>>
3045 TAG14
3046                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3047                     <NTHL TEMP8 1 = TEMP8>
3048                     <EQUAL? TEMP8 %<> - PHRASE17>
3049                     <DEAD TEMP8>
3050                     <SET TEMP8 'BOOL-FALSE (TYPE ATOM)>
3051                     <JUMP + PHRASE18>
3052 PHRASE17
3053                     <FRAME '\1aTYPE>
3054                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3055                     <NTHL TEMP8 1 = STACK>
3056                     <DEAD TEMP8>
3057                     <CALL '\1aTYPE 1 = TEMP8>
3058 PHRASE18
3059                     <PUTUV TT6 3 TEMP8>
3060                     <DEAD TEMP8>
3061                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3062                     <DEAD OBJ4>
3063                     <NTHL TEMP8 1 = TEMP8>
3064                     <PUTUV TT6 4 TEMP8>
3065                     <DEAD TEMP8>
3066                     <RETURN TT6>
3067                     <DEAD TT6>
3068                     <END \1aQUOTE-FCN>
3069 <COND (<GASSIGNED? QUOTE-FCN> <PUTPROP ,QUOTE PAPPLY-OBJECT ,QUOTE-FCN>)>
3070
3071 "Build a node for a call to an RSUBR."
3072
3073 #WORD *5643055662*
3074 <GFCN \1aRSUBR-FCN ("VALUE" NODE FORM MSUBR) OBJ4 AP5>
3075                     <TEMP TEMP3:LBIND TEMP8 TEMP16:NODE>
3076                     <INTGO>
3077                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
3078                     <FRAME '\1aNODEFM>
3079                     <PUSH 9>
3080                     <GEN-LVAL 'PARENT = STACK>
3081                     <PUSH %<>>
3082                     <NTHL OBJ4 1 = STACK>
3083                     <PUSH ()>
3084                     <PUSH AP5>
3085                     <CALL '\1aNODEFM 6 = TEMP8>
3086                     <BBIND 'PARENT 'NODE 'FIX TEMP8>
3087                     <DEAD TEMP8>
3088                     <LENUV AP5 = TEMP8 (TYPE FIX)>
3089                     <GRTR? TEMP8 2 - PHRASE13 (TYPE FIX)>
3090                     <DEAD TEMP8>
3091                     <NTHUV AP5 3 = TEMP8>
3092                     <TYPE? TEMP8 <TYPE-CODE DECL> + TAG15>
3093                     <TYPE? TEMP8 <TYPE-CODE LIST> - PHRASE13>
3094                     <DEAD TEMP8>
3095 TAG15
3096                     <NTHR 'PARENT 2 = TEMP8 (RECORD-TYPE ATOM) (TYPE LBIND)>
3097                     <NTHR TEMP8 1 = TEMP16 (RECORD-TYPE LBIND)>
3098                     <DEAD TEMP8>
3099                     <FRAME '\1aPRSUBR-C>
3100                     <NTHL OBJ4 1 = STACK>
3101                     <PUSH OBJ4>
3102                     <DEAD OBJ4>
3103                     <NTHUV AP5 3 = STACK>
3104                     <CALL '\1aPRSUBR-C 3 = TEMP8>
3105                     <PUTUV TEMP16 5 TEMP8>
3106                     <DEAD TEMP16 TEMP8>
3107                     <NTHR 'PARENT 2 = TEMP8 (RECORD-TYPE ATOM) (TYPE LBIND)>
3108                     <NTHR TEMP8 1 = TEMP16 (RECORD-TYPE LBIND)>
3109                     <DEAD TEMP8>
3110                     <FRAME '\1aSANITIZE-DECL>
3111                     <NTHUV AP5 3 = STACK (TYPE LIST)>
3112                     <DEAD AP5>
3113                     <CALL '\1aSANITIZE-DECL 1 = TEMP8>
3114                     <PUTUV TEMP16 7 TEMP8 (TYPE LIST)>
3115                     <DEAD TEMP8>
3116                     <JUMP + PHRASE24>
3117 PHRASE13
3118                     <FRAME '\1aPSUBR-C>
3119                     <PUSH OBJ4>
3120                     <DEAD OBJ4>
3121                     <PUSH AP5>
3122                     <DEAD AP5>
3123                     <CALL '\1aPSUBR-C 2 = TEMP16>
3124 PHRASE24
3125                     <UNBIND TEMP3>
3126                     <DEAD TEMP3>
3127                     <ADJ -9>
3128                     <RETURN TEMP16>
3129                     <DEAD TEMP16>
3130                     <END \1aRSUBR-FCN>
3131 <COND (<GASSIGNED? RSUBR-FCN> <PUTPROP MSUBR PAPPLY-TYPE ,RSUBR-FCN>)>
3132
3133 #WORD *22536232165*
3134 <GFCN \1aSANITIZE-DECL ("VALUE" <LIST [REST <LIST ATOM ANY>]> LIST) DCL4>
3135                     <TEMP (OPT5 %<>) (TUPF6 %<>) TEMP9 TEMP10 TEMP11 TEMP12 TEMP13 TEMP28 TEMP29 TEMP30 TEMP31>
3136                     <INTGO>
3137                     <NTHL DCL4 1 = TEMP9>
3138                     <TYPE? TEMP9 <TYPE-CODE STRING> - PHRASE8>
3139                     <IFCAN "STRING-EQUAL?">
3140                     <STRING-EQUAL? TEMP9 "VALUE" - PHRASE8>
3141                     <ENDIF "STRING-EQUAL?">
3142                     <IFCANNOT "STRING-EQUAL?">
3143                     <SET TEMP10 "VALUE" (TYPE STRING)>
3144                     <LENUS TEMP9 = TEMP11 (TYPE FIX)>
3145                     <VEQUAL? TEMP11 5 - PHRASE8>
3146                     <LOOP (TEMP9 VALUE LENGTH) (TEMP10 VALUE LENGTH) (TEMP11 VALUE)>
3147 TAG14
3148                     <NTHUS TEMP9 1 = TEMP12>
3149                     <NTHUS TEMP10 1 = TEMP13>
3150                     <VEQUAL? TEMP12 TEMP13 - PHRASE8>
3151                     <DEAD TEMP12 TEMP13>
3152                     <RESTUS TEMP9 1 = TEMP9 (TYPE STRING)>
3153                     <RESTUS TEMP10 1 = TEMP10 (TYPE STRING)>
3154                     <SUB TEMP11 1 = TEMP11 (TYPE FIX)>
3155                     <GRTR? TEMP11 0 + TAG14 (TYPE FIX)>
3156                     <ENDIF "STRING-EQUAL?">
3157                     <RESTL DCL4 1 = DCL4 (TYPE LIST)>
3158                     <RESTL DCL4 1 = DCL4 (TYPE LIST)>
3159 PHRASE8
3160                     <SET TEMP12 () (TYPE LIST)>
3161                     <SET TEMP9 () (TYPE LIST)>
3162                     <SET TEMP10 DCL4 (TYPE LIST)>
3163                     <DEAD DCL4>
3164                     <LOOP>
3165 MAP16
3166                     <INTGO>
3167                     <EMPL? TEMP10 + MAPAP19>
3168                     <NTHL TEMP10 1 = TEMP11>
3169                     <TYPE? TEMP11 <TYPE-CODE STRING> - TAG26>
3170                     <IFCAN "STRING-EQUAL?">
3171                     <STRING-EQUAL? TEMP11 "QUOTE" + MAP17>
3172                     <ENDIF "STRING-EQUAL?">
3173                     <IFCANNOT "STRING-EQUAL?">
3174                     <SET TEMP13 TEMP11>
3175                     <SET TEMP28 "QUOTE" (TYPE STRING)>
3176                     <LENUS TEMP13 = TEMP29 (TYPE FIX)>
3177                     <VEQUAL? TEMP29 5 - TAG26>
3178                     <LOOP (TEMP13 VALUE LENGTH) (TEMP28 VALUE LENGTH) (TEMP29 VALUE)>
3179 TAG32
3180                     <NTHUS TEMP13 1 = TEMP30>
3181                     <NTHUS TEMP28 1 = TEMP31>
3182                     <VEQUAL? TEMP30 TEMP31 - TAG26>
3183                     <DEAD TEMP30 TEMP31>
3184                     <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3185                     <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3186                     <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
3187                     <GRTR? TEMP29 0 + TAG32 (TYPE FIX)>
3188                     <JUMP + MAP17>
3189                     <ENDIF "STRING-EQUAL?">
3190 TAG26
3191                     <TYPE? TEMP11 <TYPE-CODE STRING> - PHRASE24>
3192                     <IFCAN "STRING-EQUAL?">
3193                     <STRING-EQUAL? TEMP11 "ARGS" - PHRASE24>
3194                     <ENDIF "STRING-EQUAL?">
3195                     <IFCANNOT "STRING-EQUAL?">
3196                     <SET TEMP28 TEMP11>
3197                     <SET TEMP13 "ARGS" (TYPE STRING)>
3198                     <LENUS TEMP28 = TEMP31 (TYPE FIX)>
3199                     <VEQUAL? TEMP31 4 - PHRASE24>
3200                     <LOOP (TEMP28 VALUE LENGTH) (TEMP13 VALUE LENGTH) (TEMP31 VALUE)>
3201 TAG34
3202                     <NTHUS TEMP28 1 = TEMP30>
3203                     <NTHUS TEMP13 1 = TEMP29>
3204                     <VEQUAL? TEMP30 TEMP29 - PHRASE24>
3205                     <DEAD TEMP30 TEMP29>
3206                     <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3207                     <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3208                     <SUB TEMP31 1 = TEMP31 (TYPE FIX)>
3209                     <GRTR? TEMP31 0 + TAG34 (TYPE FIX)>
3210                     <ENDIF "STRING-EQUAL?">
3211                     <JUMP + MAP17>
3212 PHRASE24
3213                     <TYPE? TEMP11 <TYPE-CODE STRING> - TAG38>
3214                     <IFCAN "STRING-EQUAL?">
3215                     <STRING-EQUAL? TEMP11 "OPT" + BOOL37>
3216                     <ENDIF "STRING-EQUAL?">
3217                     <IFCANNOT "STRING-EQUAL?">
3218                     <SET TEMP13 TEMP11>
3219                     <SET TEMP28 "OPT" (TYPE STRING)>
3220                     <LENUS TEMP13 = TEMP29 (TYPE FIX)>
3221                     <VEQUAL? TEMP29 3 - TAG38>
3222                     <LOOP (TEMP13 VALUE LENGTH) (TEMP28 VALUE LENGTH) (TEMP29 VALUE)>
3223 TAG40
3224                     <NTHUS TEMP13 1 = TEMP30>
3225                     <NTHUS TEMP28 1 = TEMP31>
3226                     <VEQUAL? TEMP30 TEMP31 - TAG38>
3227                     <DEAD TEMP30 TEMP31>
3228                     <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3229                     <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3230                     <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
3231                     <GRTR? TEMP29 0 + TAG40 (TYPE FIX)>
3232                     <JUMP + BOOL37>
3233                     <ENDIF "STRING-EQUAL?">
3234 TAG38
3235                     <TYPE? TEMP11 <TYPE-CODE STRING> - PHRASE36>
3236                     <IFCAN "STRING-EQUAL?">
3237                     <STRING-EQUAL? TEMP11 "OPTIONAL" - PHRASE36>
3238                     <ENDIF "STRING-EQUAL?">
3239                     <IFCANNOT "STRING-EQUAL?">
3240                     <SET TEMP28 TEMP11>
3241                     <SET TEMP13 "OPTIONAL" (TYPE STRING)>
3242                     <LENUS TEMP28 = TEMP31 (TYPE FIX)>
3243                     <VEQUAL? TEMP31 8 - PHRASE36>
3244                     <LOOP (TEMP28 VALUE LENGTH) (TEMP13 VALUE LENGTH) (TEMP31 VALUE)>
3245 TAG42
3246                     <NTHUS TEMP28 1 = TEMP30>
3247                     <NTHUS TEMP13 1 = TEMP29>
3248                     <VEQUAL? TEMP30 TEMP29 - PHRASE36>
3249                     <DEAD TEMP30 TEMP29>
3250                     <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3251                     <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3252                     <SUB TEMP31 1 = TEMP31 (TYPE FIX)>
3253                     <GRTR? TEMP31 0 + TAG42 (TYPE FIX)>
3254                     <ENDIF "STRING-EQUAL?">
3255 BOOL37
3256                     <SET OPT5 'T (TYPE ATOM)>
3257                     <JUMP + MAP17>
3258 PHRASE36
3259                     <TYPE? TEMP11 <TYPE-CODE STRING> - PHRASE44>
3260                     <IFCAN "STRING-EQUAL?">
3261                     <STRING-EQUAL? TEMP11 "TUPLE" - PHRASE44>
3262                     <ENDIF "STRING-EQUAL?">
3263                     <IFCANNOT "STRING-EQUAL?">
3264                     <SET TEMP13 TEMP11>
3265                     <SET TEMP28 "TUPLE" (TYPE STRING)>
3266                     <LENUS TEMP13 = TEMP29 (TYPE FIX)>
3267                     <VEQUAL? TEMP29 5 - PHRASE44>
3268                     <LOOP (TEMP13 VALUE LENGTH) (TEMP28 VALUE LENGTH) (TEMP29 VALUE)>
3269 TAG46
3270                     <NTHUS TEMP13 1 = TEMP30>
3271                     <NTHUS TEMP28 1 = TEMP31>
3272                     <VEQUAL? TEMP30 TEMP31 - PHRASE44>
3273                     <DEAD TEMP30 TEMP31>
3274                     <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3275                     <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3276                     <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
3277                     <GRTR? TEMP29 0 + TAG46 (TYPE FIX)>
3278                     <ENDIF "STRING-EQUAL?">
3279                     <SET TUPF6 'T (TYPE ATOM)>
3280                     <JUMP + MAP17>
3281 PHRASE44
3282                     <VEQUAL? TUPF6 0 + PHRASE49>
3283                     <CONS TEMP11 () = TEMP28>
3284                     <DEAD TEMP11>
3285                     <CONS 'TUPLE TEMP28 = TEMP28>
3286                     <JUMP + PHRASE51>
3287 PHRASE49
3288                     <VEQUAL? OPT5 0 + PHRASE50>
3289                     <CONS TEMP11 () = TEMP28>
3290                     <DEAD TEMP11>
3291                     <CONS 'OPTIONAL TEMP28 = TEMP28>
3292                     <JUMP + PHRASE51>
3293 PHRASE50
3294                     <CONS TEMP11 () = TEMP28>
3295                     <DEAD TEMP11>
3296                     <CONS 'NORMAL TEMP28 = TEMP28>
3297 PHRASE51
3298                     <CONS TEMP28 () = TEMP28 (TYPE LIST)>
3299                     <EMPL? TEMP12 - TAG52>
3300                     <SET TEMP12 TEMP28 (TYPE LIST)>
3301                     <JUMP + TAG53>
3302 TAG52
3303                     <PUTREST TEMP9 TEMP28>
3304                     <DEAD TEMP9>
3305 TAG53
3306                     <SET TEMP9 TEMP28 (TYPE LIST)>
3307                     <DEAD TEMP28>
3308 MAP17
3309                     <RESTL TEMP10 1 = TEMP10 (TYPE LIST)>
3310                     <JUMP + MAP16>
3311 MAPAP19
3312                     <RETURN TEMP12>
3313                     <DEAD TEMP12>
3314                     <END \1aSANITIZE-DECL>
3315 "Predicate:  any segments in this object?"
3316
3317 #WORD *7130071033*
3318 <GFCN \1aSEG? ("VALUE" <OR ATOM !<FALSE>> <PRIMTYPE LIST>) OB4>
3319                     <TEMP TEMP5>
3320                     <INTGO>
3321                     <LOOP>
3322 AGAIN8
3323                     <INTGO>
3324                     <EMPL? OB4 - PHRASE10>
3325                     <RETURN %<>>
3326 PHRASE10
3327                     <NTHL OB4 1 = TEMP5>
3328                     <TYPE? TEMP5 <TYPE-CODE SEGMENT> - PHRASE12>
3329                     <DEAD TEMP5>
3330                     <RETURN 'T>
3331 PHRASE12
3332                     <RESTL OB4 1 = OB4 (TYPE LIST)>
3333                     <CHTYPE OB4 <TYPE-CODE LIST> = OB4>
3334                     <JUMP + AGAIN8>
3335                     <END \1aSEG?>
3336 "Analyze a call to an MSUBR with decls checking number of args and types wherever
3337  possible."
3338
3339 #WORD *24214155136*
3340 <FCN \1aPRSUBR-C ("VALUE" ANY ANY <PRIMTYPE LIST> <PRIMTYPE LIST>) NAME4 OBJ5 RDCL6>
3341                     <TEMP TEMP3:LBIND TEMP23 (SGD9:FORM <>) (SGP10:LIST (1)) (IX12 0) (ARG-NUMBER15:FIX 0) OB19:LIST (ST20 %<>) (ODC21 "FOO") DC13 TEMP42 TEMP52 TEMP53 SGN11 TT132:NODE>
3342                     <INTGO>
3343                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
3344                     <BBIND 'NAME 'ANY %<> NAME4>
3345                     <DEAD NAME4>
3346                     <BBIND 'OBJ <PRIMTYPE LIST> %<> OBJ5>
3347                     <DEAD OBJ5>
3348                     <BBIND 'RDCL <PRIMTYPE LIST> %<> RDCL6>
3349                     <DEAD RDCL6>
3350                     <FIXBIND>
3351                     <GVAL 'INIT-R = TEMP23>
3352                     <BBIND 'DOIT 'ANY 'FIX TEMP23>
3353                     <DEAD TEMP23>
3354                     <BBIND 'SEGSW 'ANY 'FIX %<>>
3355                     <GVAL 'RMODES = TEMP23>
3356                     <BBIND 'RM <VECTOR [REST STRING]> 'FIX TEMP23>
3357                     <DEAD TEMP23>
3358                     <CONS () () = TEMP23>
3359                     <BBIND 'KDS 'LIST 'FIX TEMP23>
3360                     <DEAD TEMP23>
3361                     <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3362                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3363                     <BBIND 'TKDS 'LIST 'FIX TEMP23>
3364                     <DEAD TEMP23>
3365                     <NTHR 'OBJ 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3366                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3367                     <RESTL TEMP23 1 = OB19 (TYPE LIST)>
3368                     <DEAD TEMP23>
3369                     <CHTYPE OB19 <TYPE-CODE LIST> = OB19>
3370                     <CFRAME = TEMP23 (TYPE FRAME)>
3371                     <BBIND 'RSB 'ANY 'FIX TEMP23>
3372                     <DEAD TEMP23>
3373                     <ACTIVATION>
3374                     <LOOP>
3375 AGAIN30
3376                     <INTGO>
3377                     <NTHR 'RDCL 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3378                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3379                     <EMPL? TEMP23 + PHRASE32>
3380                     <DEAD TEMP23>
3381                     <NTHR 'RM 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3382                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3383                     <EMPUV? TEMP23 + PHRASE37 (TYPE VECTOR)>
3384                     <DEAD TEMP23>
3385                     <NTHR 'RDCL 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3386                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3387                     <NTHL TEMP23 1 = DC13>
3388                     <DEAD TEMP23>
3389                     <NTHR 'RDCL 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3390                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3391                     <RESTL TEMP42 1 = TEMP23 (TYPE LIST)>
3392                     <DEAD TEMP42>
3393                     <CHTYPE TEMP23 <TYPE-CODE LIST> = TEMP23>
3394                     <NTHR 'RDCL 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3395                     <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3396                     <DEAD TEMP42 TEMP23>
3397 PHRASE37
3398                     <TYPE? DC13 <TYPE-CODE STRING> - PHRASE48>
3399                     <IFCAN "STRING-EQUAL?">
3400                     <STRING-EQUAL? DC13 "OPT" - PHRASE50>
3401                     <ENDIF "STRING-EQUAL?">
3402                     <IFCANNOT "STRING-EQUAL?">
3403                     <SET TEMP23 DC13>
3404                     <SET TEMP42 "OPT" (TYPE STRING)>
3405                     <LENUS TEMP23 = IX12 (TYPE FIX)>
3406                     <VEQUAL? IX12 3 - PHRASE50>
3407                     <LOOP (TEMP23 VALUE LENGTH) (TEMP42 VALUE LENGTH) (IX12 VALUE)>
3408 TAG54
3409                     <NTHUS TEMP23 1 = TEMP52>
3410                     <NTHUS TEMP42 1 = TEMP53>
3411                     <VEQUAL? TEMP52 TEMP53 - PHRASE50>
3412                     <DEAD TEMP52 TEMP53>
3413                     <RESTUS TEMP23 1 = TEMP23 (TYPE STRING)>
3414                     <RESTUS TEMP42 1 = TEMP42 (TYPE STRING)>
3415                     <SUB IX12 1 = IX12 (TYPE FIX)>
3416                     <GRTR? IX12 0 + TAG54 (TYPE FIX)>
3417                     <ENDIF "STRING-EQUAL?">
3418                     <SET DC13 "OPTIONAL" (TYPE STRING)>
3419 PHRASE50
3420                     <FRAME '\1aMEMBER>
3421                     <PUSH DC13>
3422                     <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3423                     <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3424                     <DEAD TEMP42>
3425                     <CALL '\1aMEMBER 2 = TEMP23>
3426                     <TYPE? TEMP23 <TYPE-CODE FALSE> - PHRASE56>
3427                     <FRAME '\1aCOMPILE-ERROR>
3428                     <PUSH "Unknown string in MSUBR decl: ">
3429                     <PUSH DC13>
3430                     <PUSH " ">
3431                     <NTHR 'NAME 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3432                     <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3433                     <DEAD TEMP42>
3434                     <CALL '\1aCOMPILE-ERROR 4>
3435 PHRASE56
3436                     <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3437                     <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3438                     <DEAD TEMP42 TEMP23>
3439                     <GVAL 'RDOIT = TEMP42>
3440                     <NTHR 'RM 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3441                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3442                     <LENUV TEMP23 = IX12 (TYPE FIX)>
3443                     <DEAD TEMP23>
3444                     <NTHUV TEMP42 IX12 = TEMP23>
3445                     <DEAD TEMP42>
3446                     <NTHR 'DOIT 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3447                     <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3448                     <DEAD TEMP42 TEMP23>
3449                     <FRAME>
3450                     <GVAL 'SDOIT = TEMP23>
3451                     <NTHUV TEMP23 IX12 = TEMP42>
3452                     <DEAD TEMP23 IX12>
3453                     <PUSH ST20>
3454                     <DEAD ST20>
3455                     <PUSH DC13>
3456                     <PUSH ODC21>
3457                     <ACALL TEMP42 3 = ST20>
3458                     <DEAD TEMP42>
3459                     <SET ODC21 DC13>
3460                     <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3461                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3462                     <EMPUV? TEMP42 - AGAIN30 (TYPE VECTOR)>
3463                     <DEAD TEMP42>
3464                     <FRAME '\1aGET-ELE-TYPE>
3465                     <NTHR 'RDCL 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3466                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3467                     <NTHL TEMP42 1 = STACK>
3468                     <DEAD TEMP42>
3469                     <PUSH 'ALL>
3470                     <CALL '\1aGET-ELE-TYPE 2 = DC13>
3471                     <JUMP + AGAIN30>
3472 PHRASE48
3473                     <EMPL? OB19 - PHRASE78 (TYPE LIST)>
3474                     <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3475                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3476                     <LENUV TEMP42 = TEMP42 (TYPE FIX)>
3477                     <LESS? TEMP42 4 - BOOL79 (TYPE FIX)>
3478                     <DEAD TEMP42>
3479                     <NTHR 'TKDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3480                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3481                     <RESTL TEMP42 1 = TEMP23 (TYPE LIST)>
3482                     <DEAD TEMP42>
3483                     <JUMP + EXIT28>
3484 BOOL79
3485                     <FRAME '\1aCOMPILE-ERROR>
3486                     <PUSH "Too few arguments to:  ">
3487                     <NTHR 'NAME 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3488                     <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3489                     <DEAD TEMP42>
3490                     <PUSH " ">
3491                     <NTHR 'OBJ 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3492                     <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3493                     <DEAD TEMP42>
3494                     <CALL '\1aCOMPILE-ERROR 4>
3495                     <JUMP + AGAIN30>
3496 PHRASE78
3497                     <NTHR 'SEGSW 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3498                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3499                     <TYPE? TEMP42 <TYPE-CODE FALSE> + PHRASE89>
3500                     <DEAD TEMP42>
3501                     <SET ST20 %<> (TYPE FALSE)>
3502                     <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3503                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3504                     <EMPUV? TEMP42 - PHRASE93 (TYPE VECTOR)>
3505                     <DEAD TEMP42>
3506                     <PUSH 'REST>
3507                     <PUSH DC13>
3508                     <UBLOCK <TYPE-CODE VECTOR> 2 = TEMP42>
3509                     <CONS TEMP42 () = TEMP42>
3510                     <PUTREST SGP10 TEMP42>
3511                     <DEAD TEMP42>
3512                     <FRAME '\1aTYPE-AND>
3513                     <NTHUV SGN11 3 = STACK>
3514                     <PUSH SGD9>
3515                     <CALL '\1aTYPE-AND 2 = TEMP42>
3516                     <PUTUV SGN11 3 TEMP42>
3517                     <DEAD SGN11 TEMP42>
3518                     <NTHR 'TKDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3519                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3520                     <RESTL TEMP42 1 = TEMP23 (TYPE LIST)>
3521                     <DEAD TEMP42>
3522                     <JUMP + EXIT28>
3523 PHRASE93
3524                     <CONS DC13 () = TEMP42>
3525                     <PUTREST SGP10 TEMP42>
3526                     <DEAD SGP10>
3527                     <SET SGP10 TEMP42>
3528                     <DEAD TEMP42>
3529                     <JUMP + AGAIN30>
3530 PHRASE89
3531                     <NTHL OB19 1 = TEMP42>
3532                     <TYPE? TEMP42 <TYPE-CODE SEGMENT> - PHRASE101>
3533                     <DEAD TEMP42>
3534                     <NTHR 'KDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3535                     <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3536                     <FRAME '\1aSEGCHK>
3537                     <NTHL OB19 1 = STACK (TYPE SEGMENT)>
3538                     <CALL '\1aSEGCHK 1 = SGN11>
3539                     <CONS SGN11 () = TEMP23>
3540                     <PUTREST TEMP42 TEMP23>
3541                     <DEAD TEMP42>
3542                     <NTHR 'KDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3543                     <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3544                     <DEAD TEMP42 TEMP23>
3545                     <RESTL OB19 1 = TEMP23 (TYPE LIST)>
3546                     <EMPL? TEMP23 - PHRASE108 (TYPE LIST)>
3547                     <DEAD TEMP23>
3548                     <NTHR 'RM 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3549                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3550                     <EMPUV? TEMP23 - PHRASE110 (TYPE VECTOR)>
3551                     <DEAD TEMP23>
3552                     <FRAME '\1aSEGCH1>
3553                     <PUSH DC13>
3554                     <NTHUV SGN11 3 = STACK>
3555                     <NTHL OB19 1 = STACK>
3556                     <CALL '\1aSEGCH1 3 = TEMP23>
3557                     <PUTUV SGN11 3 TEMP23>
3558                     <DEAD SGN11 TEMP23>
3559                     <NTHR 'TKDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3560                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3561                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
3562                     <JUMP + EXIT28>
3563 PHRASE110
3564                     <NTHR 'SEGSW 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3565                     <PUTR TEMP23 1 'T (RECORD-TYPE LBIND)>
3566                     <DEAD TEMP23>
3567                     <JUMP + PHRASE119>
3568 PHRASE108
3569                     <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3570                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3571                     <SET TEMP42 () (TYPE LIST)>
3572                     <SET TEMP53 () (TYPE LIST)>
3573                     <RESTL OB19 1 = IX12 (TYPE LIST)>
3574                     <LOOP>
3575 MAP123
3576                     <INTGO>
3577                     <EMPL? IX12 + MAPAP126>
3578                     <NTHL IX12 1 = TEMP52>
3579                     <FRAME '\1aPCOMP>
3580                     <PUSH TEMP52>
3581                     <DEAD TEMP52>
3582                     <GEN-LVAL 'PARENT = STACK>
3583                     <CALL '\1aPCOMP 2 = TT132>
3584                     <NTHR 'RM 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3585                     <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3586                     <EMPUV? TEMP52 - PHRASE161 (TYPE VECTOR)>
3587                     <DEAD TEMP52>
3588                     <NTHUV TT132 1 = TEMP52 (TYPE FIX)>
3589                     <VEQUAL? TEMP52 3 - PHRASE144 (TYPE FIX)>
3590                     <DEAD TEMP52>
3591                     <FRAME '\1aTYPE-OK?>
3592                     <NTHUV TT132 5 = TEMP52 (TYPE LIST)>
3593                     <NTHL TEMP52 1 = TEMP52 (TYPE NODE)>
3594                     <NTHUV TEMP52 3 = STACK>
3595                     <DEAD TEMP52>
3596                     <FRAME '\1aFORM>
3597                     <PUSH <OR MULTI STRUCTURED>>
3598                     <PUSH 'REST>
3599                     <PUSH DC13>
3600                     <UBLOCK <TYPE-CODE VECTOR> 2 = STACK>
3601                     <CALL '\1aFORM 2 = STACK>
3602                     <CALL '\1aTYPE-OK? 2 = TEMP52>
3603                     <TYPE? TEMP52 <TYPE-CODE FALSE> - PHRASE161>
3604                     <DEAD TEMP52>
3605                     <FRAME '\1aCOMPILE-ERROR>
3606                     <PUSH "Argument wrong type to:  ">
3607                     <NTHR 'NAME 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3608                     <NTHR TEMP52 1 = STACK (RECORD-TYPE LBIND)>
3609                     <DEAD TEMP52>
3610                     <PUSH OB19>
3611                     <CALL '\1aCOMPILE-ERROR 3>
3612                     <JUMP + PHRASE161>
3613 PHRASE144
3614                     <FRAME '\1aTYPE-OK?>
3615                     <NTHUV TT132 3 = STACK>
3616                     <PUSH DC13>
3617                     <CALL '\1aTYPE-OK? 2 = TEMP52>
3618                     <TYPE? TEMP52 <TYPE-CODE FALSE> - PHRASE155>
3619                     <DEAD TEMP52>
3620                     <FRAME '\1aCOMPILE-ERROR>
3621                     <PUSH "Argument wrong type to:  ">
3622                     <NTHR 'NAME 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3623                     <NTHR TEMP52 1 = STACK (RECORD-TYPE LBIND)>
3624                     <DEAD TEMP52>
3625                     <PUSH OB19>
3626                     <CALL '\1aCOMPILE-ERROR 3>
3627 PHRASE155
3628                     <NTHUV TT132 3 = TEMP52>
3629                     <TYPE? TEMP52 <TYPE-CODE FALSE> - PHRASE161>
3630                     <DEAD TEMP52>
3631                     <PUTUV TT132 3 DC13>
3632 PHRASE161
3633                     <CONS TT132 () = TEMP52 (TYPE LIST)>
3634                     <DEAD TT132>
3635                     <EMPL? TEMP42 - TAG162>
3636                     <SET TEMP42 TEMP52 (TYPE LIST)>
3637                     <JUMP + TAG163>
3638 TAG162
3639                     <PUTREST TEMP53 TEMP52>
3640                     <DEAD TEMP53>
3641 TAG163
3642                     <SET TEMP53 TEMP52 (TYPE LIST)>
3643                     <DEAD TEMP52>
3644                     <RESTL IX12 1 = IX12 (TYPE LIST)>
3645                     <JUMP + MAP123>
3646 MAPAP126
3647                     <PUTREST TEMP23 TEMP42>
3648                     <DEAD TEMP23 TEMP42>
3649                     <NTHR 'TKDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3650                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3651                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
3652                     <JUMP + EXIT28>
3653 PHRASE119
3654                     <FRAME '\1aFORM>
3655                     <PUSH 'STRUCTURED>
3656                     <PUSH DC13>
3657                     <CALL '\1aFORM 2 = SGD9>
3658                     <RESTL SGD9 1 = SGP10 (TYPE LIST)>
3659                     <CHTYPE SGP10 <TYPE-CODE LIST> = SGP10>
3660                     <SET ST20 %<> (TYPE FALSE)>
3661                     <JUMP + AGAIN30>
3662 PHRASE101
3663                     <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3664                     <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3665                     <FRAME>
3666                     <NTHR 'DOIT 2 = IX12 (RECORD-TYPE ATOM) (TYPE LBIND)>
3667                     <NTHR IX12 1 = IX12 (RECORD-TYPE LBIND)>
3668                     <PUSH DC13>
3669                     <PUSH OB19>
3670                     <ACALL IX12 2 = TEMP52>
3671                     <DEAD IX12>
3672                     <CONS TEMP52 () = TEMP52>
3673                     <PUTREST TEMP23 TEMP52>
3674                     <DEAD TEMP23>
3675                     <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3676                     <PUTR TEMP23 1 TEMP52 (RECORD-TYPE LBIND)>
3677                     <DEAD TEMP23 TEMP52>
3678                     <RESTL OB19 1 = OB19 (TYPE LIST)>
3679                     <ADD ARG-NUMBER15 1 = ARG-NUMBER15 (TYPE FIX)>
3680                     <SET ST20 %<> (TYPE FALSE)>
3681                     <JUMP + AGAIN30>
3682 PHRASE32
3683                     <EMPL? OB19 - PHRASE175 (TYPE LIST)>
3684                     <NTHR 'TKDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3685                     <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3686                     <RESTL TEMP52 1 = TEMP23 (TYPE LIST)>
3687                     <DEAD TEMP52>
3688                     <JUMP + EXIT28>
3689 PHRASE175
3690                     <NTHR 'SEGSW 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3691                     <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3692                     <TYPE? TEMP52 <TYPE-CODE FALSE> + PHRASE178>
3693                     <DEAD TEMP52>
3694                     <NTHUV SGN11 3 = TEMP52>
3695                     <TYPE? TEMP52 <TYPE-CODE FALSE> + PHRASE182>
3696                     <DEAD TEMP52>
3697                     <FRAME '\1aTYPE-AND>
3698                     <NTHUV SGN11 3 = STACK>
3699                     <PUSH SGD9>
3700                     <CALL '\1aTYPE-AND 2 = TEMP52>
3701                     <JUMP + PHRASE184>
3702 PHRASE182
3703                     <SET TEMP52 SGD9>
3704                     <DEAD SGD9>
3705 PHRASE184
3706                     <PUTUV SGN11 3 TEMP52>
3707                     <DEAD SGN11 TEMP52>
3708                     <NTHR 'TKDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3709                     <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3710                     <RESTL TEMP52 1 = TEMP23 (TYPE LIST)>
3711                     <DEAD TEMP52>
3712                     <JUMP + EXIT28>
3713 PHRASE178
3714                     <SET TEMP52 OB19 (TYPE LIST)>
3715                     <LOOP>
3716 MAP189
3717                     <INTGO>
3718                     <EMPL? TEMP52 + MAPAP192>
3719                     <NTHL TEMP52 1 = TEMP23>
3720                     <TYPE? TEMP23 <TYPE-CODE SEGMENT> - PHRASE187>
3721                     <DEAD TEMP23>
3722                     <RESTL TEMP52 1 = TEMP52 (TYPE LIST)>
3723                     <JUMP + MAP189>
3724 MAPAP192
3725                     <NTHR 'KDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3726                     <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3727                     <FRAME '\1aSEGCHK>
3728                     <NTHL OB19 1 = STACK>
3729                     <CALL '\1aSEGCHK 1 = SGN11>
3730                     <CONS SGN11 () = TEMP23>
3731                     <PUTREST TEMP52 TEMP23>
3732                     <DEAD TEMP52>
3733                     <NTHR 'KDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3734                     <PUTR TEMP52 1 TEMP23 (RECORD-TYPE LBIND)>
3735                     <DEAD TEMP52 TEMP23>
3736                     <NTHR 'TKDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3737                     <NTHR TEMP52 1 = TEMP23 (RECORD-TYPE LBIND)>
3738                     <DEAD TEMP52>
3739                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
3740                     <JUMP + EXIT28>
3741 PHRASE187
3742                     <FRAME '\1aCOMPILE-ERROR>
3743                     <PUSH "Too many arguments too: ">
3744                     <NTHR 'NAME 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3745                     <NTHR TEMP23 1 = STACK (RECORD-TYPE LBIND)>
3746                     <DEAD TEMP23>
3747                     <PUSH " ">
3748                     <NTHR 'OBJ 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3749                     <NTHR TEMP23 1 = STACK (RECORD-TYPE LBIND)>
3750                     <DEAD TEMP23>
3751                     <CALL '\1aCOMPILE-ERROR 4>
3752                     <JUMP + AGAIN30>
3753 EXIT28
3754                     <UNBIND TEMP3>
3755                     <DEAD TEMP3>
3756                     <ADJ -81>
3757                     <RETURN TEMP23>
3758                     <DEAD TEMP23>
3759                     <END \1aPRSUBR-C>
3760 #WORD *772350765*
3761 <GFCN \1aSQUOT ("VALUE" ATOM ANY ANY ANY) F4 S1-5 S2-6>
3762                     <TEMP>
3763                     <INTGO>
3764                     <RETURN 'T>
3765                     <END \1aSQUOT>
3766 "Flush one possible decl away."
3767
3768 #WORD *2037740012*
3769 <GFCN \1aCHOPPER ("VALUE" ATOM ANY ANY ANY) F4 S1-5 S2-6>
3770                     <TEMP TEMP10>
3771                     <INTGO>
3772                     <TYPE? F4 <TYPE-CODE FALSE> + PHRASE8>
3773                     <DEAD F4>
3774                     <FRAME '\1aCOMPILE-ERROR>
3775                     <PUSH "Two DECL strings in a row in:  ">
3776                     <PUSH S1-5>
3777                     <DEAD S1-5>
3778                     <PUSH " ">
3779                     <PUSH S2-6>
3780                     <DEAD S2-6>
3781                     <CALL '\1aCOMPILE-ERROR 4>
3782 PHRASE8
3783                     <GEN-LVAL 'RM = TEMP10>
3784                     <RESTUV TEMP10 1 = TEMP10 (TYPE VECTOR)>
3785                     <GEN-SET 'RM TEMP10>
3786                     <DEAD TEMP10>
3787                     <RETURN 'T>
3788                     <END \1aCHOPPER>
3789 "Handle Normal arg when \"VALUE\" still possible."
3790
3791 #WORD *23076477562*
3792 <GFCN \1aINIT-R ("VALUE" NODE ANY ANY) DC4 OB5>
3793                     <TEMP TEMP6>
3794                     <INTGO>
3795                     <GEN-LVAL 'RM = TEMP6>
3796                     <RESTUV TEMP6 2 = TEMP6 (TYPE VECTOR)>
3797                     <GEN-SET 'RM TEMP6>
3798                     <DEAD TEMP6>
3799                     <GVAL 'INIT1-R = TEMP6>
3800                     <GEN-SET 'DOIT TEMP6>
3801                     <DEAD TEMP6>
3802                     <FRAME '\1aINIT1-R>
3803                     <PUSH DC4>
3804                     <DEAD DC4>
3805                     <PUSH OB5>
3806                     <DEAD OB5>
3807                     <CALL '\1aINIT1-R 2 = TEMP6>
3808                     <RETURN TEMP6>
3809                     <DEAD TEMP6>
3810                     <END \1aINIT-R>
3811 "Handle Normal arg when \"CALL\" still possible."
3812
3813 #WORD *22417044032*
3814 <GFCN \1aINIT2-R ("VALUE" NODE ANY ANY) DC4 OB5>
3815                     <TEMP TEMP6>
3816                     <INTGO>
3817                     <GEN-LVAL 'RM = TEMP6>
3818                     <RESTUV TEMP6 1 = TEMP6 (TYPE VECTOR)>
3819                     <GEN-SET 'RM TEMP6>
3820                     <DEAD TEMP6>
3821                     <GVAL 'INIT1-R = TEMP6>
3822                     <GEN-SET 'DOIT TEMP6>
3823                     <DEAD TEMP6>
3824                     <FRAME '\1aINIT1-R>
3825                     <PUSH DC4>
3826                     <DEAD DC4>
3827                     <PUSH OB5>
3828                     <DEAD OB5>
3829                     <CALL '\1aINIT1-R 2 = TEMP6>
3830                     <RETURN TEMP6>
3831                     <DEAD TEMP6>
3832                     <END \1aINIT2-R>
3833 "Handle normal arg."
3834
3835 #WORD *31036001645*
3836 <GFCN \1aINIT1-R ("VALUE" NODE ANY LIST) DC4 OB5>
3837                     <TEMP TEMP11 TT6:NODE>
3838                     <INTGO>
3839                     <FRAME '\1aTYPE-OK?>
3840                     <FRAME '\1aPCOMP>
3841                     <NTHL OB5 1 = STACK>
3842                     <GEN-LVAL 'PARENT = STACK>
3843                     <CALL '\1aPCOMP 2 = TT6>
3844                     <NTHUV TT6 3 = STACK>
3845                     <PUSH DC4>
3846                     <CALL '\1aTYPE-OK? 2 = TEMP11>
3847                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3848                     <DEAD TEMP11>
3849                     <FRAME '\1aCOMPILE-ERROR>
3850                     <PUSH "Argument wrong type to:  ">
3851                     <GEN-LVAL 'NAME = STACK>
3852                     <PUSH " ">
3853                     <NTHL OB5 1 = STACK>
3854                     <DEAD OB5>
3855                     <CALL '\1aCOMPILE-ERROR 4>
3856 PHRASE8
3857                     <NTHUV TT6 3 = TEMP11>
3858                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE19>
3859                     <DEAD TEMP11>
3860                     <PUTUV TT6 3 DC4>
3861                     <DEAD DC4>
3862 PHRASE19
3863                     <RETURN TT6>
3864                     <DEAD TT6>
3865                     <END \1aINIT1-R>
3866 "Handle \"QUOTE\" arg."
3867
3868 #WORD *13427741371*
3869 <GFCN \1aQINIT-R ("VALUE" NODE ANY LIST) DC4 OB5>
3870                     <TEMP TEMP11 TT6:NODE>
3871                     <INTGO>
3872                     <FRAME '\1aTYPE-OK?>
3873                     <FRAME '\1aNODE1>
3874                     <PUSH 2>
3875                     <GEN-LVAL 'PARENT = STACK>
3876                     <FRAME '\1aTYPE>
3877                     <NTHL OB5 1 = STACK>
3878                     <CALL '\1aTYPE 1 = STACK>
3879                     <NTHL OB5 1 = STACK>
3880                     <PUSH ()>
3881                     <CALL '\1aNODE1 5 = TT6>
3882                     <NTHUV TT6 3 = STACK>
3883                     <PUSH DC4>
3884                     <DEAD DC4>
3885                     <CALL '\1aTYPE-OK? 2 = TEMP11>
3886                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3887                     <DEAD TEMP11>
3888                     <FRAME '\1aCOMPILE-ERROR>
3889                     <PUSH "Argument wrong type to:  ">
3890                     <GEN-LVAL 'NAME = STACK>
3891                     <PUSH " ">
3892                     <NTHL OB5 1 = STACK>
3893                     <DEAD OB5>
3894                     <CALL '\1aCOMPILE-ERROR 4>
3895 PHRASE8
3896                     <GVAL 'INIT1-R = TEMP11>
3897                     <GEN-SET 'DOIT TEMP11>
3898                     <DEAD TEMP11>
3899                     <RETURN TT6>
3900                     <DEAD TT6>
3901                     <END \1aQINIT-R>
3902 "Handle \"CALL\" decl."
3903
3904 #WORD *7274472467*
3905 <GFCN \1aCAL-R ("VALUE" ANY ANY ANY) DC4 OB5>
3906                     <TEMP TEMP11 TT6>
3907                     <INTGO>
3908                     <FRAME '\1aTYPE-OK?>
3909                     <FRAME '\1aNODE1>
3910                     <PUSH 2>
3911                     <GEN-LVAL 'PARENT = STACK>
3912                     <PUSH 'FORM>
3913                     <GEN-LVAL 'OBJ = STACK>
3914                     <PUSH ()>
3915                     <CALL '\1aNODE1 5 = TT6>
3916                     <NTHUV TT6 3 = STACK>
3917                     <PUSH DC4>
3918                     <DEAD DC4>
3919                     <CALL '\1aTYPE-OK? 2 = TEMP11>
3920                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3921                     <DEAD TEMP11>
3922                     <FRAME '\1aCOMPILE-ERROR>
3923                     <PUSH "Argument wrong type to:  ">
3924                     <GEN-LVAL 'NAME = STACK>
3925                     <PUSH " ">
3926                     <NTH1 OB5 = STACK>
3927                     <DEAD OB5>
3928                     <CALL '\1aCOMPILE-ERROR 4>
3929 PHRASE8
3930                     <GEN-LVAL 'KDS = TEMP11>
3931                     <CONS TT6 () = TT6>
3932                     <PUTREST TEMP11 TT6>
3933                     <DEAD TEMP11 TT6>
3934                     <FRAME '\1aRETURN>
3935                     <GEN-LVAL 'TKDS = TEMP11>
3936                     <RESTL TEMP11 1 = STACK (TYPE LIST)>
3937                     <DEAD TEMP11>
3938                     <GEN-LVAL 'RSB = STACK>
3939                     <CALL '\1aRETURN 2 = TT6>
3940                     <RETURN TT6>
3941                     <DEAD TT6>
3942                     <END \1aCAL-R>
3943 "Handle \"ARGS\" decl."
3944
3945 #WORD *414200360*
3946 <GFCN \1aARGS-R ("VALUE" ANY ANY ANY) DC4 OB5>
3947                     <TEMP TEMP11 TT6>
3948                     <INTGO>
3949                     <FRAME '\1aTYPE-OK?>
3950                     <FRAME '\1aNODE1>
3951                     <PUSH 2>
3952                     <GEN-LVAL 'PARENT = STACK>
3953                     <PUSH 'LIST>
3954                     <PUSH OB5>
3955                     <PUSH ()>
3956                     <CALL '\1aNODE1 5 = TT6>
3957                     <NTHUV TT6 3 = STACK>
3958                     <PUSH DC4>
3959                     <DEAD DC4>
3960                     <CALL '\1aTYPE-OK? 2 = TEMP11>
3961                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3962                     <DEAD TEMP11>
3963                     <FRAME '\1aCOMPILE-ERROR>
3964                     <PUSH "Argument wrong type to:  ">
3965                     <GEN-LVAL 'NAME = STACK>
3966                     <PUSH " ">
3967                     <NTH1 OB5 = STACK>
3968                     <DEAD OB5>
3969                     <CALL '\1aCOMPILE-ERROR 4>
3970 PHRASE8
3971                     <GEN-LVAL 'KDS = TEMP11>
3972                     <CONS TT6 () = TT6>
3973                     <PUTREST TEMP11 TT6>
3974                     <DEAD TEMP11 TT6>
3975                     <FRAME '\1aRETURN>
3976                     <GEN-LVAL 'TKDS = TEMP11>
3977                     <RESTL TEMP11 1 = STACK (TYPE LIST)>
3978                     <DEAD TEMP11>
3979                     <GEN-LVAL 'RSB = STACK>
3980                     <CALL '\1aRETURN 2 = TT6>
3981                     <RETURN TT6>
3982                     <DEAD TT6>
3983                     <END \1aARGS-R>
3984 "Handle \"TUPLE\" decl."
3985
3986 #WORD *21271652253*
3987 <GFCN \1aTUPL-R ("VALUE" NODE ANY LIST) DC4 OB5>
3988                     <TEMP TEMP11 TT6:NODE>
3989                     <INTGO>
3990                     <FRAME '\1aTYPE-OK?>
3991                     <FRAME '\1aPCOMP>
3992                     <NTHL OB5 1 = STACK>
3993                     <GEN-LVAL 'PARENT = STACK>
3994                     <CALL '\1aPCOMP 2 = TT6>
3995                     <NTHUV TT6 3 = STACK>
3996                     <PUSH DC4>
3997                     <CALL '\1aTYPE-OK? 2 = TEMP11>
3998                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3999                     <DEAD TEMP11>
4000                     <FRAME '\1aCOMPILE-ERROR>
4001                     <PUSH "Argument wrong type to:  ">
4002                     <GEN-LVAL 'NAME = STACK>
4003                     <PUSH " ">
4004                     <NTHL OB5 1 = STACK>
4005                     <DEAD OB5>
4006                     <CALL '\1aCOMPILE-ERROR 4>
4007 PHRASE8
4008                     <NTHUV TT6 3 = TEMP11>
4009                     <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE19>
4010                     <DEAD TEMP11>
4011                     <PUTUV TT6 3 DC4>
4012                     <DEAD DC4>
4013 PHRASE19
4014                     <RETURN TT6>
4015                     <DEAD TT6>
4016                     <END \1aTUPL-R>
4017 "Handle stuff with segments in arguments."
4018
4019 #WORD *20070237142*
4020 <GFCN \1aSEGCHK ("VALUE" NODE ANY) OB4>
4021                     <TEMP TEMP10 TT5:NODE>
4022                     <INTGO>
4023                     <FRAME '\1aTYPE-OK?>
4024                     <FRAME '\1aPCOMP>
4025                     <PUSH OB4>
4026                     <GEN-LVAL 'PARENT = STACK>
4027                     <CALL '\1aPCOMP 2 = TT5>
4028                     <NTHUV TT5 3 = STACK>
4029                     <PUSH <OR MULTI STRUCTURED>>
4030                     <CALL '\1aTYPE-OK? 2 = TEMP10>
4031                     <TYPE? TEMP10 <TYPE-CODE FALSE> - PHRASE7>
4032                     <DEAD TEMP10>
4033                     <FRAME '\1aCOMPILE-ERROR>
4034                     <PUSH "Non-structured segment?  ">
4035                     <PUSH OB4>
4036                     <DEAD OB4>
4037                     <CALL '\1aCOMPILE-ERROR 2>
4038 PHRASE7
4039                     <RETURN TT5>
4040                     <DEAD TT5>
4041                     <END \1aSEGCHK>
4042 #WORD *24626220634*
4043 <GFCN \1aSEGCH1 ("VALUE" ANY ANY ANY ANY) DC4 RT5 OB6>
4044                     <TEMP TEMP13>
4045                     <INTGO>
4046                     <FRAME '\1aTYPE-AND>
4047                     <PUSH RT5>
4048                     <DEAD RT5>
4049                     <FRAME '\1aFORM>
4050                     <PUSH <OR MULTI STRUCTURED>>
4051                     <PUSH 'REST>
4052                     <PUSH DC4>
4053                     <DEAD DC4>
4054                     <UBLOCK <TYPE-CODE VECTOR> 2 = STACK>
4055                     <CALL '\1aFORM 2 = STACK>
4056                     <CALL '\1aTYPE-AND 2 = TEMP13>
4057                     <TYPE? TEMP13 <TYPE-CODE FALSE> + TAG14>
4058                     <DEAD TEMP13>
4059                     <RETURN %<>>
4060 TAG14
4061                     <FRAME '\1aCOMPILE-ERROR>
4062                     <PUSH "Argument wrong type to:  ">
4063                     <GEN-LVAL 'NAME = STACK>
4064                     <PUSH " ">
4065                     <PUSH OB6>
4066                     <DEAD OB6>
4067                     <CALL '\1aCOMPILE-ERROR 4 = TEMP13>
4068                     <RETURN TEMP13>
4069                     <DEAD TEMP13>
4070                     <END \1aSEGCH1>
4071 "Handle \"VALUE\" chop decl and do the rest."
4072
4073 #WORD *5404575626*
4074 <GFCN \1aVAL-R ("VALUE" <OR FALSE ATOM> ANY ANY ANY) F4 S1-5 S2-6>
4075                     <TEMP TEMP8 TEMP11>
4076                     <INTGO>
4077                     <FRAME '\1aCHOPPER>
4078                     <PUSH F4>
4079                     <DEAD F4>
4080                     <PUSH S1-5>
4081                     <DEAD S1-5>
4082                     <PUSH S2-6>
4083                     <DEAD S2-6>
4084                     <CALL '\1aCHOPPER 3>
4085                     <GEN-LVAL 'PARENT = TEMP8>
4086                     <GEN-LVAL 'RDCL = TEMP11>
4087                     <NTHL TEMP11 1 = TEMP11>
4088                     <PUTUV TEMP8 3 TEMP11>
4089                     <DEAD TEMP8 TEMP11>
4090                     <GVAL 'INIT2-R = TEMP8>
4091                     <GEN-SET 'DOIT TEMP8>
4092                     <DEAD TEMP8>
4093                     <GEN-LVAL 'RDCL = TEMP8>
4094                     <NTHL TEMP8 1 = TEMP8>
4095                     <TYPE? TEMP8 <TYPE-CODE STRING> - TAG19>
4096                     <DEAD TEMP8>
4097                     <SET F4 'STRING (TYPE ATOM)>
4098                     <JUMP + TAG20>
4099 TAG19
4100                     <SET F4 %<> (TYPE FALSE)>
4101 TAG20
4102                     <GEN-LVAL 'RDCL = TEMP11>
4103                     <RESTL TEMP11 1 = TEMP8 (TYPE LIST)>
4104                     <DEAD TEMP11>
4105                     <CHTYPE TEMP8 <TYPE-CODE LIST> = TEMP8>
4106                     <GEN-SET 'RDCL TEMP8>
4107                     <DEAD TEMP8>
4108                     <RETURN F4>
4109                     <DEAD F4>
4110                     <END \1aVAL-R>
4111 #WORD *3241576356*
4112 <GFCN \1aERR-R ("VALUE" ANY ANY ANY) DC4 OB5>
4113                     <TEMP TEMP7>
4114                     <INTGO>
4115                     <FRAME '\1aCOMPILE-LOSSAGE>
4116                     <PUSH "Entered MSUBR application illegal state">
4117                     <PUSH DC4>
4118                     <DEAD DC4>
4119                     <PUSH OB5>
4120                     <DEAD OB5>
4121                     <CALL '\1aCOMPILE-LOSSAGE 3 = TEMP7>
4122                     <RETURN TEMP7>
4123                     <DEAD TEMP7>
4124                     <END \1aERR-R>
4125 <SETG RMODES ["VALUE" "CALL" "QUOTE" "OPTIONAL" "QUOTE" "ARGS" "TUPLE"]>
4126
4127 <COND (<GASSIGNED? TUPL-R> <SETG RDOIT [,TUPL-R ,ARGS-R ,QINIT-R ,INIT1-R ,QINIT-R ,CAL-R ,ERR-R]> <SETG SDOIT [,CHOPPER ,CHOPPER ,SQUOT ,CHOPPER ,SQUOT ,CHOPPER ,VAL-R]>)>
4128
4129 <GDECL (RMODES) <VECTOR [REST STRING]> (RDOIT SDOIT) VECTOR>
4130
4131 "Create a node for a call to a function."
4132
4133 #WORD *4615434740*
4134 <GFCN \1aPFUNC ("VALUE" <OR FALSE NODE> <PRIMTYPE LIST> ANY) OB4 AP5>
4135                     <TEMP TEMP10 TEMP13>
4136                     <INTGO>
4137                     <NTHL OB4 1 = TEMP10>
4138                     <TYPE? TEMP10 <TYPE-CODE ATOM> - PHRASE9>
4139                     <DEAD TEMP10>
4140                     <NTHL OB4 1 = TEMP10 (TYPE ATOM)>
4141                     <GEN-LVAL 'FNAME = TEMP13>
4142                     <EQUAL? TEMP10 TEMP13 - PHRASE12>
4143                     <DEAD TEMP10 TEMP13>
4144                     <FRAME '\1aRSUBR-CALL2>
4145                     <NTHL OB4 1 = TEMP13 (TYPE ATOM)>
4146                     <GVAL TEMP13 = STACK>
4147                     <DEAD TEMP13>
4148                     <NTHL OB4 1 = STACK (TYPE ATOM)>
4149                     <PUSH OB4>
4150                     <DEAD OB4>
4151                     <CALL '\1aRSUBR-CALL2 3 = TEMP13>
4152                     <RETURN TEMP13>
4153                     <DEAD TEMP13>
4154 PHRASE12
4155                     <FRAME '\1aGETPROP>
4156                     <NTHL OB4 1 = STACK (TYPE ATOM)>
4157                     <PUSH 'RSUB-DEC>
4158                     <CALL '\1aGETPROP 2 = TEMP10>
4159                     <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE17>
4160                     <FRAME '\1aRSUBR-CALL3>
4161                     <PUSH TEMP10>
4162                     <DEAD TEMP10>
4163                     <NTHL OB4 1 = STACK (TYPE ATOM)>
4164                     <PUSH OB4>
4165                     <DEAD OB4>
4166                     <CALL '\1aRSUBR-CALL3 3 = TEMP13>
4167                     <RETURN TEMP13>
4168                     <DEAD TEMP13>
4169 PHRASE17
4170                     <GEN-LVAL 'REASONABLE = TEMP10>
4171                     <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE20>
4172                     <DEAD TEMP10>
4173                     <FRAME '\1aPSUBR-C>
4174                     <PUSH OB4>
4175                     <DEAD OB4>
4176                     <PUSH 'DUMMY>
4177                     <CALL '\1aPSUBR-C 2 = TEMP13>
4178                     <RETURN TEMP13>
4179                     <DEAD TEMP13>
4180 PHRASE20
4181                     <FRAME '\1aCOMPILE-WARNING>
4182                     <PUSH "Uncompiled function called:  ">
4183                     <NTHL OB4 1 = STACK (TYPE ATOM)>
4184                     <CALL '\1aCOMPILE-WARNING 2>
4185                     <FRAME '\1aPAPDEF>
4186                     <PUSH OB4>
4187                     <NTHL OB4 1 = TEMP10 (TYPE ATOM)>
4188                     <DEAD OB4>
4189                     <GVAL TEMP10 = STACK>
4190                     <DEAD TEMP10>
4191                     <CALL '\1aPAPDEF 2 = TEMP13>
4192                     <RETURN TEMP13>
4193                     <DEAD TEMP13>
4194 PHRASE9
4195                     <NTHL OB4 1 = TEMP10>
4196                     <TYPE? TEMP10 <TYPE-CODE FUNCTION> + TAG28>
4197                     <DEAD TEMP10>
4198                     <RETURN %<>>
4199 TAG28
4200                     <FRAME '\1aMAKE-TAG>
4201                     <PUSH "ANONF">
4202                     <GEN-LVAL 'FNAME = TEMP10>
4203                     <NTHR TEMP10 3 = STACK (RECORD-TYPE ATOM)>
4204                     <DEAD TEMP10>
4205                     <UBLOCK <TYPE-CODE STRING> 2 = STACK (TYPE STRING)>
4206                     <CALL '\1aMAKE-TAG 1 = TEMP10>
4207                     <FRAME '\1aANONF>
4208                     <PUSH TEMP10>
4209                     <NTHL OB4 1 = STACK>
4210                     <CALL '\1aANONF 2>
4211                     <FRAME '\1aRSUBR-CALL1>
4212                     <GVAL TEMP10 = STACK>
4213                     <PUSH TEMP10>
4214                     <DEAD TEMP10>
4215                     <PUSH OB4>
4216                     <DEAD OB4>
4217                     <CALL '\1aRSUBR-CALL1 3 = TEMP13>
4218                     <RETURN TEMP13>
4219                     <DEAD TEMP13>
4220                     <END \1aPFUNC>
4221 "Call compiler recursively to compile anonymous function."
4222
4223 #WORD *25552100712*
4224 <GFCN \1aANONF ("VALUE" NODE ANY ANY) NAME4 BODY5>
4225                     <TEMP (INT?6 %<>) TEMP16>
4226                     <INTGO>
4227                     <FRAME '\1aCOMPILE-NOTE>
4228                     <PUSH "Compiling anonymous function">
4229                     <CALL '\1aCOMPILE-NOTE 1>
4230                     <NTHR NAME4 1 = INT?6 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG11)>
4231                     <TYPE? INT?6 <TYPE-CODE FALSE> + TAG11>
4232                     <PUTR INT?6 1 BODY5 (RECORD-TYPE GBIND)>
4233                     <DEAD INT?6 BODY5>
4234                     <JUMP + TAG12>
4235 TAG11
4236                     <FRAME '\1aSETG>
4237                     <PUSH NAME4>
4238                     <PUSH BODY5>
4239                     <DEAD BODY5>
4240                     <CALL '\1aSETG 2>
4241 TAG12
4242                     <GEN-LVAL 'EXTRA-CODE = INT?6>
4243                     <FRAME>
4244                     <GVAL 'COMPILE = TEMP16>
4245                     <PUSH NAME4>
4246                     <ACALL TEMP16 1 = TEMP16>
4247                     <PUTREST INT?6 TEMP16>
4248                     <DEAD INT?6 TEMP16>
4249                     <GEN-LVAL 'EXTRA-CODE = INT?6>
4250                     <GEN-LVAL 'EXTRA-CODE = TEMP16>
4251                     <LENL TEMP16 = TEMP16 (TYPE FIX)>
4252                     <SUB TEMP16 1 = TEMP16 (TYPE FIX)>
4253                     <GRTR? TEMP16 0 - RESTL23 (TYPE FIX)>
4254                     <LOOP (INT?6 VALUE) (TEMP16 VALUE)>
4255 RESTL22
4256                     <INTGO>
4257                     <RESTL INT?6 1 = INT?6 (TYPE LIST)>
4258                     <SUB TEMP16 1 = TEMP16 (TYPE FIX)>
4259                     <GRTR? TEMP16 0 + RESTL22 (TYPE FIX)>
4260 RESTL23
4261                     <GEN-SET 'EXTRA-CODE INT?6>
4262                     <DEAD INT?6>
4263                     <FRAME '\1aGUNASSIGN>
4264                     <PUSH NAME4>
4265                     <CALL '\1aGUNASSIGN 1>
4266                     <FRAME '\1aCOMPILE-NOTE>
4267                     <PUSH "Finished anonymous function">
4268                     <CALL '\1aCOMPILE-NOTE 1>
4269                     <FRAME '\1aPCOMP>
4270                     <FRAME '\1aFORM>
4271                     <PUSH 'GVAL>
4272                     <PUSH NAME4>
4273                     <DEAD NAME4>
4274                     <CALL '\1aFORM 2 = STACK>
4275                     <GEN-LVAL 'PARENT = STACK>
4276                     <CALL '\1aPCOMP 2 = TEMP16>
4277                     <RETURN TEMP16>
4278                     <DEAD TEMP16>
4279                     <END \1aANONF>
4280 "#FUNCTION (....) compiler -- call ANONF."
4281
4282 #WORD *15072461456*
4283 <GFCN \1aFCN-FCN ("VALUE" NODE ANY) OB4>
4284                     <TEMP TEMP8>
4285                     <INTGO>
4286                     <FRAME '\1aMAKE-TAG>
4287                     <PUSH "ANONF">
4288                     <GEN-LVAL 'FNAME = TEMP8>
4289                     <NTHR TEMP8 3 = STACK (RECORD-TYPE ATOM)>
4290                     <DEAD TEMP8>
4291                     <UBLOCK <TYPE-CODE STRING> 2 = STACK (TYPE STRING)>
4292                     <CALL '\1aMAKE-TAG 1 = TEMP8>
4293                     <FRAME '\1aANONF>
4294                     <PUSH TEMP8>
4295                     <DEAD TEMP8>
4296                     <PUSH OB4>
4297                     <DEAD OB4>
4298                     <CALL '\1aANONF 2 = TEMP8>
4299                     <RETURN TEMP8>
4300                     <DEAD TEMP8>
4301                     <END \1aFCN-FCN>
4302 <COND (<GASSIGNED? FCN-FCN> <PUTPROP FUNCTION PTHIS-TYPE ,FCN-FCN> <PUTPROP FUNCTION PAPPLY-TYPE ,PFUNC>)>
4303
4304 "<FUNCTION (..) ....> compiler -- call ANONF."
4305
4306 #WORD *11444351321*
4307 <GFCN \1aFCN-FCN1 ("VALUE" NODE <PRIMTYPE LIST> ANY) OB4 AP5>
4308                     <TEMP TEMP9>
4309                     <INTGO>
4310                     <FRAME '\1aMAKE-TAG>
4311                     <PUSH "ANONF">
4312                     <GEN-LVAL 'FNAME = TEMP9>
4313                     <NTHR TEMP9 3 = STACK (RECORD-TYPE ATOM)>
4314                     <DEAD TEMP9>
4315                     <UBLOCK <TYPE-CODE STRING> 2 = STACK (TYPE STRING)>
4316                     <CALL '\1aMAKE-TAG 1 = TEMP9>
4317                     <FRAME '\1aANONF>
4318                     <PUSH TEMP9>
4319                     <DEAD TEMP9>
4320                     <RESTL OB4 1 = TEMP9 (TYPE LIST)>
4321                     <DEAD OB4>
4322                     <CHTYPE TEMP9 <TYPE-CODE LIST> = TEMP9>
4323                     <CHTYPE TEMP9 <TYPE-CODE FUNCTION> = STACK>
4324                     <DEAD TEMP9>
4325                     <CALL '\1aANONF 2 = TEMP9>
4326                     <RETURN TEMP9>
4327                     <DEAD TEMP9>
4328                     <END \1aFCN-FCN1>
4329 <COND (<GASSIGNED? FCN-FCN1> <PUTPROP ,FUNCTION PAPPLY-OBJECT ,FCN-FCN1>)>
4330
4331 "Handle RSUBR that is really a function."
4332
4333 #WORD *30512375273*
4334 <GFCN \1aRSUBR-CALL2 ("VALUE" NODE ANY ANY ANY) BODY4 NAME5 OBJ6>
4335                     <TEMP TEMP3:LBIND TEMP11 TEMP14:NODE TEMP22>
4336                     <INTGO>
4337                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
4338                     <FRAME '\1aNODEFM>
4339                     <PUSH 9>
4340                     <GEN-LVAL 'PARENT = STACK>
4341                     <PUSH %<>>
4342                     <PUSH NAME5>
4343                     <PUSH ()>
4344                     <PUSH BODY4>
4345                     <DEAD BODY4>
4346                     <CALL '\1aNODEFM 6 = TEMP14>
4347                     <BBIND 'PARENT 'NODE 'FIX TEMP14>
4348                     <DEAD TEMP14>
4349                     <NTHR 'PARENT 2 = TEMP11 (RECORD-TYPE ATOM) (TYPE LBIND)>
4350                     <NTHR TEMP11 1 = TEMP14 (RECORD-TYPE LBIND)>
4351                     <DEAD TEMP11>
4352                     <FRAME '\1aPRSUBR-C>
4353                     <PUSH NAME5>
4354                     <PUSH OBJ6>
4355                     <DEAD OBJ6>
4356                     <FRAME '\1aGETPROP>
4357                     <PUSH NAME5>
4358                     <DEAD NAME5>
4359                     <GEN-LVAL 'IND = STACK>
4360                     <CALL '\1aGETPROP 2 = TEMP11>
4361                     <NTHUV TEMP11 9 = TEMP11>
4362                     <PUSH TEMP11>
4363                     <CALL '\1aPRSUBR-C 3 = TEMP22>
4364                     <PUTUV TEMP14 5 TEMP22>
4365                     <DEAD TEMP14 TEMP22>
4366                     <NTHR 'PARENT 2 = TEMP22 (RECORD-TYPE ATOM) (TYPE LBIND)>
4367                     <NTHR TEMP22 1 = TEMP14 (RECORD-TYPE LBIND)>
4368                     <DEAD TEMP22>
4369                     <FRAME '\1aSANITIZE-DECL>
4370                     <PUSH TEMP11>
4371                     <DEAD TEMP11>
4372                     <CALL '\1aSANITIZE-DECL 1 = TEMP22>
4373                     <PUTUV TEMP14 7 TEMP22 (TYPE LIST)>
4374                     <DEAD TEMP22>
4375                     <UNBIND TEMP3>
4376                     <DEAD TEMP3>
4377                     <ADJ -9>
4378                     <RETURN TEMP14>
4379                     <DEAD TEMP14>
4380                     <END \1aRSUBR-CALL2>
4381 "Handle an RSUBR that is already an RSUBR."
4382
4383 #WORD *24766001440*
4384 <GFCN \1aRSUBR-CALL1 ("VALUE" NODE <PRIMTYPE LIST> ANY ANY) BODY4 NAME5 OBJ6>
4385                     <TEMP TEMP3:LBIND TEMP9 TEMP12:NODE>
4386                     <INTGO>
4387                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
4388                     <FRAME '\1aNODEFM>
4389                     <PUSH 9>
4390                     <GEN-LVAL 'PARENT = STACK>
4391                     <PUSH %<>>
4392                     <PUSH NAME5>
4393                     <PUSH ()>
4394                     <PUSH BODY4>
4395                     <CALL '\1aNODEFM 6 = TEMP12>
4396                     <BBIND 'PARENT 'NODE 'FIX TEMP12>
4397                     <DEAD TEMP12>
4398                     <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4399                     <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4400                     <DEAD TEMP9>
4401                     <FRAME '\1aPRSUBR-C>
4402                     <PUSH NAME5>
4403                     <DEAD NAME5>
4404                     <PUSH OBJ6>
4405                     <DEAD OBJ6>
4406                     <RESTL BODY4 1 = TEMP9 (TYPE LIST)>
4407                     <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
4408                     <NTHL TEMP9 1 = STACK>
4409                     <DEAD TEMP9>
4410                     <CALL '\1aPRSUBR-C 3 = TEMP9>
4411                     <PUTUV TEMP12 5 TEMP9>
4412                     <DEAD TEMP12 TEMP9>
4413                     <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4414                     <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4415                     <DEAD TEMP9>
4416                     <FRAME '\1aSANITIZE-DECL>
4417                     <RESTL BODY4 1 = TEMP9 (TYPE LIST)>
4418                     <DEAD BODY4>
4419                     <NTHL TEMP9 1 = STACK (TYPE LIST)>
4420                     <DEAD TEMP9>
4421                     <CALL '\1aSANITIZE-DECL 1 = TEMP9>
4422                     <PUTUV TEMP12 7 TEMP9 (TYPE LIST)>
4423                     <DEAD TEMP9>
4424                     <UNBIND TEMP3>
4425                     <DEAD TEMP3>
4426                     <ADJ -9>
4427                     <RETURN TEMP12>
4428                     <DEAD TEMP12>
4429                     <END \1aRSUBR-CALL1>
4430 #WORD *25445413011*
4431 <GFCN \1aRSUBR-CALL3 ("VALUE" NODE ANY ANY ANY) DC4 NAME5 OBJ6>
4432                     <TEMP TEMP3:LBIND TEMP9 TEMP12:NODE>
4433                     <INTGO>
4434                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
4435                     <FRAME '\1aNODEFM>
4436                     <PUSH 9>
4437                     <GEN-LVAL 'PARENT = STACK>
4438                     <PUSH %<>>
4439                     <PUSH NAME5>
4440                     <PUSH ()>
4441                     <PUSH 'FOO>
4442                     <CALL '\1aNODEFM 6 = TEMP12>
4443                     <BBIND 'PARENT 'NODE 'FIX TEMP12>
4444                     <DEAD TEMP12>
4445                     <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4446                     <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4447                     <DEAD TEMP9>
4448                     <FRAME '\1aPRSUBR-C>
4449                     <PUSH NAME5>
4450                     <DEAD NAME5>
4451                     <PUSH OBJ6>
4452                     <DEAD OBJ6>
4453                     <PUSH DC4>
4454                     <CALL '\1aPRSUBR-C 3 = TEMP9>
4455                     <PUTUV TEMP12 5 TEMP9>
4456                     <DEAD TEMP12 TEMP9>
4457                     <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4458                     <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4459                     <DEAD TEMP9>
4460                     <FRAME '\1aSANITIZE-DECL>
4461                     <PUSH DC4>
4462                     <DEAD DC4>
4463                     <CALL '\1aSANITIZE-DECL 1 = TEMP9>
4464                     <PUTUV TEMP12 7 TEMP9 (TYPE LIST)>
4465                     <DEAD TEMP9>
4466                     <UNBIND TEMP3>
4467                     <DEAD TEMP3>
4468                     <ADJ -9>
4469                     <RETURN TEMP12>
4470                     <DEAD TEMP12>
4471                     <END \1aRSUBR-CALL3>
4472 #WORD *34272441472*
4473 <GFCN \1aPLIST ("VALUE" NODE ANY ANY) O4 A5>
4474                     <TEMP TEMP7:NODE>
4475                     <INTGO>
4476                     <FRAME '\1aPSTRUC>
4477                     <PUSH O4>
4478                     <DEAD O4>
4479                     <PUSH A5>
4480                     <DEAD A5>
4481                     <PUSH 'ILIST>
4482                     <PUSH 'LIST>
4483                     <CALL '\1aPSTRUC 4 = TEMP7>
4484                     <RETURN TEMP7>
4485                     <DEAD TEMP7>
4486                     <END \1aPLIST>
4487 #WORD *4312676470*
4488 <GFCN \1aPIVECTOR ("VALUE" NODE ANY ANY) O4 A5>
4489                     <TEMP TEMP7:NODE>
4490                     <INTGO>
4491                     <FRAME '\1aPSTRUC>
4492                     <PUSH O4>
4493                     <DEAD O4>
4494                     <PUSH A5>
4495                     <DEAD A5>
4496                     <PUSH 'IVECTOR>
4497                     <PUSH 'VECTOR>
4498                     <CALL '\1aPSTRUC 4 = TEMP7>
4499                     <RETURN TEMP7>
4500                     <DEAD TEMP7>
4501                     <END \1aPIVECTOR>
4502 #WORD *1752667550*
4503 <GFCN \1aPISTRING ("VALUE" NODE ANY ANY) O4 A5>
4504                     <TEMP TEMP7:NODE>
4505                     <INTGO>
4506                     <FRAME '\1aPSTRUC>
4507                     <PUSH O4>
4508                     <DEAD O4>
4509                     <PUSH A5>
4510                     <DEAD A5>
4511                     <PUSH 'ISTRING>
4512                     <PUSH 'STRING>
4513                     <CALL '\1aPSTRUC 4 = TEMP7>
4514                     <RETURN TEMP7>
4515                     <DEAD TEMP7>
4516                     <END \1aPISTRING>
4517 #WORD *26033567650*
4518 <GFCN \1aPIUVECTOR ("VALUE" NODE ANY ANY) O4 A5>
4519                     <TEMP TEMP7:NODE>
4520                     <INTGO>
4521                     <FRAME '\1aPSTRUC>
4522                     <PUSH O4>
4523                     <DEAD O4>
4524                     <PUSH A5>
4525                     <DEAD A5>
4526                     <PUSH 'IUVECTOR>
4527                     <PUSH 'UVECTOR>
4528                     <CALL '\1aPSTRUC 4 = TEMP7>
4529                     <RETURN TEMP7>
4530                     <DEAD TEMP7>
4531                     <END \1aPIUVECTOR>
4532 #WORD *31736622002*
4533 <GFCN \1aPIFORM ("VALUE" NODE ANY ANY) O4 A5>
4534                     <TEMP TEMP7:NODE>
4535                     <INTGO>
4536                     <FRAME '\1aPSTRUC>
4537                     <PUSH O4>
4538                     <DEAD O4>
4539                     <PUSH A5>
4540                     <DEAD A5>
4541                     <PUSH 'IFORM>
4542                     <PUSH 'FORM>
4543                     <CALL '\1aPSTRUC 4 = TEMP7>
4544                     <RETURN TEMP7>
4545                     <DEAD TEMP7>
4546                     <END \1aPIFORM>
4547 #WORD *35602623432*
4548 <GFCN \1aPIBYTES ("VALUE" NODE ANY ANY) O4 A5>
4549                     <TEMP TEMP7:NODE>
4550                     <INTGO>
4551                     <FRAME '\1aPSTRUC>
4552                     <PUSH O4>
4553                     <DEAD O4>
4554                     <PUSH A5>
4555                     <DEAD A5>
4556                     <PUSH 'IBYTES>
4557                     <PUSH 'BYTES>
4558                     <CALL '\1aPSTRUC 4 = TEMP7>
4559                     <RETURN TEMP7>
4560                     <DEAD TEMP7>
4561                     <END \1aPIBYTES>
4562 <COND (<GASSIGNED? PLIST> <PUTPROP ,ILIST PAPPLY-OBJECT ,PLIST> <PUTPROP ,IUVECTOR PAPPLY-OBJECT ,PIUVECTOR> <COND (<NOT ,MIM> <PUTPROP ,IFORM PAPPLY-OBJECT ,PIFORM>)> <PUTPROP ,IBYTES PAPPLY-OBJECT ,PIBYTES> <PUTPROP ,IVECTOR PAPPLY-OBJECT ,PIVECTOR> <PUTPROP ,ISTRING PAPPLY-OBJECT ,PISTRING>)>
4563
4564 #WORD *4274011335*
4565 <GFCN \1aPSTRUC ("VALUE" NODE <PRIMTYPE LIST> ANY ANY ANY) OBJ4 AP5 NAME6 TYP7>
4566                     <TEMP TEMP14 TT8:NODE LN9:FIX TEMP20 N10:NODE>
4567                     <INTGO>
4568                     <FRAME '\1aNODEFM>
4569                     <PUSH 44>
4570                     <GEN-LVAL 'PARENT = STACK>
4571                     <PUSH TYP7>
4572                     <PUSH NAME6>
4573                     <PUSH ()>
4574                     <GVAL NAME6 = STACK>
4575                     <DEAD NAME6>
4576                     <CALL '\1aNODEFM 6 = TT8>
4577                     <LENL OBJ4 = LN9 (TYPE FIX)>
4578                     <FRAME '\1aSEG?>
4579                     <PUSH OBJ4>
4580                     <CALL '\1aSEG? 1 = TEMP20>
4581                     <VEQUAL? TEMP20 0 + PHRASE18>
4582                     <DEAD TEMP20>
4583                     <FRAME '\1aRSUBR-FCN>
4584                     <PUSH OBJ4>
4585                     <DEAD OBJ4>
4586                     <PUSH AP5>
4587                     <DEAD AP5>
4588                     <CALL '\1aRSUBR-FCN 2 = TEMP20>
4589                     <RETURN TEMP20>
4590                     <DEAD TEMP20>
4591 PHRASE18
4592                     <VEQUAL? LN9 1 - PHRASE24 (TYPE FIX)>
4593                     <FRAME '\1aCOMPILE-ERROR>
4594                     <PUSH "Too few args: ">
4595                     <NTHL OBJ4 1 = STACK>
4596                     <CALL '\1aCOMPILE-ERROR 2>
4597                     <JUMP + PHRASE28>
4598 PHRASE24
4599                     <GRTR? LN9 3 - PHRASE28 (TYPE FIX)>
4600                     <FRAME '\1aCOMPILE-ERROR>
4601                     <PUSH "Too many args: ">
4602                     <NTHL OBJ4 1 = STACK>
4603                     <CALL '\1aCOMPILE-ERROR 2>
4604 PHRASE28
4605                     <FRAME '\1aPCOMP>
4606                     <RESTL OBJ4 1 = TEMP20 (TYPE LIST)>
4607                     <NTHL TEMP20 1 = STACK>
4608                     <DEAD TEMP20>
4609                     <PUSH TT8>
4610                     <CALL '\1aPCOMP 2 = N10>
4611                     <VEQUAL? LN9 3 - PHRASE33 (TYPE FIX)>
4612                     <DEAD LN9>
4613                     <FRAME '\1aPCOMP>
4614                     <RESTL OBJ4 1 = TEMP20 (TYPE LIST)>
4615                     <DEAD OBJ4>
4616                     <RESTL TEMP20 1 = TEMP20 (TYPE LIST)>
4617                     <NTHL TEMP20 1 = STACK>
4618                     <DEAD TEMP20>
4619                     <GEN-LVAL 'PARENT = STACK>
4620                     <CALL '\1aPCOMP 2 = TEMP14>
4621                     <NTHUV TEMP14 1 = TEMP20 (TYPE FIX)>
4622                     <VEQUAL? TEMP20 2 - PHRASE41 (TYPE FIX)>
4623                     <DEAD TEMP20>
4624                     <FRAME '\1aPCOMP>
4625                     <NTHUV TEMP14 4 = STACK>
4626                     <DEAD TEMP14>
4627                     <PUSH TT8>
4628                     <CALL '\1aPCOMP 2 = TEMP14>
4629                     <PUTUV TT8 1 45 (TYPE FIX)>
4630                     <JUMP + PHRASE41>
4631 PHRASE33
4632                     <PUTUV TT8 1 45 (TYPE FIX)>
4633 PHRASE41
4634                     <PUTUV TT8 3 TYP7>
4635                     <DEAD TYP7>
4636                     <TYPE? TEMP14 <TYPE-CODE UNBOUND> + PHRASE43>
4637                     <CONS TEMP14 () = TEMP20>
4638                     <DEAD TEMP14>
4639                     <CONS N10 TEMP20 = TEMP20>
4640                     <DEAD N10>
4641                     <PUTUV TT8 5 TEMP20 (TYPE LIST)>
4642                     <DEAD TEMP20>
4643                     <RETURN TT8>
4644                     <DEAD TT8>
4645 PHRASE43
4646                     <CONS N10 () = TEMP20>
4647                     <DEAD N10>
4648                     <PUTUV TT8 5 TEMP20 (TYPE LIST)>
4649                     <DEAD TEMP20>
4650                     <RETURN TT8>
4651                     <DEAD TT8>
4652                     <END \1aPSTRUC>\r\r
4653 "READ, READCHR, READSTRING, NEXTCHR, READB, GET, GETL, GETPROP, GETPL"
4654
4655 <PUTPROP ,READ PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READ 2 ANY>>>
4656
4657 <COND (<NOT <GASSIGNED? READ-INTERNAL>> <SETG READ-INTERNAL (1)>)>
4658
4659 <PUTPROP ,READ-INTERNAL PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READ-INTERNAL 2 ANY>>>
4660
4661 <COND (<GASSIGNED? GC-READ> <PUTPROP ,GC-READ PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A GC-READ 2 ANY>>>)>
4662
4663 <PUTPROP ,READCHR PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READCHR 2 ANY>>>
4664
4665 <PUTPROP ,NEXTCHR PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A NEXTCHR 2 ANY>>>
4666
4667 <PUTPROP ,READB PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READB 4 ANY>>>
4668
4669 <PUTPROP ,READSTRING PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READSTRING 4 ANY>>>
4670
4671 #WORD *33340650762*
4672 <GFCN \1aCHANFCNS ("VALUE" NODE <PRIMTYPE LIST> ANY ANY FIX ANY) OBJ4 AP5 NAME6 ARGN7 TYP8>
4673                     <TEMP LN10 (TEM12:FIX 0) TEMP17 TEMP31 TEMP35:LIST OB36 TEMP43>
4674                     <INTGO>
4675                     <LENL OBJ4 = LN10 (TYPE FIX)>
4676                     <FRAME '\1aSEG?>
4677                     <PUSH OBJ4>
4678                     <CALL '\1aSEG? 1 = TEMP17>
4679                     <VEQUAL? TEMP17 0 - BOOL15>
4680                     <DEAD TEMP17>
4681                     <SUB LN10 1 = TEMP17 (TYPE FIX)>
4682                     <DEAD LN10>
4683                     <GRTR? ARGN7 TEMP17 - PHRASE14 (TYPE FIX)>
4684                     <DEAD TEMP17>
4685 BOOL15
4686                     <FRAME '\1aRSUBR-FCN>
4687                     <PUSH OBJ4>
4688                     <DEAD OBJ4>
4689                     <PUSH AP5>
4690                     <DEAD AP5>
4691                     <CALL '\1aRSUBR-FCN 2 = TEMP17>
4692                     <RETURN TEMP17>
4693                     <DEAD TEMP17>
4694 PHRASE14
4695                     <FRAME '\1aNODEFM>
4696                     <PUSH 53>
4697                     <GEN-LVAL 'PARENT = STACK>
4698                     <PUSH TYP8>
4699                     <DEAD TYP8>
4700                     <PUSH NAME6>
4701                     <PUSH ()>
4702                     <GVAL NAME6 = STACK>
4703                     <DEAD NAME6>
4704                     <CALL '\1aNODEFM 6 = LN10>
4705                     <SET TEMP17 () (TYPE LIST)>
4706                     <SET TEMP31 () (TYPE LIST)>
4707                     <RESTL OBJ4 1 = TEMP35 (TYPE LIST)>
4708                     <DEAD OBJ4>
4709                     <CHTYPE TEMP35 <TYPE-CODE LIST> = TEMP35>
4710                     <LOOP>
4711 MAP25
4712                     <INTGO>
4713                     <EMPL? TEMP35 + MAPAP28>
4714                     <NTHL TEMP35 1 = OB36>
4715                     <FRAME '\1aPCOMP>
4716                     <PUSH OB36>
4717                     <DEAD OB36>
4718                     <PUSH LN10>
4719                     <CALL '\1aPCOMP 2 = OB36>
4720                     <ADD TEM12 1 = TEM12 (TYPE FIX)>
4721                     <VEQUAL? TEM12 ARGN7 - PHRASE40 (TYPE FIX)>
4722                     <NTHUV OB36 1 = TEMP43 (TYPE FIX)>
4723                     <VEQUAL? TEMP43 2 - PHRASE42 (TYPE FIX)>
4724                     <DEAD TEMP43>
4725                     <FRAME '\1aPCOMP>
4726                     <NTHUV OB36 4 = STACK>
4727                     <DEAD OB36>
4728                     <PUSH LN10>
4729                     <CALL '\1aPCOMP 2 = OB36>
4730                     <PUTUV LN10 1 54 (TYPE FIX)>
4731 PHRASE42
4732                     <FRAME '\1aNODE1>
4733                     <PUSH 55>
4734                     <PUSH LN10>
4735                     <NTHUV OB36 3 = STACK>
4736                     <PUSH %<>>
4737                     <CONS OB36 () = STACK>
4738                     <DEAD OB36>
4739                     <CALL '\1aNODE1 5 = OB36>
4740 PHRASE40
4741                     <CONS OB36 () = TEMP43 (TYPE LIST)>
4742                     <DEAD OB36>
4743                     <EMPL? TEMP17 - TAG46>
4744                     <SET TEMP17 TEMP43 (TYPE LIST)>
4745                     <JUMP + TAG47>
4746 TAG46
4747                     <PUTREST TEMP31 TEMP43>
4748                     <DEAD TEMP31>
4749 TAG47
4750                     <SET TEMP31 TEMP43 (TYPE LIST)>
4751                     <DEAD TEMP43>
4752                     <RESTL TEMP35 1 = TEMP35 (TYPE LIST)>
4753                     <JUMP + MAP25>
4754 MAPAP28
4755                     <PUTUV LN10 5 TEMP17 (TYPE LIST)>
4756                     <DEAD TEMP17>
4757                     <RETURN LN10>
4758                     <DEAD LN10>
4759                     <END \1aCHANFCNS>
4760 <PUTPROP ,GETPROP PAPPLY-OBJECT <FUNCTION (O A) <GETFCNS .O .A GETPROP>>>
4761
4762 '<PUTPROP ,GETPL PAPPLY-OBJECT <FUNCTION (O A) <GETFCNS .O .A GETPL>>>
4763
4764 #WORD *3573703776*
4765 <GFCN \1aGETFCNS ("VALUE" NODE FORM ANY ANY) OBJ4 AP5 NAME6>
4766                     <TEMP LN10 TEMP17 TT11:NODE TEM8:NODE T2-9:NODE>
4767                     <INTGO>
4768                     <LENL OBJ4 = LN10 (TYPE FIX)>
4769                     <VEQUAL? LN10 4 + BOOL15 (TYPE FIX)>
4770                     <VEQUAL? LN10 3 - BOOL14 (TYPE FIX)>
4771 BOOL15
4772                     <FRAME '\1aSEG?>
4773                     <PUSH OBJ4>
4774                     <CALL '\1aSEG? 1 = TEMP17>
4775                     <VEQUAL? TEMP17 0 + PHRASE13>
4776                     <DEAD TEMP17>
4777 BOOL14
4778                     <FRAME '\1aRSUBR-FCN>
4779                     <PUSH OBJ4>
4780                     <DEAD OBJ4>
4781                     <PUSH AP5>
4782                     <DEAD AP5>
4783                     <CALL '\1aRSUBR-FCN 2 = TEMP17>
4784                     <RETURN TEMP17>
4785                     <DEAD TEMP17>
4786 PHRASE13
4787                     <FRAME '\1aNODEFM>
4788                     <PUSH 56>
4789                     <GEN-LVAL 'PARENT = STACK>
4790                     <PUSH 'ANY>
4791                     <PUSH NAME6>
4792                     <PUSH ()>
4793                     <GVAL NAME6 = STACK>
4794                     <DEAD NAME6>
4795                     <CALL '\1aNODEFM 6 = TT11>
4796                     <FRAME '\1aPCOMP>
4797                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
4798                     <NTHL TEMP17 1 = STACK>
4799                     <DEAD TEMP17>
4800                     <PUSH TT11>
4801                     <CALL '\1aPCOMP 2 = TEM8>
4802                     <FRAME '\1aPCOMP>
4803                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
4804                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
4805                     <NTHL TEMP17 1 = STACK>
4806                     <DEAD TEMP17>
4807                     <PUSH TT11>
4808                     <CALL '\1aPCOMP 2 = T2-9>
4809                     <VEQUAL? LN10 3 - PHRASE28 (TYPE FIX)>
4810                     <DEAD LN10>
4811                     <PUTUV TT11 1 57 (TYPE FIX)>
4812                     <CONS T2-9 () = TEMP17>
4813                     <DEAD T2-9>
4814                     <CONS TEM8 TEMP17 = TEMP17>
4815                     <DEAD TEM8>
4816                     <PUTUV TT11 5 TEMP17 (TYPE LIST)>
4817                     <DEAD TEMP17>
4818                     <JUMP + PHRASE29>
4819 PHRASE28
4820                     <FRAME '\1aPCOMP>
4821                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
4822                     <DEAD OBJ4>
4823                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
4824                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
4825                     <NTHL TEMP17 1 = STACK>
4826                     <DEAD TEMP17>
4827                     <PUSH TT11>
4828                     <CALL '\1aPCOMP 2 = LN10>
4829                     <NTHUV LN10 1 = TEMP17 (TYPE FIX)>
4830                     <VEQUAL? TEMP17 2 - PHRASE32 (TYPE FIX)>
4831                     <DEAD TEMP17>
4832                     <FRAME '\1aPCOMP>
4833                     <NTHUV LN10 4 = STACK>
4834                     <DEAD LN10>
4835                     <PUSH TT11>
4836                     <CALL '\1aPCOMP 2 = LN10>
4837                     <PUTUV TT11 1 57 (TYPE FIX)>
4838 PHRASE32
4839                     <CONS LN10 () = TEMP17>
4840                     <DEAD LN10>
4841                     <CONS T2-9 TEMP17 = TEMP17>
4842                     <DEAD T2-9>
4843                     <CONS TEM8 TEMP17 = TEMP17>
4844                     <DEAD TEM8>
4845                     <PUTUV TT11 5 TEMP17 (TYPE LIST)>
4846                     <DEAD TEMP17>
4847 PHRASE29
4848                     <RETURN TT11>
4849                     <DEAD TT11>
4850                     <END \1aGETFCNS>
4851 #WORD *3416461150*
4852 <GFCN \1aARGCHK ("VALUE" ATOM FIX <OR <LIST FIX FIX> FIX> ANY ANY) GIV4 REQ5 NAME6 OBJ7>
4853                     <TEMP HI8 LO9>
4854                     <INTGO>
4855                     <SET HI8 REQ5>
4856                     <SET LO9 REQ5>
4857                     <TYPE? REQ5 <TYPE-CODE LIST> - PHRASE11>
4858                     <RESTL REQ5 1 = HI8 (TYPE LIST)>
4859                     <NTHL HI8 1 = HI8 (TYPE FIX)>
4860                     <NTHL REQ5 1 = LO9 (TYPE FIX)>
4861                     <DEAD REQ5>
4862 PHRASE11
4863                     <LESS? GIV4 LO9 - PHRASE14 (TYPE FIX)>
4864                     <DEAD LO9>
4865                     <FRAME '\1aCOMPILE-ERROR>
4866                     <PUSH "Too few arguments to: ">
4867                     <PUSH NAME6>
4868                     <DEAD NAME6>
4869                     <PUSH OBJ7>
4870                     <DEAD OBJ7>
4871                     <CALL '\1aCOMPILE-ERROR 3>
4872                     <RETURN 'T>
4873 PHRASE14
4874                     <GRTR? GIV4 HI8 - PHRASE16 (TYPE FIX)>
4875                     <DEAD GIV4 HI8>
4876                     <FRAME '\1aCOMPILE-ERROR>
4877                     <PUSH "Too many arguments to: ">
4878                     <PUSH NAME6>
4879                     <DEAD NAME6>
4880                     <PUSH OBJ7>
4881                     <DEAD OBJ7>
4882                     <CALL '\1aCOMPILE-ERROR 3>
4883 PHRASE16
4884                     <RETURN 'T>
4885                     <END \1aARGCHK>
4886 "\f"
4887
4888 #WORD *23605163763*
4889 <GFCN \1aPMAPF-R ("VALUE" NODE <PRIMTYPE LIST> ANY) OB4 AP5>
4890                     <TEMP NAME6 TEMP3:LBIND OBJ9:LIST (LN11 ()) (APL14 ()) (DCL15 #DECL ()) (HATOM17 %<>) (NN18 0) TT7:NODE FINALF12:NODE TAPL13 TEM19 TEMP40 L1-76:LIST SYM77:SYMTAB>
4891                     <INTGO>
4892                     <NTHL OB4 1 = NAME6>
4893                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
4894                     <BBIND 'RQRG 'FIX 'FIX 0>
4895                     <RESTL OB4 1 = OBJ9 (TYPE LIST)>
4896                     <DEAD OB4>
4897                     <CHTYPE OBJ9 <TYPE-CODE LIST> = OBJ9>
4898                     <LENL OBJ9 = LN11 (TYPE FIX)>
4899                     <BBIND 'TRG 'FIX 'FIX 0>
4900                     <LESS? LN11 2 - PHRASE28 (TYPE FIX)>
4901                     <FRAME '\1aCOMPILE-ERROR>
4902                     <PUSH "Too few arguments:  ">
4903                     <PUSH NAME6>
4904                     <PUSH OBJ9>
4905                     <CALL '\1aCOMPILE-ERROR 3>
4906 PHRASE28
4907                     <FRAME '\1aNODEFM>
4908                     <PUSH 50>
4909                     <GEN-LVAL 'PARENT = STACK>
4910                     <PUSH %<>>
4911                     <PUSH NAME6>
4912                     <DEAD NAME6>
4913                     <PUSH ()>
4914                     <PUSH AP5>
4915                     <DEAD AP5>
4916                     <CALL '\1aNODEFM 6 = TT7>
4917                     <FRAME '\1aPCOMP>
4918                     <NTHL OBJ9 1 = STACK>
4919                     <PUSH TT7>
4920                     <CALL '\1aPCOMP 2 = FINALF12>
4921                     <RESTL OBJ9 1 = NAME6 (TYPE LIST)>
4922                     <NTHL NAME6 1 = TAPL13>
4923                     <DEAD NAME6>
4924                     <TYPE? TAPL13 <TYPE-CODE FUNCTION> + BOOL37>
4925                     <TYPE? TAPL13 <TYPE-CODE FORM> - PHRASE36>
4926                     <CHTYPE TAPL13 <TYPE-CODE LIST> = APL14>
4927                     <EMPL? APL14 + PHRASE36 (TYPE LIST)>
4928                     <NTHL APL14 1 = TEM19>
4929                     <TYPE? TEM19 <TYPE-CODE ATOM> - PHRASE36>
4930                     <NTHR TEM19 1 = NAME6 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE36)>
4931                     <TYPE? NAME6 <TYPE-CODE FALSE> + PHRASE36>
4932                     <NTHR NAME6 1 = NAME6 (RECORD-TYPE GBIND)>
4933                     <TYPE? NAME6 <TYPE-CODE UNBOUND> + PHRASE36>
4934                     <DEAD NAME6>
4935                     <GVAL TEM19 = NAME6>
4936                     <GVAL 'FUNCTION = TEMP40>
4937                     <EQUAL? NAME6 TEMP40 - PHRASE36>
4938                     <DEAD NAME6 TEMP40>
4939                     <RESTL APL14 1 = TAPL13 (TYPE LIST)>
4940                     <DEAD APL14>
4941 BOOL37
4942                     <CHTYPE TAPL13 <TYPE-CODE LIST> = APL14>
4943                     <DEAD TAPL13>
4944                     <EMPL? APL14 - PHRASE42 (TYPE LIST)>
4945                     <FRAME '\1aCOMPILE-ERROR>
4946                     <PUSH "MAPF/R function is empty:  ">
4947                     <PUSH OBJ9>
4948                     <CALL '\1aCOMPILE-ERROR 2>
4949 PHRASE42
4950                     <NTHL APL14 1 = TEMP40>
4951                     <TYPE? TEMP40 <TYPE-CODE ATOM> + TAG46>
4952                     <TYPE? TEMP40 <TYPE-CODE ADECL> - PHRASE45>
4953                     <DEAD TEMP40>
4954 TAG46
4955                     <NTHL APL14 1 = HATOM17>
4956                     <RESTL APL14 1 = APL14 (TYPE LIST)>
4957 PHRASE45
4958                     <EMPL? APL14 + BOOL49 (TYPE LIST)>
4959                     <NTHL APL14 1 = NAME6>
4960                     <TYPE? NAME6 <TYPE-CODE LIST> + PHRASE48>
4961                     <DEAD NAME6>
4962 BOOL49
4963                     <FRAME '\1aCOMPILE-ERROR>
4964                     <PUSH "MAPF/R function lacks arg list:  ">
4965                     <PUSH OBJ9>
4966                     <CALL '\1aCOMPILE-ERROR 2>
4967 PHRASE48
4968                     <NTHL APL14 1 = LN11 (TYPE LIST)>
4969                     <RESTL APL14 1 = APL14 (TYPE LIST)>
4970                     <EMPL? APL14 + PHRASE52 (TYPE LIST)>
4971                     <NTHL APL14 1 = NAME6>
4972                     <TYPE? NAME6 <TYPE-CODE DECL> - PHRASE52>
4973                     <DEAD NAME6>
4974                     <NTHL APL14 1 = DCL15 (TYPE DECL)>
4975                     <RESTL APL14 1 = APL14 (TYPE LIST)>
4976 PHRASE52
4977                     <EMPL? APL14 - PHRASE55 (TYPE LIST)>
4978                     <FRAME '\1aCOMPILE-ERROR>
4979                     <PUSH "MAPF/R function has no body:  ">
4980                     <PUSH OBJ9>
4981                     <CALL '\1aCOMPILE-ERROR 2>
4982 PHRASE55
4983                     <GETS 'BIND = NAME6 (TYPE LBIND)>
4984                     <GEN-LVAL 'VARTBL = TAPL13>
4985                     <BBIND 'VARTBL 'SYMTAB 'FIX TAPL13>
4986                     <DEAD TAPL13>
4987                     <FRAME '\1aNODEPR>
4988                     <PUSH 51>
4989                     <PUSH TT7>
4990                     <FRAME '\1aFIND_DECL>
4991                     <PUSH 'VALUE>
4992                     <PUSH DCL15>
4993                     <CALL '\1aFIND_DECL 2 = TAPL13>
4994                     <TYPE? TAPL13 <TYPE-CODE FALSE> - BOOL64>
4995                     <SET TAPL13 'ANY (TYPE ATOM)>
4996 BOOL64
4997                     <PUSH TAPL13>
4998                     <DEAD TAPL13>
4999                     <PUSH %<>>
5000                     <PUSH ()>
5001                     <PUSH %<>>
5002                     <PUSH ()>
5003                     <PUSH HATOM17>
5004                     <NTHR 'VARTBL 2 = TAPL13 (RECORD-TYPE ATOM) (TYPE LBIND)>
5005                     <NTHR TAPL13 1 = STACK (RECORD-TYPE LBIND)>
5006                     <DEAD TAPL13>
5007                     <CALL '\1aNODEPR 9 = TEM19>
5008                     <FRAME '\1aGEN-D>
5009                     <PUSH LN11>
5010                     <DEAD LN11>
5011                     <PUSH DCL15>
5012                     <DEAD DCL15>
5013                     <PUSH HATOM17>
5014                     <DEAD HATOM17>
5015                     <PUSH TEM19>
5016                     <CALL '\1aGEN-D 4>
5017                     <FRAME '\1aACT-FIX>
5018                     <PUSH TEM19>
5019                     <NTHUV TEM19 10 = STACK (TYPE LIST)>
5020                     <CALL '\1aACT-FIX 2 = TAPL13>
5021                     <TYPE? TAPL13 <TYPE-CODE FALSE> + PHRASE70>
5022                     <DEAD TAPL13>
5023                     <SET LN11 () (TYPE LIST)>
5024                     <SET HATOM17 LN11>
5025                     <NTHUV TEM19 10 = DCL15 (TYPE LIST)>
5026                     <SET NN18 DCL15>
5027                     <SET L1-76 DCL15>
5028                     <LOOP>
5029 AGAIN78
5030                     <INTGO>
5031                     <EMPL? DCL15 - BOOL79 (TYPE LIST)>
5032                     <SET TAPL13 L1-76>
5033                     <DEAD L1-76>
5034                     <JUMP + EXIT72>
5035 BOOL79
5036                     <NTHL DCL15 1 = SYM77 (TYPE SYMTAB)>
5037                     <NTHUV SYM77 4 = TEMP40 (TYPE FIX)>
5038                     <VEQUAL? TEMP40 1 - PHRASE93 (TYPE FIX)>
5039                     <DEAD TEMP40>
5040                     <NTHUV SYM77 2 = TEMP40 (TYPE ATOM)>
5041                     <CONS TEMP40 LN11 = TEMP40>
5042                     <DEAD LN11>
5043                     <CONS "ACT" TEMP40 = LN11>
5044                     <DEAD TEMP40>
5045                     <NTHUV SYM77 2 = TEMP40 (TYPE ATOM)>
5046                     <CONS TEMP40 () = TEMP40>
5047                     <CONS TEMP40 () = TEMP40>
5048                     <NTHUV SYM77 3 = TAPL13>
5049                     <TYPE? TAPL13 <TYPE-CODE FALSE> + PHRASE86>
5050                     <DEAD TAPL13>
5051                     <FRAME '\1aFORM>
5052                     <PUSH 'SPECIAL>
5053                     <NTHUV SYM77 7 = STACK>
5054                     <DEAD SYM77>
5055                     <CALL '\1aFORM 2 = TAPL13>
5056                     <JUMP + PHRASE89>
5057 PHRASE86
5058                     <FRAME '\1aFORM>
5059                     <PUSH 'UNSPECIAL>
5060                     <NTHUV SYM77 7 = STACK>
5061                     <DEAD SYM77>
5062                     <CALL '\1aFORM 2 = TAPL13>
5063 PHRASE89
5064                     <CONS TAPL13 () = TAPL13>
5065                     <PUTREST TEMP40 TAPL13>
5066                     <PUTREST TAPL13 HATOM17>
5067                     <DEAD TAPL13 HATOM17>
5068                     <SET HATOM17 TEMP40>
5069                     <DEAD TEMP40>
5070                     <VEQUAL? DCL15 L1-76 - PHRASE92>
5071                     <RESTL L1-76 1 = L1-76 (TYPE LIST)>
5072                     <JUMP + PHRASE93>
5073 PHRASE92
5074                     <RESTL DCL15 1 = TEMP40 (TYPE LIST)>
5075                     <PUTREST NN18 TEMP40>
5076                     <DEAD NN18 TEMP40>
5077 PHRASE93
5078                     <SET NN18 DCL15>
5079                     <DEAD DCL15>
5080                     <RESTL NN18 1 = DCL15 (TYPE LIST)>
5081                     <JUMP + AGAIN78>
5082 EXIT72
5083                     <PUTUV TEM19 10 TAPL13 (TYPE LIST)>
5084                     <DEAD TAPL13>
5085                     <FRAME '\1aFORM>
5086                     <PUSH 'PROG>
5087                     <PUSH LN11>
5088                     <DEAD LN11>
5089                     <CHTYPE HATOM17 <TYPE-CODE DECL> = STACK>
5090                     <DEAD HATOM17>
5091                     <SET TEMP40 3 (TYPE FIX)>
5092                     <SET TAPL13 APL14>
5093                     <DEAD APL14>
5094                     <LOOP (TAPL13 VALUE) (TEMP40 VALUE)>
5095 TAG95
5096                     <INTGO>
5097                     <EMPL? TAPL13 + TAG94>
5098                     <NTHL TAPL13 1 = STACK>
5099                     <RESTL TAPL13 1 = TAPL13 (TYPE LIST)>
5100                     <ADD TEMP40 1 = TEMP40 (TYPE FIX)>
5101                     <JUMP + TAG95>
5102 TAG94
5103                     <CALL '\1aFORM TEMP40 = TEMP40>
5104                     <CONS TEMP40 () = APL14>
5105                     <DEAD TEMP40>
5106 PHRASE70
5107                     <SET HATOM17 () (TYPE LIST)>
5108                     <SET TAPL13 () (TYPE LIST)>
5109                     <SET TEMP40 APL14 (TYPE LIST)>
5110                     <DEAD APL14>
5111                     <LOOP>
5112 MAP98
5113                     <INTGO>
5114                     <EMPL? TEMP40 + MAPAP101>
5115                     <NTHL TEMP40 1 = LN11>
5116                     <FRAME '\1aPCOMP>
5117                     <PUSH LN11>
5118                     <DEAD LN11>
5119                     <PUSH TEM19>
5120                     <CALL '\1aPCOMP 2 = LN11>
5121                     <CONS LN11 () = LN11 (TYPE LIST)>
5122                     <EMPL? HATOM17 - TAG108>
5123                     <SET HATOM17 LN11 (TYPE LIST)>
5124                     <JUMP + TAG109>
5125 TAG108
5126                     <PUTREST TAPL13 LN11>
5127                     <DEAD TAPL13>
5128 TAG109
5129                     <SET TAPL13 LN11 (TYPE LIST)>
5130                     <DEAD LN11>
5131                     <RESTL TEMP40 1 = TEMP40 (TYPE LIST)>
5132                     <JUMP + MAP98>
5133 MAPAP101
5134                     <PUTUV TEM19 5 HATOM17 (TYPE LIST)>
5135                     <DEAD HATOM17>
5136                     <UNBIND NAME6>
5137                     <DEAD NAME6>
5138                     <ADJ -9>
5139                     <JUMP + PHRASE175>
5140 PHRASE36
5141                     <TYPE? TAPL13 <TYPE-CODE FIX> - BOOL112>
5142                     <VEQUAL? LN11 3 + BOOL121 (TYPE FIX)>
5143 BOOL112
5144                     <TYPE? TAPL13 <TYPE-CODE FORM> - BOOL115>
5145                     <CHTYPE TAPL13 <TYPE-CODE LIST> = APL14>
5146                     <EMPL? APL14 + BOOL115>
5147                     <RESTL APL14 1 = NAME6 (TYPE LIST)>
5148                     <EMPL? NAME6 + BOOL115>
5149                     <RESTL NAME6 1 = NAME6 (TYPE LIST)>
5150                     <EMPL? NAME6 - BOOL115>
5151                     <DEAD NAME6>
5152                     <NTHL APL14 1 = TEM19>
5153                     <TYPE? TEM19 <TYPE-CODE ATOM> - BOOL115>
5154                     <NTHR TEM19 1 = NAME6 (RECORD-TYPE ATOM) (BRANCH-FALSE + BOOL115)>
5155                     <TYPE? NAME6 <TYPE-CODE FALSE> + BOOL115>
5156                     <NTHR NAME6 1 = NAME6 (RECORD-TYPE GBIND)>
5157                     <TYPE? NAME6 <TYPE-CODE UNBOUND> + BOOL115>
5158                     <DEAD NAME6>
5159                     <GVAL TEM19 = NAME6>
5160                     <DEAD TEM19>
5161                     <GVAL 'GVAL = TEMP40>
5162                     <EQUAL? NAME6 TEMP40 - BOOL115>
5163                     <DEAD NAME6 TEMP40>
5164                     <RESTL APL14 1 = TEMP40 (TYPE LIST)>
5165                     <DEAD APL14>
5166                     <NTHL TEMP40 1 = TEM19>
5167                     <DEAD TEMP40>
5168                     <TYPE? TEM19 <TYPE-CODE ATOM> + BOOL114>
5169 BOOL115
5170                     <TYPE? TAPL13 <TYPE-CODE GVAL> - PHRASE110>
5171                     <CHTYPE TAPL13 <TYPE-CODE ATOM> = TEM19>
5172 BOOL114
5173                     <GEN-LVAL 'REASONABLE = TEMP40>
5174                     <TYPE? TEMP40 <TYPE-CODE FALSE> - BOOL121>
5175                     <DEAD TEMP40>
5176                     <NTHR TEM19 1 = TEMP40 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE110)>
5177                     <TYPE? TEMP40 <TYPE-CODE FALSE> + PHRASE110>
5178                     <NTHR TEMP40 1 = TEMP40 (RECORD-TYPE GBIND)>
5179                     <TYPE? TEMP40 <TYPE-CODE UNBOUND> + PHRASE110>
5180                     <DEAD TEMP40>
5181                     <GVAL TEM19 = TEMP40>
5182                     <TYPE? TEMP40 <TYPE-CODE FUNCTION> - BOOL121>
5183                     <DEAD TEMP40>
5184                     <GEN-LVAL 'FNAME = TEMP40>
5185                     <EQUAL? TEMP40 TEM19 - PHRASE110>
5186                     <DEAD TEMP40>
5187 BOOL121
5188                     <FRAME '\1aPUTPROP>
5189                     <GEN-LVAL 'IND = STACK>
5190                     <PUSH 'PTHIS-OBJECT>
5191                     <GVAL 'PMARGS = STACK>
5192                     <CALL '\1aPUTPROP 3>
5193                     <TYPE? TAPL13 <TYPE-CODE FIX> - PHRASE128>
5194                     <FRAME '\1aPCOMP>
5195                     <FRAME '\1aFORM>
5196                     <PUSH 'NTH>
5197                     <GEN-LVAL 'IND = STACK>
5198                     <PUSH TAPL13>
5199                     <DEAD TAPL13>
5200                     <CALL '\1aFORM 3 = STACK>
5201                     <PUSH TT7>
5202                     <CALL '\1aPCOMP 2 = LN11>
5203                     <JUMP + PHRASE133>
5204 PHRASE128
5205                     <FRAME '\1aPCOMP>
5206                     <FRAME '\1aFORM>
5207                     <PUSH TEM19>
5208                     <DEAD TEM19>
5209                     <SET APL14 1 (TYPE FIX)>
5210                     <SET NAME6 () (TYPE LIST)>
5211                     <SET HATOM17 () (TYPE LIST)>
5212                     <LOOP>
5213 MAP139
5214                     <INTGO>
5215                     <VEQUAL? LN11 2 + MAPAP142 (TYPE FIX)>
5216                     <SUB LN11 1 = LN11 (TYPE FIX)>
5217                     <GEN-LVAL 'IND = TAPL13>
5218                     <CONS TAPL13 () = TAPL13 (TYPE LIST)>
5219                     <EMPL? NAME6 - TAG155>
5220                     <SET NAME6 TAPL13 (TYPE LIST)>
5221                     <JUMP + TAG156>
5222 TAG155
5223                     <PUTREST HATOM17 TAPL13>
5224                     <DEAD HATOM17>
5225 TAG156
5226                     <SET HATOM17 TAPL13 (TYPE LIST)>
5227                     <DEAD TAPL13>
5228                     <JUMP + MAP139>
5229 MAPAP142
5230                     <LOOP (NAME6 VALUE) (APL14 VALUE)>
5231 TAG157
5232                     <INTGO>
5233                     <EMPL? NAME6 + TAG135>
5234                     <NTHL NAME6 1 = STACK>
5235                     <RESTL NAME6 1 = NAME6 (TYPE LIST)>
5236                     <ADD APL14 1 = APL14 (TYPE FIX)>
5237                     <JUMP + TAG157>
5238 TAG135
5239                     <CALL '\1aFORM APL14 = STACK>
5240                     <DEAD APL14>
5241                     <PUSH TT7>
5242                     <CALL '\1aPCOMP 2 = LN11>
5243 PHRASE133
5244                     <SET TEM19 LN11>
5245                     <DEAD LN11>
5246                     <FRAME '\1aPUTPROP>
5247                     <GEN-LVAL 'IND = STACK>
5248                     <PUSH 'PTHIS-OBJECT>
5249                     <CALL '\1aPUTPROP 2>
5250                     <NTHUV TEM19 5 = APL14 (TYPE LIST)>
5251                     <LOOP>
5252 MAP163
5253                     <INTGO>
5254                     <EMPL? APL14 + MAPAP166>
5255                     <NTHL APL14 1 = LN11>
5256                     <NTHUV LN11 1 = NAME6 (TYPE FIX)>
5257                     <VEQUAL? NAME6 61 - BOOL172 (TYPE FIX)>
5258                     <DEAD NAME6>
5259                     <ADD NN18 1 = NN18 (TYPE FIX)>
5260                     <PUTUV LN11 4 NN18>
5261                     <DEAD LN11>
5262 BOOL172
5263                     <RESTL APL14 1 = APL14 (TYPE LIST)>
5264                     <JUMP + MAP163>
5265 MAPAP166
5266                     <FRAME '\1aNODEFM>
5267                     <PUSH 62>
5268                     <PUSH TT7>
5269                     <PUSH %<>>
5270                     <PUSH %<>>
5271                     <CONS TEM19 () = STACK>
5272                     <DEAD TEM19>
5273                     <PUSH %<>>
5274                     <CALL '\1aNODEFM 6 = TEM19>
5275                     <JUMP + PHRASE175>
5276 PHRASE110
5277                     <FRAME '\1aPCOMP>
5278                     <PUSH TAPL13>
5279                     <DEAD TAPL13>
5280                     <PUSH TT7>
5281                     <CALL '\1aPCOMP 2 = TEM19>
5282 PHRASE175
5283                     <SET NAME6 () (TYPE LIST)>
5284                     <SET HATOM17 () (TYPE LIST)>
5285                     <RESTL OBJ9 1 = TAPL13 (TYPE LIST)>
5286                     <DEAD OBJ9>
5287                     <RESTL TAPL13 1 = OBJ9 (TYPE LIST)>
5288                     <DEAD TAPL13>
5289                     <LOOP>
5290 MAP178
5291                     <INTGO>
5292                     <EMPL? OBJ9 + MAPAP181>
5293                     <NTHL OBJ9 1 = TAPL13>
5294                     <FRAME '\1aPCOMP>
5295                     <PUSH TAPL13>
5296                     <DEAD TAPL13>
5297                     <PUSH TT7>
5298                     <CALL '\1aPCOMP 2 = TAPL13>
5299                     <CONS TAPL13 () = TAPL13 (TYPE LIST)>
5300                     <EMPL? NAME6 - TAG188>
5301                     <SET NAME6 TAPL13 (TYPE LIST)>
5302                     <JUMP + TAG189>
5303 TAG188
5304                     <PUTREST HATOM17 TAPL13>
5305                     <DEAD HATOM17>
5306 TAG189
5307                     <SET HATOM17 TAPL13 (TYPE LIST)>
5308                     <DEAD TAPL13>
5309                     <RESTL OBJ9 1 = OBJ9 (TYPE LIST)>
5310                     <JUMP + MAP178>
5311 MAPAP181
5312                     <CONS TEM19 NAME6 = OBJ9>
5313                     <DEAD TEM19 NAME6>
5314                     <CONS FINALF12 OBJ9 = OBJ9>
5315                     <DEAD FINALF12>
5316                     <PUTUV TT7 5 OBJ9 (TYPE LIST)>
5317                     <DEAD OBJ9>
5318                     <UNBIND TEMP3>
5319                     <DEAD TEMP3>
5320                     <ADJ -18>
5321                     <RETURN TT7>
5322                     <DEAD TT7>
5323                     <END \1aPMAPF-R>
5324 \\f
5325
5326 #WORD *25700047234*
5327 <GFCN \1aPMARGS ("VALUE" NODE ANY) O4>
5328                     <TEMP TEMP6>
5329                     <INTGO>
5330                     <FRAME '\1aNODEFM>
5331                     <PUSH 61>
5332                     <GEN-LVAL 'PARENT = STACK>
5333                     <PUSH %<>>
5334                     <PUSH %<>>
5335                     <PUSH ()>
5336                     <PUSH %<>>
5337                     <CALL '\1aNODEFM 6 = TEMP6>
5338                     <RETURN TEMP6>
5339                     <DEAD TEMP6>
5340                     <END \1aPMARGS>
5341 <COND (<GASSIGNED? PMAPF-R> <PUTPROP ,MAPF PAPPLY-OBJECT ,PMAPF-R> <PUTPROP ,MAPR PAPPLY-OBJECT ,PMAPF-R>)>
5342
5343 #WORD *26515773652*
5344 <GFCN \1aADECL-FCN ("VALUE" NODE ADECL) OBJ4>
5345                     <TEMP TEMP8 TT5:NODE>
5346                     <INTGO>
5347                     <FRAME '\1aNODEFM>
5348                     <PUSH 89>
5349                     <GEN-LVAL 'PARENT = STACK>
5350                     <PUSH %<>>
5351                     <PUSH 'ADECL>
5352                     <PUSH ()>
5353                     <PUSH %<>>
5354                     <CALL '\1aNODEFM 6 = TT5>
5355                     <LENUV OBJ4 = TEMP8 (TYPE FIX)>
5356                     <VEQUAL? TEMP8 2 - PHRASE12 (TYPE FIX)>
5357                     <DEAD TEMP8>
5358                     <NTHUV OBJ4 1 = TEMP8>
5359                     <TYPE? TEMP8 <TYPE-CODE SEGMENT> - PHRASE15>
5360                     <PUTUV TT5 1 3 (TYPE FIX)>
5361                     <PUTUV TT5 4 %<>>
5362                     <FRAME '\1aADECL-FCN>
5363                     <CHTYPE TEMP8 <TYPE-CODE FORM> = STACK>
5364                     <DEAD TEMP8>
5365                     <NTHUV OBJ4 2 = STACK>
5366                     <DEAD OBJ4>
5367                     <UBLOCK <TYPE-CODE VECTOR> 2 = TEMP8>
5368                     <CHTYPE TEMP8 <TYPE-CODE ADECL> = STACK>
5369                     <DEAD TEMP8>
5370                     <CALL '\1aADECL-FCN 1 = TEMP8>
5371                     <CONS TEMP8 () = TEMP8>
5372                     <PUTUV TT5 5 TEMP8 (TYPE LIST)>
5373                     <DEAD TEMP8>
5374                     <RETURN TT5>
5375                     <DEAD TT5>
5376 PHRASE15
5377                     <NTHUV OBJ4 2 = TEMP8>
5378                     <PUTUV TT5 4 TEMP8>
5379                     <DEAD TEMP8>
5380                     <FRAME '\1aPCOMP>
5381                     <NTHUV OBJ4 1 = STACK>
5382                     <DEAD OBJ4>
5383                     <PUSH TT5>
5384                     <CALL '\1aPCOMP 2 = TEMP8>
5385                     <CONS TEMP8 () = TEMP8>
5386                     <PUTUV TT5 5 TEMP8 (TYPE LIST)>
5387                     <DEAD TEMP8>
5388                     <RETURN TT5>
5389                     <DEAD TT5>
5390 PHRASE12
5391                     <FRAME '\1aCOMPILE-ERROR>
5392                     <PUSH "ADECL has an incorrect number of elements: ">
5393                     <PUSH OBJ4>
5394                     <DEAD OBJ4>
5395                     <CALL '\1aCOMPILE-ERROR 2 = TEMP8>
5396                     <RETURN TEMP8>
5397                     <DEAD TEMP8>
5398                     <END \1aADECL-FCN>
5399 <COND (<GASSIGNED? ADECL-FCN> <PUTPROP ADECL PTHIS-TYPE ,ADECL-FCN>)>
5400
5401 #WORD *5131071525*
5402 <GFCN \1aCASE-FCN ("VALUE" NODE <FORM ANY> ANY) OBJ4 AP5>
5403                     <TEMP OP6 TEMP3:LBIND TEMP17 (FLG8 'T) (WIN9 'T) TYP10 (DF11 %<>) TEMP23 P12 TEM13 TEMP86 TEMP40 TEMP121:LIST TT124:NODE>
5404                     <INTGO>
5405                     <GEN-LVAL 'PARENT = OP6>
5406                     <GETS 'BIND = TEMP3 (TYPE LBIND)>
5407                     <GEN-LVAL 'PARENT = TEMP17>
5408                     <BBIND 'PARENT 'NODE 'FIX TEMP17>
5409                     <DEAD TEMP17>
5410                     <SET TEMP17 OBJ4>
5411                     <SET TEMP23 4 (TYPE FIX)>
5412                     <LOOP (TEMP17 VALUE) (TEMP23 VALUE)>
5413 TAG24
5414                     <EMPL? TEMP17 + PHRASE21>
5415                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5416                     <SUB TEMP23 1 = TEMP23 (TYPE FIX)>
5417                     <GRTR? TEMP23 0 + TAG24 (TYPE FIX)>
5418                     <FRAME '\1aTYPE>
5419                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5420                     <NTHL TEMP17 1 = TEMP23>
5421                     <DEAD TEMP17>
5422                     <PUSH TEMP23>
5423                     <CALL '\1aTYPE 1 = TEMP17>
5424                     <VEQUAL? TEMP17 'GVAL - BOOL29>
5425                     <DEAD TEMP17>
5426                     <CHTYPE TEMP23 <TYPE-CODE ATOM> = P12>
5427                     <DEAD TEMP23>
5428                     <VEQUAL? P12 '==? + PHRASE33>
5429 BOOL29
5430                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5431                     <NTHL TEMP17 1 = TEMP23>
5432                     <DEAD TEMP17>
5433                     <TYPE? TEMP23 <TYPE-CODE FORM> - BOOL32>
5434                     <EMPL? TEMP23 + BOOL32>
5435                     <RESTL TEMP23 1 = TEMP17 (TYPE LIST)>
5436                     <EMPL? TEMP17 + BOOL32>
5437                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5438                     <EMPL? TEMP17 - BOOL32>
5439                     <DEAD TEMP17>
5440                     <NTHL TEMP23 1 = TEMP17>
5441                     <EQUAL? TEMP17 'GVAL - BOOL32>
5442                     <DEAD TEMP17>
5443                     <RESTL TEMP23 1 = TEMP17 (TYPE LIST)>
5444                     <DEAD TEMP23>
5445                     <NTHL TEMP17 1 = P12>
5446                     <DEAD TEMP17>
5447                     <EQUAL? P12 '==? + PHRASE33>
5448 BOOL32
5449                     <SET WIN9 %<> (TYPE FALSE)>
5450 PHRASE33
5451                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5452                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5453                     <RESTL TEMP17 1 = TEMP23 (TYPE LIST)>
5454                     <DEAD TEMP17>
5455                     <CHTYPE TEMP23 <TYPE-CODE LIST> = TEMP23>
5456                     <EMPL? TEMP23 + PHRASE21>
5457                     <LOOP>
5458 MAP35
5459                     <INTGO>
5460                     <EMPL? TEMP23 + MAPAP38>
5461                     <NTHL TEMP23 1 = TEMP17>
5462                     <VEQUAL? FLG8 0 + PHRASE48>
5463                     <EQUAL? TEMP17 'DEFAULT - PHRASE48>
5464                     <SET DF11 'T (TYPE ATOM)>
5465                     <JUMP + PHRASE90>
5466 PHRASE48
5467                     <VEQUAL? DF11 0 + PHRASE50>
5468                     <TYPE? TEMP17 <TYPE-CODE LIST> - PHRASE50>
5469                     <SET DF11 %<> (TYPE FALSE)>
5470                     <SET FLG8 %<> (TYPE FALSE)>
5471                     <JUMP + PHRASE90>
5472 PHRASE50
5473                     <VEQUAL? DF11 0 - PHRASE21>
5474                     <TYPE? TEMP17 <TYPE-CODE LIST> - PHRASE21>
5475                     <EMPL? TEMP17 + PHRASE21 (TYPE LIST)>
5476                     <FRAME '\1aVAL-CHK>
5477                     <NTHL TEMP17 1 = STACK>
5478                     <CALL '\1aVAL-CHK 1 = TEM13>
5479                     <TYPE? TEM13 <TYPE-CODE FALSE> + PHRASE55>
5480                     <TYPE? TYP10 <TYPE-CODE UNBOUND> + PHRASE58>
5481                     <FRAME '\1aTYPE>
5482                     <PUSH TEM13>
5483                     <DEAD TEM13>
5484                     <CALL '\1aTYPE 1 = TEMP17>
5485                     <VEQUAL? TYP10 TEMP17 + PHRASE90>
5486                     <DEAD TEMP17>
5487                     <SET WIN9 %<> (TYPE FALSE)>
5488                     <JUMP + PHRASE90>
5489 PHRASE58
5490                     <FRAME '\1aTYPE>
5491                     <PUSH TEM13>
5492                     <DEAD TEM13>
5493                     <CALL '\1aTYPE 1 = TYP10>
5494                     <JUMP + PHRASE90>
5495 PHRASE55
5496                     <NTHL TEMP17 1 = TEM13>
5497                     <DEAD TEMP17>
5498                     <TYPE? TEM13 <TYPE-CODE SEGMENT> - PHRASE63>
5499                     <EMPL? TEM13 + PHRASE63>
5500                     <RESTL TEM13 1 = TEMP17 (TYPE LIST)>
5501                     <EMPL? TEMP17 + PHRASE63>
5502                     <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5503                     <EMPL? TEMP17 - PHRASE63>
5504                     <DEAD TEMP17>
5505                     <NTHL TEM13 1 = TEMP17>
5506                     <EQUAL? TEMP17 'QUOTE - PHRASE63>
5507                     <DEAD TEMP17>
5508                     <RESTL TEM13 1 = TEMP17 (TYPE LIST)>
5509                     <DEAD TEM13>
5510                     <NTHL TEMP17 1 = TEM13>
5511                     <DEAD TEMP17>
5512                     <MONAD? TEM13 - TAG65>
5513                     <SET TEMP17 'T (TYPE ATOM)>
5514                     <JUMP + TAG67>
5515 TAG65
5516                     <SET TEMP17 %<> (TYPE FALSE)>
5517 TAG67
5518                     <VEQUAL? TEMP17 0 - PHRASE63>
5519                     <DEAD TEMP17>
5520                     <SET TEMP17 TEM13>
5521                     <DEAD TEM13>
5522                     <LOOP>
5523 MAP69
5524                     <INTGO>
5525                     <EMPTY? TEMP17 + PHRASE90>
5526                     <NTH1 TEMP17 = TEM13>
5527                     <FRAME '\1aVAL-CHK>
5528                     <PUSH TEM13>
5529                     <DEAD TEM13>
5530                     <CALL '\1aVAL-CHK 1 = TEM13>
5531                     <TYPE? TEM13 <TYPE-CODE FALSE> - PHRASE79>
5532                     <SET WIN9 %<> (TYPE FALSE)>
5533                     <JUMP + PHRASE87>
5534 PHRASE79
5535                     <TYPE? TYP10 <TYPE-CODE UNBOUND> + PHRASE83>
5536                     <FRAME '\1aTYPE>
5537                     <PUSH TEM13>
5538                     <DEAD TEM13>
5539                     <CALL '\1aTYPE 1 = TEMP86>
5540                     <VEQUAL? TYP10 TEMP86 + PHRASE87>
5541                     <DEAD TEMP86>
5542                     <SET WIN9 %<> (TYPE FALSE)>
5543                     <JUMP + PHRASE87>
5544 PHRASE83
5545                     <FRAME '\1aTYPE>
5546                     <PUSH TEM13>
5547                     <DEAD TEM13>
5548                     <CALL '\1aTYPE 1 = TYP10>
5549 PHRASE87
5550                     <REST1 TEMP17 = TEMP17>
5551                     <JUMP + MAP69>
5552 PHRASE63
5553                     <SET WIN9 %<> (TYPE FALSE)>
5554 PHRASE90
5555                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
5556                     <JUMP + MAP35>
5557 MAPAP38
5558                     <VEQUAL? DF11 0 - PHRASE21>
5559                     <VEQUAL? WIN9 0 + PHRASE92>
5560                     <FRAME '\1aTYPEPRIM>
5561                     <PUSH TYP10>
5562                     <CALL '\1aTYPEPRIM 1 = TEMP23>
5563                     <SET FLG8 [WORD FIX] (TYPE VECTOR)>
5564                     <TYPE? TEMP23 <TYPE-CODE ATOM> - BOOL95>
5565                     <LOOP (TEMP23 VALUE) (FLG8 LENGTH VALUE)>
5566 TAG97
5567                     <NTHUV FLG8 1 = TEMP40>
5568                     <VEQUAL? TEMP40 TEMP23 + TAG96>
5569                     <DEAD TEMP40>
5570                     <RESTUV FLG8 1 = FLG8 (TYPE VECTOR)>
5571                     <EMPUV? FLG8 - TAG97>
5572                     <JUMP + BOOL95>
5573 TAG96
5574                     <EQUAL? P12 '==? + PHRASE92>
5575 BOOL95
5576                     <EQUAL? P12 '==? + BOOL100>
5577                     <DEAD P12>
5578                     <VEQUAL? TYP10 'ATOM + PHRASE92>
5579                     <DEAD TYP10>
5580 BOOL100
5581                     <SET WIN9 %<> (TYPE FALSE)>
5582 PHRASE92
5583                     <VEQUAL? WIN9 0 + PHRASE102>
5584                     <DEAD WIN9>
5585                     <FRAME '\1aNODECOND>
5586                     <PUSH 80>
5587                     <PUSH OP6>
5588                     <DEAD OP6>
5589                     <PUSH %<>>
5590                     <PUSH 'CASE>
5591                     <PUSH ()>
5592                     <CALL '\1aNODECOND 5 = P12>
5593                     <NTHR 'PARENT 2 = FLG8 (RECORD-TYPE ATOM) (TYPE LBIND)>
5594                     <PUTR FLG8 1 P12 (RECORD-TYPE LBIND)>
5595                     <DEAD FLG8 P12>
5596                     <NTHR 'PARENT 2 = FLG8 (RECORD-TYPE ATOM) (TYPE LBIND)>
5597                     <NTHR FLG8 1 = P12 (RECORD-TYPE LBIND)>
5598                     <DEAD FLG8>
5599                     <FRAME '\1aPCOMP>
5600                     <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5601                     <NTHL TEMP17 1 = STACK>
5602                     <DEAD TEMP17>
5603                     <NTHR 'PARENT 2 = TEMP17 (RECORD-TYPE ATOM) (TYPE LBIND)>
5604                     <NTHR TEMP17 1 = STACK (RECORD-TYPE LBIND)>
5605                     <DEAD TEMP17>
5606                     <CALL '\1aPCOMP 2 = TEMP17>
5607                     <CONS TEMP17 () = TEMP17>
5608                     <FRAME '\1aPCOMP>
5609                     <RESTL OBJ4 1 = FLG8 (TYPE LIST)>
5610                     <RESTL FLG8 1 = FLG8 (TYPE LIST)>
5611                     <NTHL FLG8 1 = STACK>
5612                     <DEAD FLG8>
5613                     <NTHR 'PARENT 2 = FLG8 (RECORD-TYPE ATOM) (TYPE LBIND)>
5614                     <NTHR FLG8 1 = STACK (RECORD-TYPE LBIND)>
5615                     <DEAD FLG8>
5616                     <CALL '\1aPCOMP 2 = FLG8>
5617                     <CONS FLG8 () = FLG8>
5618                     <PUTREST TEMP17 FLG8>
5619                     <SET TEMP86 () (TYPE LIST)>
5620                     <SET TEMP40 () (TYPE LIST)>
5621                     <RESTL OBJ4 1 = OP6 (TYPE LIST)>
5622                     <DEAD OBJ4>
5623                     <RESTL OP6 1 = OP6 (TYPE LIST)>
5624                     <RESTL OP6 1 = TEMP121 (TYPE LIST)>
5625                     <DEAD OP6>
5626                     <CHTYPE TEMP121 <TYPE-CODE LIST> = TEMP121>
5627                     <LOOP>
5628 MAP115
5629                     <INTGO>
5630                     <EMPL? TEMP121 + MAPAP118>
5631                     <NTHL TEMP121 1 = WIN9>
5632                     <VEQUAL? DF11 0 + TAG130>
5633                     <DEAD DF11>
5634                     <PUSH 'ELSE>
5635                     <SET TEMP23 1 (TYPE FIX)>
5636                     <SET OP6 WIN9>
5637                     <DEAD WIN9>
5638                     <TYPE OP6 = TYP10>
5639                     <AND TYP10 7 = TYP10>
5640                     <VEQUAL? TYP10 1 + TAG129>
5641                     <DEAD TYP10>
5642                     <LOOP (OP6 TYPE VALUE LENGTH) (TEMP23 VALUE)>
5643 TAG135
5644                     <INTGO>
5645                     <EMPTY? OP6 + TAG134>
5646                     <NTH1 OP6 = STACK>
5647                     <REST1 OP6 = OP6>
5648                     <ADD TEMP23 1 = TEMP23 (TYPE FIX)>
5649                     <JUMP + TAG135>
5650 TAG134
5651                     <LIST TEMP23 = WIN9 (TYPE LIST)>
5652                     <DEAD TEMP23>
5653                     <JUMP + TAG130>
5654 TAG129
5655                     <LOOP>
5656 TAG132
5657                     <VEQUAL? TEMP23 0 + TAG131>
5658                     <POP = TYP10>
5659                     <CONS TYP10 OP6 = OP6 (TYPE LIST)>
5660                     <DEAD TYP10>
5661                     <SUB TEMP23 1 = TEMP23 (TYPE FIX)>
5662                     <JUMP + TAG132>
5663 TAG131
5664                     <SET WIN9 OP6>
5665                     <DEAD OP6>
5666 TAG130
5667                     <TYPE? WIN9 <TYPE-CODE ATOM> + PHRASE137>
5668                     <FRAME '\1aNODEB>
5669                     <PUSH 8>
5670                     <NTHR 'PARENT 2 = OP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
5671                     <NTHR OP6 1 = STACK (RECORD-TYPE LBIND)>
5672                     <DEAD OP6>
5673                     <PUSH %<>>
5674                     <PUSH %<>>
5675                     <PUSH ()>
5676                     <CALL '\1aNODEB 5 = TT124>
5677                     <FRAME '\1aPCOMP>
5678                     <NTHL WIN9 1 = TEM13>
5679                     <TYPE? TEM13 <TYPE-CODE SEGMENT> - PHRASE143>
5680                     <FRAME '\1aFORM>
5681                     <PUSH 'QUOTE>
5682                     <SET TYP10 () (TYPE LIST)>
5683                     <SET OP6 () (TYPE LIST)>
5684                     <RESTL TEM13 1 = DF11 (TYPE LIST)>
5685                     <DEAD TEM13>
5686                     <NTHL DF11 1 = DF11>
5687                     <LOOP>
5688 MAP146
5689                     <INTGO>
5690                     <EMPTY? DF11 + MAP145>
5691                     <FRAME '\1aVAL-CHK>
5692                     <NTH1 DF11 = STACK>
5693                     <CALL '\1aVAL-CHK 1 = TEMP23>
5694                     <CONS TEMP23 () = TEMP23 (TYPE LIST)>
5695                     <EMPL? TYP10 - TAG152>
5696                     <SET TYP10 TEMP23 (TYPE LIST)>
5697                     <JUMP + TAG153>
5698 TAG152
5699                     <PUTREST OP6 TEMP23>
5700                     <DEAD OP6>
5701 TAG153
5702                     <SET OP6 TEMP23 (TYPE LIST)>
5703                     <DEAD TEMP23>
5704                     <REST1 DF11 = DF11>
5705                     <JUMP + MAP146>
5706 MAP145
5707                     <PUSH TYP10>
5708                     <DEAD TYP10>
5709                     <CALL '\1aFORM 2 = DF11>
5710                     <JUMP + PHRASE165>
5711 PHRASE143
5712                     <TYPE? TEM13 <TYPE-CODE ORQ> - PHRASE154>
5713                     <FRAME '\1aFORM>
5714                     <PUSH 'QUOTE>
5715                     <SET OP6 () (TYPE LIST)>
5716                     <SET TYP10 () (TYPE LIST)>
5717                     <CHTYPE TEM13 <TYPE-CODE LIST> = TEMP23>
5718                     <DEAD TEM13>
5719                     <LOOP>
5720 MAP157
5721                     <INTGO>
5722                     <EMPL? TEMP23 + MAP156>
5723                     <FRAME '\1aVAL-CHK>
5724                     <NTHL TEMP23 1 = STACK>
5725                     <CALL '\1aVAL-CHK 1 = DF11>
5726                     <CONS DF11 () = DF11 (TYPE LIST)>
5727                     <EMPL? OP6 - TAG163>
5728                     <SET OP6 DF11 (TYPE LIST)>
5729                     <JUMP + TAG164>
5730 TAG163
5731                     <PUTREST TYP10 DF11>
5732                     <DEAD TYP10>
5733 TAG164
5734                     <SET TYP10 DF11 (TYPE LIST)>
5735                     <DEAD DF11>
5736                     <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
5737                     <JUMP + MAP157>
5738 MAP156
5739                     <PUSH OP6>
5740                     <DEAD OP6>
5741                     <CALL '\1aFORM 2 = DF11>
5742                     <JUMP + PHRASE165>
5743 PHRASE154
5744                     <FRAME '\1aVAL-CHK>
5745                     <PUSH TEM13>
5746                     <DEAD TEM13>
5747                     <CALL '\1aVAL-CHK 1 = DF11>
5748 PHRASE165
5749                     <PUSH DF11>
5750                     <DEAD DF11>
5751                     <PUSH TT124>
5752                     <CALL '\1aPCOMP 2 = DF11>
5753                     <PUTUV TT124 4 DF11>
5754                     <DEAD DF11>
5755                     <SET OP6 () (TYPE LIST)>
5756                     <SET TEMP23 () (TYPE LIST)>
5757                     <RESTL WIN9 1 = WIN9 (TYPE LIST)>
5758                     <LOOP>
5759 MAP168
5760                     <INTGO>
5761                     <EMPL? WIN9 + MAPAP171>
5762                     <NTHL WIN9 1 = TYP10>
5763                     <FRAME '\1aPCOMP>
5764                     <PUSH TYP10>
5765                     <DEAD TYP10>
5766                     <PUSH TT124>
5767                     <CALL '\1aPCOMP 2 = TYP10>
5768                     <CONS TYP10 () = TYP10 (TYPE LIST)>
5769                     <EMPL? OP6 - TAG179>
5770                     <SET OP6 TYP10 (TYPE LIST)>
5771                     <JUMP + TAG180>
5772 TAG179
5773                     <PUTREST TEMP23 TYP10>
5774                     <DEAD TEMP23>
5775 TAG180
5776                     <SET TEMP23 TYP10 (TYPE LIST)>
5777                     <DEAD TYP10>
5778                     <RESTL WIN9 1 = WIN9 (TYPE LIST)>
5779                     <JUMP + MAP168>
5780 MAPAP171
5781                     <PUTUV TT124 5 OP6 (TYPE LIST)>
5782                     <DEAD OP6>
5783                     <SET DF11 %<> (TYPE FALSE)>
5784                     <SET WIN9 TT124>
5785                     <DEAD TT124>
5786                     <JUMP + PHRASE181>
5787 PHRASE137
5788                     <SET DF11 'T (TYPE ATOM)>
5789                     <FRAME '\1aPCOMP>
5790                     <PUSH WIN9>
5791                     <DEAD WIN9>
5792                     <NTHR 'PARENT 2 = TYP10 (RECORD-TYPE ATOM) (TYPE LBIND)>
5793                     <NTHR TYP10 1 = STACK (RECORD-TYPE LBIND)>
5794                     <DEAD TYP10>
5795                     <CALL '\1aPCOMP 2 = WIN9>
5796 PHRASE181
5797                     <CONS WIN9 () = WIN9 (TYPE LIST)>
5798                     <EMPL? TEMP86 - TAG185>
5799                     <SET TEMP86 WIN9 (TYPE LIST)>
5800                     <JUMP + TAG186>
5801 TAG185
5802                     <PUTREST TEMP40 WIN9>
5803                     <DEAD TEMP40>
5804 TAG186
5805                     <SET TEMP40 WIN9 (TYPE LIST)>
5806                     <DEAD WIN9>
5807                     <RESTL TEMP121 1 = TEMP121 (TYPE LIST)>
5808                     <JUMP + MAP115>
5809 MAPAP118
5810                     <PUTREST FLG8 TEMP86>
5811                     <DEAD FLG8 TEMP86>
5812                     <PUTUV P12 5 TEMP17 (TYPE LIST)>
5813                     <DEAD TEMP17>
5814                     <JUMP + PHRASE189>
5815 PHRASE102
5816                     <FRAME '\1aPMACRO>
5817                     <PUSH OBJ4>
5818                     <DEAD OBJ4>
5819                     <PUSH OP6>
5820                     <DEAD OP6>
5821                     <CALL '\1aPMACRO 2 = P12>
5822                     <JUMP + PHRASE189>
5823 PHRASE21
5824                     <FRAME '\1aCOMPILE-ERROR>
5825                     <PUSH "CASE in incorrect format ">
5826                     <PUSH OBJ4>
5827                     <DEAD OBJ4>
5828                     <CALL '\1aCOMPILE-ERROR 2 = P12>
5829 PHRASE189
5830                     <UNBIND TEMP3>
5831                     <DEAD TEMP3>
5832                     <ADJ -9>
5833                     <RETURN P12>
5834                     <DEAD P12>
5835                     <END \1aCASE-FCN>
5836 #WORD *6504162601*
5837 <GFCN \1aVAL-CHK ("VALUE" ANY ANY) TEM4>
5838                     <TEMP TEMP11 TEMP26>
5839                     <INTGO>
5840                     <TYPE? TEM4 <TYPE-CODE ATOM> + BOOL9>
5841                     <FRAME '\1aPRIMTYPE>
5842                     <PUSH TEM4>
5843                     <CALL '\1aPRIMTYPE 1 = TEMP11>
5844                     <VEQUAL? TEMP11 'WORD + BOOL9>
5845                     <DEAD TEMP11>
5846                     <FRAME '\1aPRIMTYPE>
5847                     <PUSH TEM4>
5848                     <CALL '\1aPRIMTYPE 1 = TEMP11>
5849                     <VEQUAL? TEMP11 'FIX - BOOL8>
5850                     <DEAD TEMP11>
5851 BOOL9
5852                     <SET TEMP11 TEM4>
5853                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5854 BOOL8
5855                     <FRAME '\1aTYPE>
5856                     <PUSH TEM4>
5857                     <CALL '\1aTYPE 1 = TEMP11>
5858                     <VEQUAL? TEMP11 'GVAL - BOOL13>
5859                     <DEAD TEMP11>
5860                     <FRAME '\1aMANIFESTQ>
5861                     <CHTYPE TEM4 <TYPE-CODE ATOM> = TEM4>
5862                     <PUSH TEM4>
5863                     <CALL '\1aMANIFESTQ 1 = TEMP11>
5864                     <TYPE? TEMP11 <TYPE-CODE FALSE> + BOOL13>
5865                     <DEAD TEMP11>
5866                     <GVAL TEM4 = TEMP11>
5867                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5868 BOOL13
5869                     <TYPE? TEM4 <TYPE-CODE FORM> - BOOL21>
5870                     <EMPL? TEM4 + BOOL21>
5871                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5872                     <EMPL? TEMP11 + BOOL21>
5873                     <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
5874                     <EMPL? TEMP11 - BOOL21>
5875                     <DEAD TEMP11>
5876                     <NTHL TEM4 1 = TEMP11>
5877                     <EQUAL? TEMP11 'QUOTE - BOOL18>
5878                     <DEAD TEMP11>
5879                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5880                     <NTHL TEMP11 1 = TEMP11>
5881                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5882 BOOL18
5883                     <NTHL TEM4 1 = TEMP11>
5884                     <EQUAL? TEMP11 'GVAL - BOOL19>
5885                     <DEAD TEMP11>
5886                     <FRAME '\1aMANIFESTQ>
5887                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5888                     <NTHL TEMP11 1 = STACK (TYPE ATOM)>
5889                     <DEAD TEMP11>
5890                     <CALL '\1aMANIFESTQ 1 = TEMP11>
5891                     <TYPE? TEMP11 <TYPE-CODE FALSE> + BOOL19>
5892                     <DEAD TEMP11>
5893                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5894                     <NTHL TEMP11 1 = TEMP11 (TYPE ATOM)>
5895                     <GVAL TEMP11 = TEMP11>
5896                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5897 BOOL19
5898                     <NTHL TEM4 1 = TEMP11>
5899                     <EQUAL? TEMP11 'ASCII - BOOL21>
5900                     <DEAD TEMP11>
5901                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5902                     <NTHL TEMP11 1 = TEMP11>
5903                     <TYPE? TEMP11 <TYPE-CODE CHARACTER> + TAG22>
5904                     <TYPE? TEMP11 <TYPE-CODE FIX> - BOOL21>
5905                     <DEAD TEMP11>
5906 TAG22
5907                     <FRAME '\1aEVAL>
5908                     <PUSH TEM4>
5909                     <CALL '\1aEVAL 1 = TEMP11>
5910                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5911 BOOL21
5912                     <TYPE? TEM4 <TYPE-CODE FORM> - BOOL24>
5913                     <SET TEMP11 TEM4>
5914                     <SET TEMP26 3 (TYPE FIX)>
5915                     <LOOP (TEMP11 VALUE) (TEMP26 VALUE)>
5916 TAG27
5917                     <EMPL? TEMP11 + BOOL24>
5918                     <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
5919                     <SUB TEMP26 1 = TEMP26 (TYPE FIX)>
5920                     <GRTR? TEMP26 0 + TAG27 (TYPE FIX)>
5921                     <EMPL? TEMP11 - BOOL24>
5922                     <DEAD TEMP11>
5923                     <NTHL TEM4 1 = TEMP11>
5924                     <EQUAL? TEMP11 'CHTYPE - BOOL24>
5925                     <DEAD TEMP11>
5926                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5927                     <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
5928                     <NTHL TEMP11 1 = TEMP11>
5929                     <TYPE? TEMP11 <TYPE-CODE ATOM> - BOOL24>
5930                     <DEAD TEMP11>
5931                     <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5932                     <NTHL TEMP11 1 = TEMP11>
5933                     <TYPE? TEMP11 <TYPE-CODE FORM> + BOOL24>
5934                     <TYPE? TEMP11 <TYPE-CODE LIST> + BOOL24>
5935                     <TYPE? TEMP11 <TYPE-CODE VECTOR> + BOOL24>
5936                     <TYPE? TEMP11 <TYPE-CODE UVECTOR> + BOOL24>
5937                     <TYPE? TEMP11 <TYPE-CODE SEGMENT> + BOOL24>
5938                     <DEAD TEMP11>
5939                     <FRAME '\1aEVAL>
5940                     <PUSH TEM4>
5941                     <CALL '\1aEVAL 1 = TEMP11>
5942                     <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5943 BOOL24
5944                     <TYPE? TEM4 <TYPE-CODE FORM> + TAG30>
5945                     <RETURN %<>>
5946 TAG30
5947                     <EMPL? TEM4 - TAG32 (TYPE FORM)>
5948                     <RETURN %<>>
5949 TAG32
5950                     <NTHL TEM4 1 = TEMP26>
5951                     <TYPE? TEMP26 <TYPE-CODE ATOM> + TAG33>
5952                     <RETURN %<>>
5953 TAG33
5954                     <NTHR TEMP26 1 = TEMP11 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG36)>
5955                     <TYPE? TEMP11 <TYPE-CODE FALSE> + TAG36>
5956                     <NTHR TEMP11 1 = TEMP11 (RECORD-TYPE GBIND)>
5957                     <TYPE? TEMP11 <TYPE-CODE UNBOUND> - TAG35>
5958                     <DEAD TEMP11>
5959 TAG36
5960                     <RETURN %<>>
5961 TAG35
5962                     <GVAL TEMP26 = TEMP11>
5963                     <DEAD TEMP26>
5964                     <TYPE? TEMP11 <TYPE-CODE MACRO> + TAG37>
5965                     <DEAD TEMP11>
5966                     <RETURN %<>>
5967 TAG37
5968                     <FRAME '\1aVAL-CHK>
5969                     <FRAME '\1aEMACRO>
5970                     <PUSH TEM4>
5971                     <DEAD TEM4>
5972                     <CALL '\1aEMACRO 1 = STACK>
5973                     <CALL '\1aVAL-CHK 1 = TEMP11>
5974 BOOL29
5975                     <RETURN TEMP11>
5976                     <DEAD TEMP11>
5977                     <END \1aVAL-CHK>
5978 #WORD *25776244411*
5979 <GFCN \1aMANIFESTQ ("VALUE" <OR ATOM FALSE> ATOM) ATM4>
5980                     <TEMP TEMP6>
5981                     <INTGO>
5982                     <FRAME '\1aMANIFEST?>
5983                     <PUSH ATM4>
5984                     <CALL '\1aMANIFEST? 1 = TEMP6>
5985                     <TYPE? TEMP6 <TYPE-CODE FALSE> + TAG12>
5986                     <NTHR ATM4 1 = TEMP6 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG9)>
5987                     <TYPE? TEMP6 <TYPE-CODE FALSE> + TAG9>
5988                     <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE GBIND)>
5989                     <TYPE? TEMP6 <TYPE-CODE UNBOUND> - TAG8>
5990                     <DEAD TEMP6>
5991 TAG9
5992                     <RETURN %<>>
5993 TAG8
5994                     <GVAL ATM4 = TEMP6>
5995                     <DEAD ATM4>
5996                     <TYPE? TEMP6 <TYPE-CODE MSUBR> - TAG11>
5997                     <DEAD TEMP6>
5998                     <RETURN %<>>
5999 TAG11
6000                     <SET TEMP6 'T (TYPE ATOM)>
6001 TAG12
6002                     <RETURN TEMP6>
6003                     <DEAD TEMP6>
6004                     <END \1aMANIFESTQ>
6005 #WORD *22437646733*
6006 <GFCN \1aEMACRO ("VALUE" ANY ANY) OBJ4>
6007                     <TEMP ERR5 TEM6>
6008                     <INTGO>
6009                     <FRAME '\1aHANDLER>
6010                     <GVAL 'MACROERR = STACK>
6011                     <PUSH 100>
6012                     <CALL '\1aHANDLER 2 = ERR5>
6013                     <FRAME '\1aON>
6014                     <PUSH ERR5>
6015                     <CALL '\1aON 1>
6016                     <ICALL EXIT11 = TEM6>
6017                     <TEMP TEMP12 TEMP15>
6018                     <INTGO>
6019                     <CFRAME = TEMP12>
6020                     <NTHR TEMP12 5 = TEMP12 (RECORD-TYPE FRAME)>
6021                     <CFRAME = TEMP15 (TYPE FRAME)>
6022                     <BBIND 'MACACT 'ANY 'FIX TEMP15>
6023                     <DEAD TEMP15>
6024                     <ACTIVATION>
6025                     <SETLR TEMP15 TEMP12 ERR5>
6026                     <SETG 'ERR TEMP15>
6027                     <DEAD TEMP15>
6028                     <NTHR 'MACACT 2 = TEMP15 (RECORD-TYPE ATOM) (TYPE LBIND)>
6029                     <NTHR TEMP15 1 = TEMP15 (RECORD-TYPE LBIND)>
6030                     <SETG 'MACACT TEMP15>
6031                     <DEAD TEMP15>
6032                     <FRAME '\1aEXPAND>
6033                     <SETLR TEMP15 TEMP12 OBJ4>
6034                     <PUSH TEMP15>
6035                     <DEAD TEMP15>
6036                     <CALL '\1aEXPAND 1 = TEMP15>
6037                     <RETURN TEMP15>
6038                     <DEAD TEMP15>
6039 EXIT11
6040                     <TYPE? TEM6 <TYPE-CODE FUNNY> - PHRASE10>
6041                     <FRAME '\1aOFF>
6042                     <PUSH ERR5>
6043                     <DEAD ERR5>
6044                     <CALL '\1aOFF 1>
6045                     <FRAME '\1aCOMPILE-ERROR>
6046                     <PUSH "Macro expansion lossage ">
6047                     <GVAL 'CR = STACK>
6048                     <SET ERR5 2 (TYPE FIX)>
6049                     <LOOP (TEM6 VALUE LENGTH) (ERR5 VALUE)>
6050 TAG24
6051                     <INTGO>
6052                     <EMPUV? TEM6 + TAG21>
6053                     <NTHUV TEM6 1 = STACK>
6054                     <RESTUV TEM6 1 = TEM6 (TYPE VECTOR)>
6055                     <ADD ERR5 1 = ERR5 (TYPE FIX)>
6056                     <JUMP + TAG24>
6057 TAG21
6058                     <CALL '\1aCOMPILE-ERROR ERR5 = ERR5>
6059                     <RETURN ERR5>
6060                     <DEAD ERR5>
6061 PHRASE10
6062                     <FRAME '\1aOFF>
6063                     <PUSH ERR5>
6064                     <DEAD ERR5>
6065                     <CALL '\1aOFF 1>
6066                     <RETURN TEM6>
6067                     <DEAD TEM6>
6068                     <END \1aEMACRO>
6069 <COND (<AND <GASSIGNED? CASE> <GASSIGNED? CASE-FCN>> <PUTPROP ,CASE PAPPLY-OBJECT ,CASE-FCN>)>
6070
6071 #WORD *36345703562*
6072 <GFCN \1aP-CALL ("VALUE" NODE FORM ANY) OBJ4 AP5>
6073                     <TEMP TEMP8 TT6:NODE TEMP34 TEMP38:LIST O39>
6074                     <INTGO>
6075                     <FRAME '\1aNODEFM>
6076                     <PUSH 90>
6077                     <GEN-LVAL 'PARENT = STACK>
6078                     <PUSH %<>>
6079                     <PUSH 'CALL>
6080                     <PUSH ()>
6081                     <PUSH AP5>
6082                     <DEAD AP5>
6083                     <CALL '\1aNODEFM 6 = TT6>
6084                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
6085                     <CHTYPE TEMP8 <TYPE-CODE LIST> = TEMP8>
6086                     <EMPL? TEMP8 + PHRASE23 (TYPE LIST)>
6087                     <DEAD TEMP8>
6088                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
6089                     <NTHL TEMP8 1 = TEMP8>
6090                     <GEN-SET 'CALLED TEMP8>
6091                     <TYPE? TEMP8 <TYPE-CODE ATOM> - PHRASE23>
6092                     <DEAD TEMP8>
6093                     <GEN-LVAL 'CALLED = TEMP8>
6094                     <EQUAL? TEMP8 'IFSYS - PHRASE18>
6095                     <DEAD TEMP8>
6096                     <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
6097                     <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
6098                     <NTHL TEMP8 1 = TEMP8>
6099                     <GEN-SET 'IN-IFSYS TEMP8>
6100                     <DEAD TEMP8>
6101                     <JUMP + PHRASE23>
6102 PHRASE18
6103                     <GEN-LVAL 'CALLED = TEMP8>
6104                     <EQUAL? TEMP8 'ENDIF - PHRASE23>
6105                     <DEAD TEMP8>
6106                     <GEN-SET 'IN-IFSYS %<>>
6107 PHRASE23
6108                     <SET TEMP8 () (TYPE LIST)>
6109                     <SET TEMP34 () (TYPE LIST)>
6110                     <RESTL OBJ4 1 = TEMP38 (TYPE LIST)>
6111                     <DEAD OBJ4>
6112                     <CHTYPE TEMP38 <TYPE-CODE LIST> = TEMP38>
6113                     <LOOP>
6114 MAP29
6115                     <INTGO>
6116                     <EMPL? TEMP38 + MAPAP32>
6117                     <NTHL TEMP38 1 = O39>
6118                     <FRAME '\1aPCOMP>
6119                     <PUSH O39>
6120                     <DEAD O39>
6121                     <PUSH TT6>
6122                     <CALL '\1aPCOMP 2 = O39>
6123                     <CONS O39 () = O39 (TYPE LIST)>
6124                     <EMPL? TEMP8 - TAG42>
6125                     <SET TEMP8 O39 (TYPE LIST)>
6126                     <JUMP + TAG43>
6127 TAG42
6128                     <PUTREST TEMP34 O39>
6129                     <DEAD TEMP34>
6130 TAG43
6131                     <SET TEMP34 O39 (TYPE LIST)>
6132                     <DEAD O39>
6133                     <RESTL TEMP38 1 = TEMP38 (TYPE LIST)>
6134                     <JUMP + MAP29>
6135 MAPAP32
6136                     <PUTUV TT6 5 TEMP8 (TYPE LIST)>
6137                     <DEAD TEMP8>
6138                     <RETURN TT6>
6139                     <DEAD TT6>
6140                     <END \1aP-CALL>
6141 #WORD *4132151002*
6142 <GFCN \1aP-APPLY ("VALUE" NODE FORM ANY) OBJ4 AP5>
6143                     <TEMP PAP10 ITM7 TEMP22 TEMP21 TT6:NODE>
6144                     <INTGO>
6145                     <RESTL OBJ4 1 = PAP10 (TYPE LIST)>
6146                     <CHTYPE PAP10 <TYPE-CODE LIST> = PAP10>
6147                     <EMPL? PAP10 + PHRASE12 (TYPE LIST)>
6148                     <DEAD PAP10>
6149                     <RESTL OBJ4 1 = PAP10 (TYPE LIST)>
6150                     <NTHL PAP10 1 = ITM7>
6151                     <DEAD PAP10>
6152                     <TYPE? ITM7 <TYPE-CODE SEGMENT> - PHRASE12>
6153                     <EMPL? ITM7 + PHRASE16>
6154                     <RESTL ITM7 1 = PAP10 (TYPE LIST)>
6155                     <EMPL? PAP10 + PHRASE16>
6156                     <RESTL PAP10 1 = PAP10 (TYPE LIST)>
6157                     <EMPL? PAP10 - PHRASE16>
6158                     <DEAD PAP10>
6159                     <NTHL ITM7 1 = PAP10>
6160                     <EQUAL? PAP10 'GVAL + BOOL18>
6161                     <EQUAL? PAP10 'LVAL - PHRASE16>
6162                     <DEAD PAP10>
6163 BOOL18
6164                     <FRAME '\1aFORM>
6165                     <PUSH 1>
6166                     <PUSH ITM7>
6167                     <CALL '\1aFORM 2 = PAP10>
6168                     <CONS PAP10 () = PAP10>
6169                     <CONS ITM7 () = ITM7>
6170                     <CONS 'REST ITM7 = ITM7>
6171                     <CHTYPE ITM7 <TYPE-CODE SEGMENT> = ITM7>
6172                     <CONS ITM7 () = ITM7>
6173                     <PUTREST PAP10 ITM7>
6174                     <RESTL OBJ4 1 = TEMP22 (TYPE LIST)>
6175                     <DEAD OBJ4>
6176                     <RESTL TEMP22 1 = TEMP21 (TYPE LIST)>
6177                     <DEAD TEMP22>
6178                     <CHTYPE TEMP21 <TYPE-CODE LIST> = TEMP21>
6179                     <PUTREST ITM7 TEMP21>
6180                     <DEAD ITM7 TEMP21>
6181                     <CHTYPE PAP10 <TYPE-CODE FORM> = OBJ4>
6182                     <DEAD PAP10>
6183                     <JUMP + PHRASE33>
6184 PHRASE16
6185                     <FRAME '\1aPCOMP>
6186                     <FRAME '\1aFORM>
6187                     <PUSH 'BIND>
6188                     <FRAME '\1aMAKE-TAG>
6189                     <PUSH "A">
6190                     <CALL '\1aMAKE-TAG 1 = PAP10>
6191                     <CONS PAP10 () = TEMP21>
6192                     <CONS ITM7 () = TEMP22>
6193                     <DEAD ITM7>
6194                     <PUTREST TEMP21 TEMP22>
6195                     <DEAD TEMP22>
6196                     <CONS TEMP21 () = STACK>
6197                     <DEAD TEMP21>
6198                     <CONS 'APPLY () = TEMP21>
6199                     <FRAME '\1aFORM>
6200                     <PUSH 1>
6201                     <FRAME '\1aFORM>
6202                     <PUSH 'LVAL>
6203                     <PUSH PAP10>
6204                     <CALL '\1aFORM 2 = STACK>
6205                     <CALL '\1aFORM 2 = TEMP22>
6206                     <CONS TEMP22 () = TEMP22>
6207                     <PUTREST TEMP21 TEMP22>
6208                     <CONS 'REST () = ITM7>
6209                     <FRAME '\1aFORM>
6210                     <PUSH 'LVAL>
6211                     <PUSH PAP10>
6212                     <DEAD PAP10>
6213                     <CALL '\1aFORM 2 = PAP10>
6214                     <CONS PAP10 () = PAP10>
6215                     <PUTREST ITM7 PAP10>
6216                     <DEAD PAP10>
6217                     <CHTYPE ITM7 <TYPE-CODE SEGMENT> = ITM7>
6218                     <CONS ITM7 () = ITM7>
6219                     <PUTREST TEMP22 ITM7>
6220                     <DEAD TEMP22>
6221                     <RESTL OBJ4 1 = PAP10 (TYPE LIST)>
6222                     <DEAD OBJ4>
6223                     <RESTL PAP10 1 = TEMP22 (TYPE LIST)>
6224                     <DEAD PAP10>
6225                     <CHTYPE TEMP22 <TYPE-CODE LIST> = TEMP22>
6226                     <PUTREST ITM7 TEMP22>
6227                     <DEAD ITM7 TEMP22>
6228                     <CHTYPE TEMP21 <TYPE-CODE FORM> = STACK>
6229                     <DEAD TEMP21>
6230                     <CALL '\1aFORM 3 = STACK>
6231                     <GEN-LVAL 'PARENT = STACK>
6232                     <CALL '\1aPCOMP 2 = PAP10>
6233                     <RETURN PAP10>
6234                     <DEAD PAP10>
6235 PHRASE12
6236                     <RESTL OBJ4 1 = ITM7 (TYPE LIST)>
6237                     <DEAD OBJ4>
6238                     <CHTYPE ITM7 <TYPE-CODE LIST> = ITM7>
6239                     <CHTYPE ITM7 <TYPE-CODE FORM> = OBJ4>
6240                     <DEAD ITM7>
6241 PHRASE33
6242                     <FRAME '\1aNODEFM>
6243                     <PUSH 93>
6244                     <GEN-LVAL 'PARENT = STACK>
6245                     <PUSH %<>>
6246                     <PUSH 'APPLY>
6247                     <PUSH ()>
6248                     <PUSH AP5>
6249                     <DEAD AP5>
6250                     <CALL '\1aNODEFM 6 = TT6>
6251                     <SET ITM7 () (TYPE LIST)>
6252                     <SET PAP10 () (TYPE LIST)>
6253                     <CHTYPE OBJ4 <TYPE-CODE LIST> = TEMP22>
6254                     <DEAD OBJ4>
6255                     <LOOP>
6256 MAP38
6257                     <INTGO>
6258                     <EMPL? TEMP22 + MAPAP41>
6259                     <NTHL TEMP22 1 = TEMP21>
6260                     <FRAME '\1aPCOMP>
6261                     <PUSH TEMP21>
6262                     <DEAD TEMP21>
6263                     <PUSH TT6>
6264                     <CALL '\1aPCOMP 2 = TEMP21>
6265                     <CONS TEMP21 () = TEMP21 (TYPE LIST)>
6266                     <EMPL? ITM7 - TAG49>
6267                     <SET ITM7 TEMP21 (TYPE LIST)>
6268                     <JUMP + TAG50>
6269 TAG49
6270                     <PUTREST PAP10 TEMP21>
6271                     <DEAD PAP10>
6272 TAG50
6273                     <SET PAP10 TEMP21 (TYPE LIST)>
6274                     <DEAD TEMP21>
6275                     <RESTL TEMP22 1 = TEMP22 (TYPE LIST)>
6276                     <JUMP + MAP38>
6277 MAPAP41
6278                     <PUTUV TT6 5 ITM7 (TYPE LIST)>
6279                     <DEAD ITM7>
6280                     <RETURN TT6>
6281                     <DEAD TT6>
6282                     <END \1aP-APPLY>
6283 <COND (<GASSIGNED? P-CALL> <PUTPROP `CALL PAPPLY-OBJECT ,P-CALL>)>
6284
6285 #WORD *23350240212*
6286 <GFCN \1aPRINT-HACKERS ("VALUE" NODE FORM ANY) OBJ4 AP5>
6287                     <TEMP TEMP9 LEN6>
6288                     <INTGO>
6289                     <NTHL OBJ4 1 = TEMP9>
6290                     <EQUAL? TEMP9 'CRLF - PHRASE8>
6291                     <DEAD TEMP9>
6292                     <SET TEMP9 1 (TYPE FIX)>
6293                     <JUMP + PHRASE10>
6294 PHRASE8
6295                     <SET TEMP9 2 (TYPE FIX)>
6296 PHRASE10
6297                     <SET LEN6 TEMP9>
6298                     <DEAD TEMP9>
6299                     <LENL OBJ4 = TEMP9 (TYPE FIX)>
6300                     <VEQUAL? LEN6 TEMP9 - PHRASE18 (TYPE FIX)>
6301                     <DEAD TEMP9>
6302                     <VEQUAL? LEN6 1 - PHRASE14 (TYPE FIX)>
6303                     <DEAD LEN6>
6304                     <CONS .OUTCHAN () = TEMP9>
6305                     <NTHL OBJ4 1 = LEN6>
6306                     <DEAD OBJ4>
6307                     <CONS LEN6 TEMP9 = TEMP9>
6308                     <DEAD LEN6>
6309                     <CHTYPE TEMP9 <TYPE-CODE FORM> = OBJ4>
6310                     <DEAD TEMP9>
6311                     <JUMP + PHRASE18>
6312 PHRASE14
6313                     <CONS .OUTCHAN () = TEMP9>
6314                     <RESTL OBJ4 1 = LEN6 (TYPE LIST)>
6315                     <NTHL LEN6 1 = LEN6>
6316                     <CONS LEN6 TEMP9 = TEMP9>
6317                     <DEAD LEN6>
6318                     <NTHL OBJ4 1 = LEN6>
6319                     <DEAD OBJ4>
6320                     <CONS LEN6 TEMP9 = TEMP9>
6321                     <DEAD LEN6>
6322                     <CHTYPE TEMP9 <TYPE-CODE FORM> = OBJ4>
6323                     <DEAD TEMP9>
6324 PHRASE18
6325                     <FRAME '\1aRSUBR-FCN>
6326                     <PUSH OBJ4>
6327                     <DEAD OBJ4>
6328                     <PUSH AP5>
6329                     <DEAD AP5>
6330                     <CALL '\1aRSUBR-FCN 2 = TEMP9>
6331                     <RETURN TEMP9>
6332                     <DEAD TEMP9>
6333                     <END \1aPRINT-HACKERS>
6334 <COND (<GASSIGNED? PRINT-HACKERS> <PUTPROP ,PRINT PAPPLY-OBJECT ,PRINT-HACKERS> <PUTPROP ,PRIN1 PAPPLY-OBJECT ,PRINT-HACKERS> <PUTPROP ,PRINC PAPPLY-OBJECT ,PRINT-HACKERS> <PUTPROP ,CRLF PAPPLY-OBJECT ,PRINT-HACKERS>)>
6335
6336 #WORD *31041641403*
6337 <GFCN \1aP-MULTI-SET ("VALUE" NODE FORM ANY) OBJ4 AP5>
6338                     <TEMP TEMP9 TT6:NODE TEMP15:LIST X30 TEMP48 TEMP47:LIST>
6339                     <INTGO>
6340                     <FRAME '\1aNODEFM>
6341                     <PUSH 103>
6342                     <GEN-LVAL 'PARENT = STACK>
6343                     <PUSH %<>>
6344                     <PUSH 'MULTI-SET>
6345                     <PUSH ()>
6346                     <GVAL 'MULTI-SET = STACK>
6347                     <CALL '\1aNODEFM 6 = TT6>
6348                     <EMPL? OBJ4 + TAG14>
6349                     <RESTL OBJ4 1 = TEMP15 (TYPE LIST)>
6350                     <EMPL? TEMP15 - PHRASE13>
6351                     <DEAD TEMP15>
6352 TAG14
6353                     <FRAME '\1aCOMPILE-ERROR>
6354                     <PUSH "Too few args to MULTI-SET:  ">
6355                     <PUSH OBJ4>
6356                     <CALL '\1aCOMPILE-ERROR 2>
6357 PHRASE13
6358                     <RESTL OBJ4 1 = TEMP15 (TYPE LIST)>
6359                     <NTHL TEMP15 1 = TEMP9>
6360                     <DEAD TEMP15>
6361                     <TYPE? TEMP9 <TYPE-CODE LIST> - MAPAP24>
6362                     <EMPL? TEMP9 + MAPAP24 (TYPE LIST)>
6363                     <SET TEMP15 TEMP9 (TYPE LIST)>
6364                     <LOOP>
6365 MAP21
6366                     <INTGO>
6367                     <EMPL? TEMP15 + PHRASE18>
6368                     <NTHL TEMP15 1 = X30>
6369                     <TYPE? X30 <TYPE-CODE ATOM> + PHRASE32>
6370                     <TYPE? X30 <TYPE-CODE ADECL> - MAPAP24>
6371                     <NTHUV X30 1 = X30>
6372                     <TYPE? X30 <TYPE-CODE ATOM> - MAPAP24>
6373                     <DEAD X30>
6374 PHRASE32
6375                     <RESTL TEMP15 1 = TEMP15 (TYPE LIST)>
6376                     <JUMP + MAP21>
6377 MAPAP24
6378                     <FRAME '\1aCOMPILE-ERROR>
6379                     <PUSH "Arg wrong type to MULTI-SET:  ">
6380                     <PUSH OBJ4>
6381                     <CALL '\1aCOMPILE-ERROR 2>
6382 PHRASE18
6383                     <FRAME '\1aPCOMP>
6384                     <FRAME '\1aFORM>
6385                     <PUSH 'QUOTE>
6386                     <PUSH TEMP9>
6387                     <DEAD TEMP9>
6388                     <CALL '\1aFORM 2 = STACK>
6389                     <PUSH TT6>
6390                     <CALL '\1aPCOMP 2 = TEMP9>
6391                     <CONS TEMP9 () = TEMP15>
6392                     <DEAD TEMP9>
6393                     <SET TEMP9 () (TYPE LIST)>
6394                     <SET X30 () (TYPE LIST)>
6395                     <RESTL OBJ4 1 = TEMP48 (TYPE LIST)>
6396                     <DEAD OBJ4>
6397                     <RESTL TEMP48 1 = TEMP47 (TYPE LIST)>
6398                     <DEAD TEMP48>
6399                     <CHTYPE TEMP47 <TYPE-CODE LIST> = TEMP47>
6400                     <LOOP>
6401 MAP40
6402                     <INTGO>
6403                     <EMPL? TEMP47 + MAPAP43>
6404                     <NTHL TEMP47 1 = TEMP48>
6405                     <FRAME '\1aPCOMP>
6406                     <PUSH TEMP48>
6407                     <DEAD TEMP48>
6408                     <PUSH TT6>
6409                     <CALL '\1aPCOMP 2 = TEMP48>
6410                     <CONS TEMP48 () = TEMP48 (TYPE LIST)>
6411                     <EMPL? TEMP9 - TAG51>
6412                     <SET TEMP9 TEMP48 (TYPE LIST)>
6413                     <JUMP + TAG52>
6414 TAG51
6415                     <PUTREST X30 TEMP48>
6416                     <DEAD X30>
6417 TAG52
6418                     <SET X30 TEMP48 (TYPE LIST)>
6419                     <DEAD TEMP48>
6420                     <RESTL TEMP47 1 = TEMP47 (TYPE LIST)>
6421                     <JUMP + MAP40>
6422 MAPAP43
6423                     <PUTREST TEMP15 TEMP9>
6424                     <DEAD TEMP9>
6425                     <PUTUV TT6 5 TEMP15 (TYPE LIST)>
6426                     <DEAD TEMP15>
6427                     <RETURN TT6>
6428                     <DEAD TT6>
6429                     <END \1aP-MULTI-SET>
6430 <COND (<AND <GASSIGNED? MULTI-SET> <GASSIGNED? P-MULTI-SET>> <PUTPROP ,MULTI-SET PAPPLY-OBJECT ,P-MULTI-SET>)>
6431
6432 #WORD *35000523245*
6433 <GFCN \1aPIFSYS ("VALUE" ANY <OR FORM LIST> ANY) OBJ4 AP5>
6434                     <TEMP TEMP11 STUFF17:LIST L6 SYS7 TEMP39 TEMP40 TEMP41 TEMP42>
6435                     <INTGO>
6436                     <GEN-ASSIGNED? 'IN-IFSYS - PHRASE9>
6437                     <GEN-LVAL 'IN-IFSYS = TEMP11>
6438                     <TYPE? TEMP11 <TYPE-CODE FALSE> + PHRASE9>
6439                     <DEAD TEMP11>
6440                     <SET STUFF17 () (TYPE LIST)>
6441                     <LOOP>
6442 AGAIN18
6443                     <INTGO>
6444                     <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
6445                     <CHTYPE OBJ4 <TYPE-CODE LIST> = OBJ4>
6446                     <EMPL? OBJ4 - PHRASE20 (TYPE LIST)>
6447                     <EMPL? STUFF17 - PHRASE22 (TYPE LIST)>
6448                     <FRAME '\1aPDEFAULT>
6449                     <PUSH %<>>
6450                     <CALL '\1aPDEFAULT 1 = TEMP11>
6451                     <RETURN TEMP11>
6452                     <DEAD TEMP11>
6453 PHRASE22
6454                     <FRAME '\1aPPROG-REPEAT>
6455                     <CONS () STUFF17 = TEMP11>
6456                     <DEAD STUFF17>
6457                     <CONS 'BIND TEMP11 = TEMP11>
6458                     <CHTYPE TEMP11 <TYPE-CODE FORM> = STACK>
6459                     <DEAD TEMP11>
6460                     <PUSH 'BIND>
6461                     <CALL '\1aPPROG-REPEAT 2 = TEMP11>
6462                     <RETURN TEMP11>
6463                     <DEAD TEMP11>
6464 PHRASE20
6465                     <NTHL OBJ4 1 = L6>
6466                     <TYPE? L6 <TYPE-CODE LIST> - BOOL28>
6467                     <EMPL? L6 + BOOL28 (TYPE LIST)>
6468                     <NTHL L6 1 = SYS7>
6469                     <TYPE? SYS7 <TYPE-CODE STRING> + PHRASE27>
6470                     <TYPE? SYS7 <TYPE-CODE ATOM> + PHRASE27>
6471 BOOL28
6472                     <FRAME '\1aERROR>
6473                     <PUSH 'ARG-WRONG-TYPE>
6474                     <NTHL OBJ4 1 = STACK>
6475                     <PUSH 'IFSYS>
6476                     <CALL '\1aERROR 3>
6477                     <JUMP + AGAIN18>
6478 PHRASE27
6479                     <TYPE? SYS7 <TYPE-CODE ATOM> - PHRASE32>
6480                     <NTHR SYS7 3 = SYS7 (RECORD-TYPE ATOM)>
6481 PHRASE32
6482                     <GEN-LVAL 'IN-IFSYS = TEMP11>
6483                     <TYPE? TEMP11 <TYPE-CODE STRING> - TAG36>
6484                     <IFCAN "STRING-EQUAL?">
6485                     <STRING-EQUAL? SYS7 TEMP11 + BOOL35>
6486                     <ENDIF "STRING-EQUAL?">
6487                     <IFCANNOT "STRING-EQUAL?">
6488                     <SET TEMP39 SYS7>
6489                     <LENUS TEMP39 = TEMP40 (TYPE FIX)>
6490                     <LENUS TEMP11 = TEMP41 (TYPE FIX)>
6491                     <VEQUAL? TEMP40 TEMP41 - TAG36>
6492                     <DEAD TEMP41>
6493                     <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (TEMP40 VALUE)>
6494 TAG43
6495                     <NTHUS TEMP39 1 = TEMP41>
6496                     <NTHUS TEMP11 1 = TEMP42>
6497                     <VEQUAL? TEMP41 TEMP42 - TAG36>
6498                     <DEAD TEMP41 TEMP42>
6499                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6500                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6501                     <SUB TEMP40 1 = TEMP40 (TYPE FIX)>
6502                     <GRTR? TEMP40 0 + TAG43 (TYPE FIX)>
6503                     <JUMP + BOOL35>
6504                     <ENDIF "STRING-EQUAL?">
6505 TAG36
6506                     <IFCAN "STRING-EQUAL?">
6507                     <STRING-EQUAL? SYS7 "UNIX" - TAG53>
6508                     <ENDIF "STRING-EQUAL?">
6509                     <IFCANNOT "STRING-EQUAL?">
6510                     <SET TEMP11 SYS7>
6511                     <SET TEMP39 "UNIX" (TYPE STRING)>
6512                     <LENUS TEMP11 = TEMP42 (TYPE FIX)>
6513                     <VEQUAL? TEMP42 4 - TAG53>
6514                     <LOOP (TEMP11 VALUE LENGTH) (TEMP39 VALUE LENGTH) (TEMP42 VALUE)>
6515 TAG46
6516                     <NTHUS TEMP11 1 = TEMP41>
6517                     <NTHUS TEMP39 1 = TEMP40>
6518                     <VEQUAL? TEMP41 TEMP40 - TAG53>
6519                     <DEAD TEMP41 TEMP40>
6520                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6521                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6522                     <SUB TEMP42 1 = TEMP42 (TYPE FIX)>
6523                     <GRTR? TEMP42 0 + TAG46 (TYPE FIX)>
6524                     <ENDIF "STRING-EQUAL?">
6525                     <GEN-LVAL 'IN-IFSYS = TEMP39>
6526                     <TYPE? TEMP39 <TYPE-CODE STRING> - TAG48>
6527                     <IFCAN "STRING-EQUAL?">
6528                     <STRING-EQUAL? TEMP39 "VAX" + BOOL35>
6529                     <ENDIF "STRING-EQUAL?">
6530                     <IFCANNOT "STRING-EQUAL?">
6531                     <SET TEMP11 "VAX" (TYPE STRING)>
6532                     <LENUS TEMP39 = TEMP40 (TYPE FIX)>
6533                     <VEQUAL? TEMP40 3 - TAG48>
6534                     <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (TEMP40 VALUE)>
6535 TAG52
6536                     <NTHUS TEMP39 1 = TEMP41>
6537                     <NTHUS TEMP11 1 = TEMP42>
6538                     <VEQUAL? TEMP41 TEMP42 - TAG48>
6539                     <DEAD TEMP41 TEMP42>
6540                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6541                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6542                     <SUB TEMP40 1 = TEMP40 (TYPE FIX)>
6543                     <GRTR? TEMP40 0 + TAG52 (TYPE FIX)>
6544                     <JUMP + BOOL35>
6545                     <ENDIF "STRING-EQUAL?">
6546 TAG48
6547                     <GEN-LVAL 'IN-IFSYS = TEMP11>
6548                     <TYPE? TEMP11 <TYPE-CODE STRING> - TAG53>
6549                     <IFCAN "STRING-EQUAL?">
6550                     <STRING-EQUAL? TEMP11 "MAC" + BOOL35>
6551                     <ENDIF "STRING-EQUAL?">
6552                     <IFCANNOT "STRING-EQUAL?">
6553                     <SET TEMP39 "MAC" (TYPE STRING)>
6554                     <LENUS TEMP11 = TEMP42 (TYPE FIX)>
6555                     <VEQUAL? TEMP42 3 - TAG53>
6556                     <LOOP (TEMP11 VALUE LENGTH) (TEMP39 VALUE LENGTH) (TEMP42 VALUE)>
6557 TAG57
6558                     <NTHUS TEMP11 1 = TEMP41>
6559                     <NTHUS TEMP39 1 = TEMP40>
6560                     <VEQUAL? TEMP41 TEMP40 - TAG53>
6561                     <DEAD TEMP41 TEMP40>
6562                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6563                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6564                     <SUB TEMP42 1 = TEMP42 (TYPE FIX)>
6565                     <GRTR? TEMP42 0 + TAG57 (TYPE FIX)>
6566                     <JUMP + BOOL35>
6567                     <ENDIF "STRING-EQUAL?">
6568 TAG53
6569                     <IFCAN "STRING-EQUAL?">
6570                     <STRING-EQUAL? SYS7 "VAX" + BOOL59>
6571                     <ENDIF "STRING-EQUAL?">
6572                     <IFCANNOT "STRING-EQUAL?">
6573                     <SET TEMP39 SYS7>
6574                     <SET TEMP11 "VAX" (TYPE STRING)>
6575                     <LENUS TEMP39 = TEMP40 (TYPE FIX)>
6576                     <VEQUAL? TEMP40 3 - TAG60>
6577                     <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (TEMP40 VALUE)>
6578 TAG62
6579                     <NTHUS TEMP39 1 = TEMP41>
6580                     <NTHUS TEMP11 1 = TEMP42>
6581                     <VEQUAL? TEMP41 TEMP42 - TAG60>
6582                     <DEAD TEMP41 TEMP42>
6583                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6584                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6585                     <SUB TEMP40 1 = TEMP40 (TYPE FIX)>
6586                     <GRTR? TEMP40 0 + TAG62 (TYPE FIX)>
6587                     <JUMP + BOOL59>
6588                     <ENDIF "STRING-EQUAL?">
6589 TAG60
6590                     <IFCAN "STRING-EQUAL?">
6591                     <STRING-EQUAL? SYS7 "MAC" - AGAIN18>
6592                     <ENDIF "STRING-EQUAL?">
6593                     <IFCANNOT "STRING-EQUAL?">
6594                     <SET TEMP11 SYS7>
6595                     <DEAD SYS7>
6596                     <SET TEMP39 "MAC" (TYPE STRING)>
6597                     <LENUS TEMP11 = TEMP42 (TYPE FIX)>
6598                     <VEQUAL? TEMP42 3 - AGAIN18>
6599                     <LOOP (TEMP11 VALUE LENGTH) (TEMP39 VALUE LENGTH) (TEMP42 VALUE)>
6600 TAG64
6601                     <NTHUS TEMP11 1 = TEMP41>
6602                     <NTHUS TEMP39 1 = SYS7>
6603                     <VEQUAL? TEMP41 SYS7 - AGAIN18>
6604                     <DEAD TEMP41 SYS7>
6605                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6606                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6607                     <SUB TEMP42 1 = TEMP42 (TYPE FIX)>
6608                     <GRTR? TEMP42 0 + TAG64 (TYPE FIX)>
6609                     <ENDIF "STRING-EQUAL?">
6610 BOOL59
6611                     <GEN-LVAL 'IN-IFSYS = TEMP39>
6612                     <TYPE? TEMP39 <TYPE-CODE STRING> - AGAIN18>
6613                     <IFCAN "STRING-EQUAL?">
6614                     <STRING-EQUAL? TEMP39 "UNIX" - AGAIN18>
6615                     <ENDIF "STRING-EQUAL?">
6616                     <IFCANNOT "STRING-EQUAL?">
6617                     <SET TEMP11 "UNIX" (TYPE STRING)>
6618                     <LENUS TEMP39 = SYS7 (TYPE FIX)>
6619                     <VEQUAL? SYS7 4 - AGAIN18>
6620                     <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (SYS7 VALUE)>
6621 TAG68
6622                     <NTHUS TEMP39 1 = TEMP41>
6623                     <NTHUS TEMP11 1 = TEMP40>
6624                     <VEQUAL? TEMP41 TEMP40 - AGAIN18>
6625                     <DEAD TEMP41 TEMP40>
6626                     <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6627                     <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6628                     <SUB SYS7 1 = SYS7 (TYPE FIX)>
6629                     <GRTR? SYS7 0 + TAG68 (TYPE FIX)>
6630                     <ENDIF "STRING-EQUAL?">
6631 BOOL35
6632                     <RESTL L6 1 = TEMP11 (TYPE LIST)>
6633                     <DEAD L6>
6634                     <SET TEMP39 STUFF17>
6635                     <EMPL? TEMP11 + TAG70>
6636                     <NTHL TEMP11 1 = TEMP40>
6637                     <CONS TEMP40 STUFF17 = TEMP40>
6638                     <SET TEMP39 TEMP40>
6639                     <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
6640                     <EMPL? TEMP11 + TAG70>
6641                     <LOOP (TEMP11 VALUE) (TEMP40 VALUE) (STUFF17 VALUE)>
6642 TAG69
6643                     <NTHL TEMP11 1 = TEMP41>
6644                     <CONS TEMP41 STUFF17 = TEMP41>
6645                     <PUTREST TEMP40 TEMP41>
6646                     <DEAD TEMP40>
6647                     <SET TEMP40 TEMP41>
6648                     <DEAD TEMP41>
6649                     <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
6650                     <EMPL? TEMP11 - TAG69>
6651 TAG70
6652                     <SET STUFF17 TEMP39>
6653                     <DEAD TEMP39>
6654                     <JUMP + AGAIN18>
6655 PHRASE9
6656                     <FRAME '\1aPMACRO>
6657                     <RESTL OBJ4 1 = TEMP39 (TYPE LIST)>
6658                     <DEAD OBJ4>
6659                     <CHTYPE TEMP39 <TYPE-CODE LIST> = TEMP39>
6660                     <CONS 'IFSYS-MIMC TEMP39 = TEMP39>
6661                     <CHTYPE TEMP39 <TYPE-CODE FORM> = STACK>
6662                     <DEAD TEMP39>
6663                     <PUSH AP5>
6664                     <DEAD AP5>
6665                     <CALL '\1aPMACRO 2 = TEMP11>
6666                     <RETURN TEMP11>
6667                     <DEAD TEMP11>
6668                     <END \1aPIFSYS>
6669 <COND (<AND <GASSIGNED? IFSYS> <GASSIGNED? PIFSYS>> <PUTPROP ,IFSYS PAPPLY-OBJECT ,PIFSYS>)>
6670
6671 #WORD *1337570064*
6672 <GFCN \1aIFSYS-MIMC ("VALUE" FORM "ARGS" LIST) ARGS6>
6673                     <OPT-DISPATCH 0 %<> OPT4 OPT5>
6674 OPT4
6675                     <PUSH ()>
6676 OPT5
6677                     <TEMP (STUFF7:LIST ()) L10 TEMP17 TEMP26 TEMP27 TEMP28>
6678                     <INTGO>
6679                     <LOOP>
6680 AGAIN11
6681                     <INTGO>
6682                     <EMPL? ARGS6 + EXIT8 (TYPE LIST)>
6683                     <NTHL ARGS6 1 = L10>
6684                     <TYPE? L10 <TYPE-CODE LIST> - BOOL16>
6685                     <EMPL? L10 + BOOL16 (TYPE LIST)>
6686                     <NTHL L10 1 = TEMP17>
6687                     <TYPE? TEMP17 <TYPE-CODE STRING> + PHRASE15>
6688                     <TYPE? TEMP17 <TYPE-CODE ATOM> + PHRASE15>
6689                     <DEAD TEMP17>
6690 BOOL16
6691                     <FRAME '\1aERROR>
6692                     <PUSH 'ARG-WRONG-TYPE>
6693                     <NTHL ARGS6 1 = STACK>
6694                     <PUSH 'IFSYS>
6695                     <CALL '\1aERROR 3>
6696                     <JUMP + PHRASE19>
6697 PHRASE15
6698                     <NTHL L10 1 = TEMP17>
6699                     <TYPE? TEMP17 <TYPE-CODE ATOM> - PHRASE21>
6700                     <DEAD TEMP17>
6701                     <NTHL L10 1 = TEMP17 (TYPE ATOM)>
6702                     <NTHR TEMP17 3 = TEMP17 (RECORD-TYPE ATOM)>
6703                     <PUTL L10 1 TEMP17>
6704                     <DEAD TEMP17>
6705 PHRASE21
6706                     <FRAME '\1aFORM>
6707                     <PUSH 'CALL>
6708                     <PUSH 'IFSYS>
6709                     <NTHL L10 1 = STACK (TYPE STRING)>
6710                     <CALL '\1aFORM 3 = TEMP17>
6711                     <CONS TEMP17 () = TEMP17>
6712                     <RESTL L10 1 = TEMP26 (TYPE LIST)>
6713                     <SET TEMP27 TEMP17>
6714                     <EMPL? TEMP26 + TAG25>
6715                     <LOOP (TEMP26 VALUE) (TEMP27 VALUE)>
6716 TAG24
6717                     <NTHL TEMP26 1 = TEMP28>
6718                     <CONS TEMP28 () = TEMP28>
6719                     <PUTREST TEMP27 TEMP28>
6720                     <DEAD TEMP27>
6721                     <SET TEMP27 TEMP28>
6722                     <DEAD TEMP28>
6723                     <RESTL TEMP26 1 = TEMP26 (TYPE LIST)>
6724                     <EMPL? TEMP26 - TAG24>
6725 TAG25
6726                     <FRAME '\1aFORM>
6727                     <PUSH 'CALL>
6728                     <PUSH 'ENDIF>
6729                     <NTHL L10 1 = STACK>
6730                     <DEAD L10>
6731                     <CALL '\1aFORM 3 = TEMP26>
6732                     <CONS TEMP26 () = TEMP26>
6733                     <PUTREST TEMP27 TEMP26>
6734                     <DEAD TEMP27>
6735                     <PUTREST TEMP26 STUFF7>
6736                     <DEAD TEMP26 STUFF7>
6737                     <SET STUFF7 TEMP17>
6738                     <DEAD TEMP17>
6739 PHRASE19
6740                     <RESTL ARGS6 1 = ARGS6 (TYPE LIST)>
6741                     <JUMP + AGAIN11>
6742 EXIT8
6743                     <CONS () STUFF7 = TEMP26>
6744                     <DEAD STUFF7>
6745                     <CONS 'BIND TEMP26 = TEMP26>
6746                     <CHTYPE TEMP26 <TYPE-CODE FORM> = TEMP26>
6747                     <RETURN TEMP26>
6748                     <DEAD TEMP26>
6749                     <END \1aIFSYS-MIMC><COND (<AND <GASSIGNED? IFSYS-MIMC> <NOT <TYPE? ,IFSYS-MIMC MACRO>>> <SETG IFSYS-MIMC <CHTYPE (,IFSYS-MIMC) MACRO>>)>
6750
6751 <ENDPACKA