mim/development/mim/vaxc/intgen.mud

   1 <SETG LB-DOPE <+ <CHTYPE <LSH 18 16> FIX> *40* 770>>
   2 <SETG LB-OBJ 0>
   3 <SETG LB-ATOM 8>
   4 <SETG LB-DECL 12>
   5 <SETG LB-PREV 20>
   6 <SETG LB-LAST 24>
   7 <SETG LB-BID 28>
   8 <MANIFEST LB-DOPE LB-OBJ LB-ATOM LB-DECL LB-PREV LB-LAST LB-BID>
   9
  10 <DEFINE GEN-BBIND (ATM DECL FIXUP? "OPT" INIT "AUX" AC ATMADDR)
  11   #DECL ((ATM) ATOM (FIXUP?) <OR ATOM FALSE>)
  12   <EMIT-PUSH <MA-IMM ,LB-DOPE> LONG>    ;"Push the dope word"
  13   <COND (<ASSIGNED? INIT>
  14          <PUSH-GEN .INIT>)
  15         (T
  16          <EMIT-PUSH <MA-IMM 0> DOUBLE>)>        ; "Push the value"
  17   <SET AC <GET-AC PREF-VAL T>>
  18   <EMIT-MOVE <ADDR-VALUE-MQUOTE .ATM>
  19              <SET ATMADDR <MA-REG .AC>> LONG>   ; "load the atom"
  20   <EMIT-MOVE .ATMADDR <MA-AINC ,AC-TP> LONG>    ; "stuff it in the binding"
  21   <PUSH-GEN .DECL>                      ;"PUSH THE DECL"
  22   <EMIT-PUSH <MA-ABS ,SPSTO-LOC> LONG>  ;"PUSH THE PREVIOUS BINDING"
  23   <EMIT-PUSH <MA-DISP .AC 4> LONG>      ;"PUSH THE ATOM'S OLD BINDING"
  24   <EMIT-PUSH <MA-ABS ,BINDID-LOC> LONG> ;"PUSH BINDID"
  25   <EMIT ,INST-MOVAL <MA-DISP ,AC-TP -32> <MA-ABS ,SPSTO-LOC>>
  26   <COND (.FIXUP?                        ;"IF FIXUP, STUFF BINDING INTO ATOM"
  27          <EMIT ,INST-MOVAL <MA-DISP ,AC-TP -32>
  28                <MA-LD .AC 4>>)>
  29   NORMAL>
  30
  31 <DEFINE GEN-ASSIGNED? (FROB DIR LABEL)
  32   <CALL-RTE ,IASSQ!-MIMOP CALL <> <> .FROB>
  33   <EMIT ,INST-TSTL <MA-REG ,AC-1>>
  34   <COND (<==? .DIR ->
  35          <GEN-BRANCH ,INST-BEQL .LABEL CONDITIONAL-BRANCH>)
  36         (T
  37          <GEN-BRANCH ,INST-BNEQ .LABEL CONDITIONAL-BRANCH>)>
  38   CONDITIONAL-BRANCH>
  39
  40 <DEFINE GEN-LVAL (ATM RES)
  41   #DECL ((ATM) <OR ATOM VARTBL>)
  42   <CALL-RTE ,ILVAL!-MIMOP CALL .RES <> .ATM>
  43   NORMAL>
  44
  45 <DEFINE GEN-SET (ATM VAL)
  46   <CALL-RTE ,ISET!-MIMOP CALL <> <> .ATM .VAL>
  47   NORMAL>
  48
  49 <DEFINE MOVSTK-GEN (AMT "OPTIONAL" (RES <>) HINT TYP)
  50         <CALL-RTE ,IMOVSTK!-MIMOP CALL .RES <> .AMT>
  51         NORMAL>
  52
  53 <DEFINE GETSTK-GEN (UV "OPTIONAL" (RES <>) HINT TYP)
  54         <CALL-RTE ,IGETSTK!-MIMOP CALL .RES <> .UV>
  55         NORMAL>
  56
  57 <DEFINE GETTTY-GEN (FROB "OPTIONAL" (RES <>) HINT TYP)
  58         <CALL-RTE ,IGETTTY!-MIMOP CALL .RES <> .FROB>
  59         NORMAL>
  60
  61 <DEFINE SAVTTY-GEN (OLD NEW "OPTIONAL" (RES <>) HINT TYP)
  62         <CALL-RTE ,ISAVTTY!-MIMOP CALL .RES <> .OLD .NEW>
  63         NORMAL>
  64
  65 <DEFINE SETZONE-GEN (ZONE "OPT" (RES <>) HINT TYP)
  66         <CALL-RTE ,ISETZONE!-MIMOP CALL .RES <> .ZONE>
  67         NORMAL>
  68
  69 <DEFINE LEGAL-GEN (OBJ "OPT" (RES <>) HINT TYP)
  70         <CALL-RTE ,ILEGAL?!-MIMOP CALL .RES <> .OBJ>
  71         NORMAL>
  72
  73 <DEFINE TEMPLATE-TABLE-GEN (OFFS TBL "OPTIONAL" HINT)
  74         <CALL-RTE ,ITTABLE!-MIMOP CALL <> <> .OFFS .TBL>
  75         NORMAL>
  76
  77 <DEFINE FATAL-GEN ("OPTIONAL" (STR <>) HINT)
  78         <CALL-RTE ,IFATAL!-MIMOP CALL <> <> .STR>
  79         NORMAL>
  80
  81 <DEFINE QUIT-GEN ("OPTIONAL" (ARG -1) HINT)
  82         <CALL-RTE ,IQUIT!-MIMOP CALL <> <> .ARG>
  83         NORMAL>
  84
  85 <DEFINE CONS-GEN (NEARG LARG RES "OPTIONAL" HINT)
  86         #DECL ((LARG) <OR VARTBL LIST> (NEARG) ANY (RES) <OR VARTBL ATOM>)
  87         <CALL-RTE ,ICONS!-MIMOP CALL .RES LIST .LARG .NEARG>
  88         NORMAL>
  89
  90 <DEFINE UBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
  91         #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
  92         <GET-AC ,AC-0 T>
  93         <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
  94                <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
  95               (ELSE <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
  96         <CALL-RTE ,IBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
  97         NORMAL>
  98
  99 <DEFINE UUBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
 100   #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
 101   <GET-AC ,AC-0 T>
 102   <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
 103          <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
 104         (T
 105          <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
 106   <CALL-RTE ,UIBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
 107   NORMAL>
 108
 109 <DEFINE CHTYPE-GEN (VAR TYP RES "OPTIONAL" HINT "AUX" VAC CAC TYVAR LV)
 110    #DECL ((VAR) ANY (TYVAR) VARTBL (TYP) <OR ATOM FORM VARTBL>
 111           (RES) <OR ATOM VARTBL>)
 112    <COND
 113     (<TYPE? .VAR VARTBL>
 114      <COND
 115       (<AND <==? .RES .VAR> <VAR-COUNT-STORED? .VAR>>
 116           <EMIT ,INST-MOVW <COND (<TYPE? .TYP ATOM> <TYPE-CODE .TYP>)
 117                                  (<TYPE? .TYP VARTBL> <VAR-VALUE-ADDRESS .TYP>)
 118                                  (ELSE <VAR-TYPE-ADDRESS <2 .TYP>>)>
 119                        <VAR-TYPE-ADDRESS .VAR TYPE-WORD>>
 120           <COND (<SET LV <FIND-CACHE-VAR .VAR>>
 121                  ;<PUT .LV ,LINKVAR-TYPE-AC <>>
 122                  ;<PUT .LV ,LINKVAR-TYPE-WORD-AC <>>
 123                  <COND (<LINKVAR-TYPE-WORD-AC .LV>
 124                         <PUT .LV ,LINKVAR-TYPE-STORED <>>)>)>)
 125          (<OR <NOT <TYPE? .TYP ATOM>> <COUNT-NEEDED? .TYP>>
 126           <COND (<==? .RES STACK>
 127                  <EMIT-PUSH <VAR-TYPE-ADDRESS .VAR TYPE-WORD> LONG>
 128                  <COND (<TYPE? .TYP VARTBL>
 129                         <EMIT ,INST-MOVW <VAR-VALUE-ADDRESS .TYP>
 130                               <MA-DISP ,AC-TP -4>>)
 131                        (<TYPE? .TYP FORM>
 132                         <EMIT ,INST-MOVW <VAR-TYPE-ADDRESS <2 .TYP>>
 133                               <MA-DISP ,AC-TP -4>>)
 134                        (ELSE <EMIT ,INST-MOVW <TYPE-CODE .TYP>
 135                                    <MA-DISP ,AC-TP -4>>)>
 136                  <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)
 137                 (ELSE
 138                  <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>
 139                  <PROTECT .VAC>
 140                  <COND (<AND <TYPE? .TYP ATOM>
 141                              <VAR-TYPE-WORD-IN-AC? .VAR>>
 142                         <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
 143                         <EMIT ,INST-MOVW <TYPE-CODE .TYP> <MA-REG .CAC>>
 144                         <DEST-PAIR  .VAC .CAC .RES>)
 145                        (<TYPE? .TYP ATOM>
 146                         <SET CAC <LOAD-VAR .VAR COUNT <> PREF-TYPE>>
 147                         <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)
 148                        (<TYPE? .TYP FORM>
 149                         <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
 150                         <EMIT ,INST-MOVW
 151                               <VAR-TYPE-ADDRESS <2 .TYP> TYPE>
 152                               <MA-REG .CAC>>
 153                         <DEST-PAIR .VAC .CAC .RES>)
 154                        (ELSE
 155                         <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
 156                         <EMIT ,INST-MOVW
 157                               <VAR-VALUE-ADDRESS .TYP>
 158                               <MA-REG .CAC>>
 159                         <DEST-PAIR .VAC .CAC .RES>)>)>)
 160          (ELSE
 161           <COND (<==? .RES STACK>
 162                  <EMIT-PUSH <TYPE-WORD .TYP> LONG>
 163                  <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)
 164                 (ELSE
 165                  <SET VAC <LOAD-VAR-APP .VAR <>>>
 166                  <DEST-DECL .VAC .RES .TYP>)>)>)
 167     (<COUNT-NEEDED? <TYPE .VAR>>
 168      ; "Some structured thing"
 169      <COND (<==? .RES STACK>
 170             <EMIT-PUSH <ADDR-TYPE-M <ADD-MVEC .VAR>>>
 171             <COND (<TYPE? .TYP VARTBL>
 172                    <EMIT ,INST-MOVW <VAR-VALUE-ADDRESS .TYP>
 173                          <MA-DISP ,AC-TP -4>>)
 174                   (<TYPE? .TYP FORM>
 175                    <EMIT ,INST-MOVW <VAR-TYPE-ADDRESS <2 .TYP>>
 176                          <MA-DISP ,AC-TP -4>>)
 177                   (T
 178                    <EMIT ,INST-MOVW <TYPE-CODE .TYP>
 179                          <MA-DISP ,AC-TP -4>>)>
 180             <EMIT-PUSH <ADDR-VAL-M .VAR> LONG>)
 181            (T
 182             <SET-GEN .RES .VAR>
 183             <CHTYPE-GEN .RES .TYP .RES>)>)
 184     (T
 185      <COND (<==? .RES STACK>
 186             <COND (<TYPE? .TYP VARTBL>
 187                    <EMIT-PUSH <VAR-VALUE-ADDRESS .TYP> LONG>)
 188                   (<TYPE? .TYP FORM>
 189                    <EMIT-PUSH <VAR-TYPE-ADDRESS <2 .TYP> LONG>>)
 190                   (T
 191                    <EMIT-PUSH <TYPE-CODE .TYP> LONG>)>
 192             <EMIT-PUSH <MA-IMM <FIX-CONSTANT? .VAR>> LONG>)
 193            (T
 194             <SET-GEN .RES .VAR>
 195             <CHTYPE-GEN .RES .TYP .RES>)>)>
 196    NORMAL>
 197
 198 <SETG GVAL-CAREFUL <>>
 199 <DEFINE GVAL-GEN (ATM RES "OPTIONAL" (HINT <>) "AUX" VAC ATMADDR TYP TAC
 200                   ELABEL NLABEL ATMOFF)
 201         #DECL ((ATM) <OR ATOM VARTBL> (RES) <OR ATOM VARTBL>
 202                (HINT) <OR FALSE HINT>)
 203         <COND (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>) (ELSE <SET TYP <>>)>
 204         <COND (,BOOT-MODE <SET ATMADDR <ADDR-VALUE-MQUOTE .ATM>>)
 205               (<TYPE? .ATM VARTBL>)
 206               (T
 207                <SET ATMADDR
 208                     <MA-DEF-DISP ,AC-M <SET ATMOFF
 209                                        <+ <ADD-MVEC <CHTYPE .ATM XGLOC>> 4>>>>
 210                ;<SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)>
 211         <COND (,BOOT-MODE
 212                <SET VAC <GET-AC PREF-VAL T>>
 213                <PROTECT .VAC>
 214                <EMIT-MOVE .ATMADDR <MA-REG .VAC> LONG>
 215                <EMIT-MOVE <MA-REGD .VAC> <MA-REG .VAC> LONG>
 216                <COND (<==? .RES STACK> <EMIT-PUSH <MA-REGD .VAC> DOUBLE>)
 217                      (ELSE
 218                       <COND (<OR <NOT .TYP> <COUNT-NEEDED? .TYP>>
 219                              <SET TYP <>>
 220                              <SET TAC <GET-AC DOUBLE T>>
 221                              <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .TAC>>
 222                              <SET VAC <NEXT-AC .TAC>>)
 223                             (ELSE
 224                              <EMIT ,INST-MOVL <MA-DISP .VAC 4> <MA-REG .VAC>>)>
 225                       <COND (<NOT .TYP> <DEST-PAIR .VAC .TAC .RES T>)
 226                             (<DEST-DECL .VAC .RES .TYP T>)>)>)
 227               (<AND <TYPE? .ATM VARTBL>
 228                     <NOT ,GVAL-CAREFUL>>
 229                <COND (<SET TAC <VAR-VALUE-IN-AC? .ATM>>
 230                       <PROTECT .TAC>
 231                       ; "If atom is in AC, can win immediate"
 232                       <COND (<==? .RES STACK>
 233                              <EMIT-PUSH <MA-BDD .TAC 0> DOUBLE>)
 234                             (T
 235                              <SET VAC <GET-AC DOUBLE T>>
 236                              <EMIT ,INST-MOVQ <MA-BDD .TAC 0> <MA-REG .VAC>>)>)
 237                      (T
 238                       <SET VAC <GET-AC DOUBLE T>>
 239                       ; "Otherwise, pick up gbind through pointer on stack"
 240                       <EMIT ,INST-MOVL <GEN-LOC .ATM 4 T> <MA-REG .VAC>>
 241                       ; "Then get value out of that"
 242                       <COND (<==? .RES STACK>
 243                              <EMIT-PUSH <MA-REGD .VAC> DOUBLE>)
 244                             (T
 245                              <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .VAC>>)>)>
 246                <COND (<N==? .RES STACK>
 247                       <DEST-PAIR <NEXT-AC .VAC> .VAC .RES T>)>)
 248               (<AND ,GVAL-CAREFUL <N==? .ATM M$$BINDID>>
 249                <FLUSH-ALL-ACS>
 250                <SET TAC <GET-AC ,AC-0 T>>
 251                <SET VAC <GET-AC ,AC-1 T>>
 252                <SET ELABEL <MAKE-LABEL>>
 253                <SET NLABEL <MAKE-LABEL>>
 254                <COND (<TYPE? .ATM VARTBL>
 255                       ; "Pick up gbind"
 256                       <EMIT ,INST-MOVL <GEN-LOC .ATM 4 T> <MA-REG .VAC>>
 257                       ; "Barf if not there"
 258                       <GEN-BRANCH ,INST-BEQL .NLABEL <>>
 259                       ; "Pick up gval"
 260                       <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .TAC>>)
 261                      (T
 262                       <EMIT ,INST-MOVQ .ATMADDR <MA-REG .TAC>>)>
 263                ; "Win if have gval"
 264                <GEN-BRANCH ,INST-BNEQ .ELABEL <>>
 265                <EMIT-LABEL .NLABEL <>>
 266                <COND (<TYPE? .ATM VARTBL>
 267                       <EMIT ,INST-PUSHAL <VAR-VALUE-ADDRESS .ATM>>)
 268                      (T <EMIT ,INST-PUSHAL <MA-DISP ,AC-M .ATMOFF>>)>
 269                <CALL-RTE ,IGVERR!-MIMOP CALL <COND (<N==? .RES STACK> .RES)>
 270                          <>>
 271                <EMIT-LABEL .ELABEL <>>
 272                <COND (<==? .RES STACK>
 273                       <EMIT-PUSH <MA-REG .TAC> DOUBLE>)
 274                      (T
 275                       <DEST-PAIR <NEXT-AC .TAC> .TAC .RES T>)>)
 276               (T
 277                <COND (<==? .RES STACK>
 278                       <EMIT-PUSH .ATMADDR DOUBLE>)
 279                      (T
 280                       <SET TAC <GET-AC DOUBLE T>>
 281                       <EMIT ,INST-MOVQ .ATMADDR <MA-REG .TAC>>
 282                       <DEST-PAIR <NEXT-AC .TAC> .TAC .RES T>)>)>
 283         NORMAL>
 284
 285
 286 <DEFINE SETG-GEN (ATM VAL
 287                   "OPTIONAL" HINT
 288                   "AUX" VAC ATMADDR (A1 <>) (A2 <>) (TWOM <>) LV)
 289         #DECL ((ATM) ATOM (RES) ANY)
 290         <COND (<AND <TYPE? .VAL VARTBL> <SET LV <FIND-CACHE-VAR .VAL>>>
 291                <SET A1 <LINKVAR-TYPE-WORD-AC .LV>>
 292                <SET A2 <LINKVAR-VALUE-AC .LV>>)
 293               (T <SET LV <>>)>
 294         <COND (,BOOT-MODE <SET ATMADDR <ADDR-VALUE-MQUOTE .ATM>>)
 295               (<OR <FIX-CONSTANT? .VAL>
 296                    <AND .LV
 297                         <NOT <AND <LINKVAR-VALUE-STORED .LV>
 298                                   <LINKVAR-TYPE-STORED .LV>
 299                                   <LINKVAR-COUNT-STORED .LV>>>
 300                         <NOT <AND .A1 <==? .A2 <NEXT-AC .A1>>>>>>
 301                <SET TWOM T>
 302                <SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)
 303               (T
 304                <SET ATMADDR
 305                     <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ATM XGLOC>> 4>>>
 306                         ;<SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)>
 307         <COND (<OR ,BOOT-MODE .TWOM>
 308                <COND (.A1 <PROTECT .A1>)>
 309                <COND (.A2 <PROTECT .A2>)>
 310                <SET VAC <GET-AC PREF-VAL T>>
 311                <EMIT ,INST-MOVL .ATMADDR <MA-REG .VAC>>
 312                <PROTECT .VAC>
 313                <COND (<NOT .TWOM>
 314                       <EMIT ,INST-MOVL <MA-REGD .VAC> <MA-REG .VAC>>)>
 315                <COND (<OR <TYPE? .VAL VARTBL> <FIX-CONSTANT? .VAL>>
 316                       <MOVE-TYPE .VAL <MA-REGD .VAC> <MA-DISP .VAC 2>>
 317                       <MOVE-VALUE .VAL <MA-DISP .VAC 4>>)
 318                      (ELSE
 319                       <EMIT-MOVE <ADDR-TYPE-MQUOTE .VAL>
 320                                  <MA-REGD .VAC>
 321                                  DOUBLE>)>)
 322               (<TYPE? .VAL VARTBL>
 323                <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAL TYPE-WORD> .ATMADDR>)
 324               (T <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .VAL> .ATMADDR>)>
 325         NORMAL>
 326
 327 <SETG BE-COMPATIBLE T>
 328
 329 <DEFINE SET-GEN (VAR VAL "OPTIONAL" (HINT <>) "AUX" VAC TAC CAC DCL LV)
 330         #DECL ((VAR) VARTBL (VAL) ANY (HINT) <OR FALSE HINT>)
 331         <DEAD-VAR .VAR>
 332         <COND (<TYPE? .VAL VARTBL>
 333                <SET VAC <LOAD-VAR-APP .VAL <> <VARTBL-DECL .VAL> <>>>
 334                <LINK-VAR-TO-AC .VAR .VAC VALUE <>>
 335                <COND (<OR <SET DCL <VARTBL-DECL .VAR>>
 336                           <SET DCL <VARTBL-DECL .VAL>>>
 337                       <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL>
 338                       <COND (<COUNT-NEEDED? .DCL>
 339                              <SET CAC <LOAD-VAR .VAL TYPE-WORD <> PREF-TYPE
 340                                                 <> <>>>
 341                              <LINK-VAR-TO-AC .VAR .CAC TYPE-WORD <>>)>)
 342                      (ELSE
 343                       <SET TAC <LOAD-VAR .VAL TYPE-WORD <> PREF-TYPE <> <>>>
 344                       <LINK-VAR-TO-AC .VAR .TAC TYPE-WORD <>>)>)
 345               (<N==? <PRIMTYPE .VAL> FIX>
 346                <SET TAC <GET-AC DOUBLE T>>
 347                <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC .VAL>> <MA-REG .TAC>>
 348                <DEST-PAIR <NEXT-AC .TAC> .TAC .VAR>
 349                <INDICATE-CACHED-VARIABLE-DECL .VAR <TYPE .VAL>>)
 350               (ELSE
 351                <SET VAC
 352                     <GEN-CONSTANT .VAL PREF-VAL PREF-TYPE COUNT-IF-NECESSARY>>
 353                <LINK-VAR-TO-AC .VAR .VAC VALUE <>>
 354                <AND ,CONSTANT-COUNT-AC
 355                     <LINK-VAR-TO-AC .VAR ,CONSTANT-COUNT-AC COUNT <>>>
 356                <INDICATE-CACHED-VARIABLE-DECL .VAR <TYPE .VAL>>)>
 357         <PROCESS-DESTINATION-HINT .HINT .VAR>
 358         NORMAL>
 359
 360 <DEFINE MRETURN-GEN (TVAR FVAR "OPTIONAL" RES)
 361         <INDICATE-ALL-DEAD>
 362         <COND (<TYPE? .TVAR VARTBL> <PUT .TVAR ,VARTBL-DEAD? <>>)>
 363         <COND (<TYPE? .FVAR VARTBL> <PUT .FVAR ,VARTBL-DEAD? <>>)>
 364         <EMIT ,INST-MOVL
 365               <COND (<TYPE? .TVAR VARTBL> <VAR-VALUE-ADDRESS .TVAR>)
 366                     (<MA-IMM .TVAR>)>
 367               <MA-REG ,AC-1>>
 368         <PROTECT ,AC-1>
 369         <COND (<==? .FVAR 0>
 370                <COND (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
 371                       <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG ,AC-2>>)
 372                      (ELSE
 373                       <EMIT ,INST-MOVL <MA-REG ,AC-F> <MA-REG ,AC-2>>)>)
 374               (ELSE
 375                <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .FVAR> <MA-REG ,AC-2>>)>
 376         <PROTECT ,AC-2>
 377         <CALL-RTE ,IMRETURN!-MIMOP JUMP <> <>>
 378         UNCONDITIONAL-BRANCH>
 379
 380 <DEFINE RETURN-GEN (VAL "OPTIONAL" (FRM <>) RES)
 381         #DECL ((VAL) ANY (FRM) <OR FALSE VARTBL>)
 382         <INDICATE-ALL-DEAD>
 383         <COND (<TYPE? .FRM VARTBL> <PUT .FRM ,VARTBL-DEAD? <>>)>
 384         <COND (<TYPE? .VAL VARTBL>
 385                <PUT .VAL ,VARTBL-DEAD? <>>
 386                <LOAD-VAR .VAL VALUE <> ,AC-1>
 387                <LOAD-VAR .VAL TYPE-WORD <> ,AC-0>)
 388               (ELSE <GEN-CONSTANT .VAL ,AC-1 ,AC-0 TYPE-WORD>)>
 389         <PROTECT ,AC-1>
 390         <PROTECT ,AC-0>
 391         <COND (.FRM <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .FRM> <MA-REG ,AC-F>>)
 392               (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
 393                <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG ,AC-F>>)>
 394         <CALL-RTE ,FINIS!-MIMOP JUMP <> <>>
 395         UNCONDITIONAL-BRANCH>
 396
 397 <DEFINE DISPATCH-GEN (VAR BASE "TUPLE" LABELS "AUX" (CT <LENGTH .LABELS>))
 398   #DECL ((CT) FIX (LABELS) <TUPLE [REST ATOM]> (BASE) <PRIMTYPE WORD>)
 399   <STORE-ALL-ACS>
 400   <EMIT ,INST-CASEL
 401         <VAR-VALUE-ADDRESS .VAR>
 402         <MA-IMM .BASE>
 403         <MA-IMM <- .CT 1>>>
 404   <MAPF <>
 405     <FUNCTION (AC)
 406       <STORE-AC .AC T>>
 407     ,ALL-ACS>
 408   <MAPF <>
 409     <FUNCTION (LABEL "AUX" XREF)
 410       <SET XREF <EMIT-LABEL-WORD .LABEL>>
 411       <SAVE-XREF-AC-INFO .XREF <SAVE-STATE> <SAVE-LOAD-STATE>>>
 412     .LABELS>
 413   CONDITIONAL-BRANCH>
 414
 415 <DEFINE OPDISP-GEN (RNUM TRONUM "TUPLE" LABELS "AUX" (NARGS .RNUM))
 416         #DECL  ((RNUM) FIX (TRONUM) <OR FALSE FIX> (LABELS) <TUPLE [REST
 417                                                                    ATOM]>)
 418         <PROTECT ,AC-0>
 419         <EMIT ,INST-CASEW
 420               <MA-REG ,AC-0>
 421               <MA-LIT .RNUM>
 422               <MA-LIT <COND (.TRONUM <- .TRONUM .RNUM>)
 423                             (ELSE <- <LENGTH .LABELS> 1>)>>>
 424         <MAPF <>
 425               <FCN (LABEL)
 426                    <EMIT-LABEL-WORD .LABEL>
 427                    <ADD-INTERNAL-ENTRY .NARGS .LABEL>
 428                    <SET NARGS <+ .NARGS 1>>>
 429               .LABELS>
 430         NORMAL>
 431
 432 <DEFINE MAKTUP-GEN ("TUPLE" TEMPS
 433                     "AUX" RES (TLEN <LENGTH .TEMPS>) (ARGS ,ARGLIST-VARS)
 434                           LNOARG TVAR)
 435         <SET RES <NTH .TEMPS .TLEN>>
 436         <TEMP-PROCESS .RES>
 437         <GEN-LOC <SET TVAR <FIND-VAR .RES>> 0>
 438         <PUT .TVAR ,VARTBL-TEMP? <>>
 439         <MAPR ,TEMP-PROCESS
 440               <FCN (TEMPS "AUX" (TEMP <1 .TEMPS>))
 441                    <COND (<==? .TEMP => <MAPSTOP>)
 442                          (<OR <==? .RES .TEMP>
 443                               <=? .RES .TEMP>
 444                               <COND (<AND <TYPE? .RES ADECL>
 445                                           <TYPE? .TEMP ADECL>>
 446                                      <==? <1 .RES> <1 .TEMP>>)
 447                                     (<AND <TYPE? .RES ADECL>
 448                                           <TYPE? .TEMP ATOM>>
 449                                      <==? <1 .RES> .TEMP>)
 450                                     (<AND <TYPE? .RES ATOM>
 451                                           <TYPE? .TEMP ADECL>>
 452                                      <==? .RES <1 .TEMP>>)>>
 453                           <MAPRET>)
 454                          (<MAPRET .TEMP>)>>
 455               .TEMPS>
 456         <EMIT ,INST-MOVL <MA-REG ,AC-0> <MA-REG ,AC-1>>
 457         <COND (<NOT <EMPTY? .ARGS>>
 458                <ADD-CONSTANT-TO-AC <- <LENGTH .ARGS>> ,AC-1>
 459                <SET LNOARG <MAKE-LABEL>>
 460                <GEN-BRANCH ,INST-BGEQ .LNOARG <>>
 461                <EMIT ,INST-CLRL <MA-REG ,AC-1>>
 462                <EMIT-LABEL .LNOARG <>>)>
 463         <SETG MAKTUP-FLAG T>
 464         <EMIT-PUSH <TYPE-CODE TUPLE> WORD>
 465         <EMIT-PUSH <MA-REG ,AC-1> WORD>
 466         <CLEAR-PUSH>
 467         <EMIT-PUSH <TYPE-WORD T$FRAME> LONG>
 468         <EMIT-PUSH <MA-REG ,AC-F> LONG>
 469         <EMIT ,INST-MOVL <MA-REG ,AC-TP> <MA-REG ,AC-2>>
 470         <MAPF <> <FCN (VAR) <EMIT-PUSH <ADDR-VAR-TYPE .VAR> DOUBLE>> .ARGS>
 471         <EMIT-PUSH <TYPE-CODE TUPLE> WORD>
 472         <EMIT-PUSH <MA-REG ,AC-1> WORD>
 473         <EMIT-PUSH <MA-REG ,AC-F> LONG>
 474         <OR <0? <LENGTH .ARGS>>
 475             <EMIT ,INST-ADDL2
 476                   <MA-IMM <* <LENGTH .ARGS> 8>>
 477                   <MA-DISP ,AC-TP -4>>>
 478         <EMIT ,INST-MOVL <MA-REG ,AC-2> <MA-REG ,AC-F>>
 479         <INDICATE-TEMP-PATCH <ADD-PATCH TEMPORARIES>>
 480         NORMAL>
 481
 482 <COND (<NOT <GASSIGNED? ICALL-LEVEL>> <SETG ICALL-LEVEL 0>)>
 483
 484 <DEFINE ICALL-GEN (LABEL "OPTIONAL" (RES <>) "AUX" VADDR TADDR TLAB)
 485         #DECL ((LABEL) ATOM (RES) <OR FALSE ATOM VARTBL>)
 486         <FLUSH-ALL-ACS>
 487         <SETG ICALL-LEVEL <+ ,ICALL-LEVEL 1>>
 488         <COND (<TYPE? .RES VARTBL>
 489                <SET TADDR <ADDR-VAR-TYPE .RES>>
 490                <SET VADDR <ADDR-VAR-VALUE .RES>>)>
 491         <SETG ICALL-LABELS (.LABEL !,ICALL-LABELS)>
 492         <NEW-MODEL <CREATE-MODEL>>
 493         <CALL-RTE ,INCALL!-MIMOP CALL <> <>>
 494         <SET TLAB <MAKE-LABEL>>
 495         <EMIT-BRANCH ,INST-BRB .TLAB <> 0 <> T>
 496         <COND (<==? .RES STACK> <EMIT-PUSH <MA-REG ,AC-0> DOUBLE>)
 497               (<TYPE? .RES VARTBL> <EMIT ,INST-MOVQ <MA-REG ,AC-0> .TADDR>)>
 498         <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH>
 499         <EMIT-LABEL .TLAB <>>
 500         NORMAL>
 501
 502 "Args are:  LOCAL variable being set; FRAME where new val is coming from;
 503  variable in that frame for new value."
 504 <DEFINE SETLR-GEN (LVAR FVAR NLVAR
 505                    "OPTIONAL" (HINT <>)
 506                    "AUX" TAC FAC (SADDR <ADDR-VAR-OFFSET .NLVAR>) (TYP <>) REFNUM)
 507         #DECL ((NLVAR) VARTBL (LVAR) <OR VARTBL ATOM>)
 508         ; "If we don't call GEN-LOC, this frob may never get a stack slot"
 509         <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
 510         <PROTECT-VAL .NLVAR>
 511         <COND (<AND <TYPE? .LVAR VARTBL>
 512                     <N==? .LVAR .FVAR>>
 513                <DEAD-VAR .LVAR>)>
 514         ; "Don't leave the old guy around in ACs"
 515         <PROTECT <SET FAC <LOAD-VAR .FVAR VALUE <> PREF-VAL>>>
 516         <COND (<==? .LVAR STACK>
 517                ; "Handle case of pushing non-local value (code hacked
 518                   in ILDB-LOOKAHEAD pass)"
 519                <EMIT-PUSH <MA-DISP .FAC .SADDR> DOUBLE>)
 520               (<AND .TYP <NOT <COUNT-NEEDED? .TYP>>>
 521                <SET TAC <GET-AC PREF-VAL T>>
 522                ; "Don't clobber frame AC; these guys run in sets"
 523                <EMIT ,INST-MOVL <MA-DISP .FAC <+ .SADDR 4>> <MA-REG .TAC>>
 524                <DEST-DECL .TAC .LVAR .TYP>)
 525               (ELSE
 526                <SET TAC <GET-AC DOUBLE T>>
 527                <EMIT ,INST-MOVQ <MA-DISP .FAC .SADDR> <MA-REG .TAC>>
 528                <DEST-PAIR <NEXT-AC .TAC> .TAC .LVAR>)>
 529         NORMAL>
 530
 531 "Args are:  FRAME where new value is going; variable in that frame; value
 532  for variable (often local var, often not)"
 533 <DEFINE SETRL-GEN (FVAR NLVAR LVAR
 534                    "OPTIONAL" (HINT <>)
 535                    "AUX" FAC (SADDR <ADDR-VAR-OFFSET .NLVAR>) REFNUM TAC CADDR
 536                          (TYP <>) LV T1 T2)
 537    #DECL ((NLVAR FVAR) VARTBL (SADDR) FIX)
 538    <PROTECT-VAL .LVAR>
 539    <PROTECT <SET FAC <LOAD-VAR .FVAR VALUE <> PREF-VAL>>>
 540    <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
 541    <COND (.TYP)
 542          (<TYPE? .LVAR VARTBL> <SET TYP <VARTBL-DECL .LVAR>>)
 543          (<SET TYP <TYPE .LVAR>>)>
 544    <COND (<TYPE? .LVAR VARTBL>
 545           <COND (<OR <NOT <SET LV <FIND-CACHE-VAR .LVAR>>>
 546                      <AND <SET T1 <LINKVAR-VALUE-AC .LV>>
 547                           <SET T2 <LINKVAR-TYPE-WORD-AC .LV>>
 548                           <==? .T1 <NEXT-AC .T2>>>
 549                      <AND <LINKVAR-VALUE-STORED .LV>
 550                           <LINKVAR-TYPE-STORED .LV>
 551                           <LINKVAR-COUNT-STORED .LV>>>
 552                  <EMIT ,INST-MOVQ
 553                        <COND (<AND .LV .T1> <MA-REG .T2>)
 554                              (ELSE
 555                               <ADDR-VAR-TYPE-VALUE .LVAR>)>
 556                        <MA-DISP .FAC .SADDR>>)
 557                 (.TYP
 558                  <EMIT ,INST-MOVL
 559                        <VAR-VALUE-ADDRESS .LVAR>
 560                        <MA-DISP .FAC <+ .SADDR 4>>>
 561                  <EMIT ,INST-MOVW
 562                        <TYPE-CODE .TYP WORD>
 563                        <MA-DISP .FAC .SADDR>>
 564                  <COND (<COUNT-NEEDED? .TYP>
 565                         <COND (<SET TAC <VAR-COUNT-IN-AC? .LVAR>>
 566                                <EMIT ,INST-MOVW
 567                                      <MA-REG .TAC>
 568                                      <MA-DISP .FAC <+ .SADDR 2>>>)
 569                               (<SET CADDR <VAR-COUNT-STORED? .LVAR>>
 570                                <EMIT ,INST-MOVW
 571                                      .CADDR
 572                                      <MA-DISP .FAC <+ .SADDR 2>>>)
 573                               (<ERROR "COUNT NOT FOUND" SETRL-GEN>)>)>)
 574                 (ELSE
 575                  <EMIT ,INST-MOVL
 576                        <VAR-TYPE-ADDRESS .LVAR TYPE-WORD>
 577                        <MA-DISP .FAC .SADDR>>
 578                  <EMIT ,INST-MOVL
 579                        <VAR-VALUE-ADDRESS .LVAR>
 580                        <MA-DISP .FAC <+ .SADDR 4>>>)>)
 581          (ELSE
 582           <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .LVAR> <MA-DISP .FAC .SADDR>>)>
 583    NORMAL>
 584
 585 <DEFINE FIXBIND-GEN () <CALL-RTE ,IFIXBND!-MIMOP CALL <> <>> NORMAL>
 586
 587 <DEFINE BIND-GEN (RES "OPTIONAL" HINT)
 588         #DECL ((RES) <OR ATOM VARTBL>)
 589         <CALL-RTE ,IBIND!-MIMOP CALL .RES <>>>
 590
 591 <DEFINE CFRAME-GEN (RES "OPTIONAL" HINT "AUX" VAC TLAB)
 592         #DECL ((RES) <OR ATOM VARTBL>)
 593         <SET VAC <GET-AC PREF-VAL T>>
 594         <COND (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
 595                <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG .VAC>>)
 596               (<EMIT ,INST-MOVL <MA-REG ,AC-F> <MA-REG .VAC>>)>
 597         <EMIT ,INST-TSTL <MA-DISP .VAC -4>>
 598         <SET TLAB <MAKE-LABEL>>
 599         <GEN-BRANCH ,INST-BLSS .TLAB <>>
 600         <EMIT-MOVE <MA-DISP .VAC -4> <MA-REG .VAC> LONG>
 601         <EMIT-LABEL .TLAB <>>
 602         <DEST-DECL .VAC .RES T$FRAME>
 603         NORMAL>
 604
 605 <DEFINE UNBIND-GEN (VAR)
 606         #DECL ((VAR) VARTBL)
 607         <CALL-RTE ,IUNBIND!-MIMOP CALL <> <> .VAR>
 608         NORMAL>
 609
 610 <DEFINE GETS-GEN (CASE RES "OPTIONAL" HINT "AUX" CE AC)
 611         #DECL ((CASE) ATOM)
 612         <COND (<MEMBER <SPNAME .CASE> '["PURVEC" "DBVEC"]>
 613                <COND (<==? .RES STACK>
 614                       <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC <>>>
 615                             <MA-AINC ,AC-TP>>)
 616                      (T
 617                       <SET-GEN .RES <>>)>)
 618               (<MEMBER <SPNAME .CASE> '["BIND" "BINDID"]>
 619                <COND (<==? .RES STACK>
 620                       <COND (<=? <SPNAME .CASE> "BIND">
 621                              <EMIT-PUSH <TYPE-WORD LBIND> LONG>
 622                              <EMIT-PUSH <MA-ABS ,SPSTO-LOC> LONG>)
 623                             (T
 624                              <EMIT-PUSH <TYPE-CODE FIX> LONG>
 625                              <EMIT-PUSH <MA-ABS ,BINDID-LOC> LONG>)>)
 626                      (T
 627                       <COND (<SET AC <VAR-VALUE-IN-AC? .RES>>
 628                              <STORE-AC .AC <> <FIND-CACHE-VAR .RES>>)
 629                             (T
 630                              <SET AC <GET-AC PREF-VAL T>>)>
 631                       <COND (<=? <SPNAME .CASE> "BIND">
 632                              <EMIT-MOVE <MA-ABS ,SPSTO-LOC> <MA-REG .AC> LONG>
 633                              <DEST-DECL .AC .RES LBIND>)
 634                             (T
 635                              <EMIT-MOVE <MA-ABS ,BINDID-LOC> <MA-REG .AC> LONG>
 636                              <DEST-DECL .AC .RES FIX>)>)>)
 637               (T
 638                <SET CE <FIND-CASE-ENTRY .CASE>>
 639                <CALL-RTE ,IGETS!-MIMOP CALL .RES
 640                          <CSENT-VTYP .CE> <CSENT-OFF .CE>>)>
 641         NORMAL>
 642
 643 <DEFINE SETS-GEN (CASE VAL "AUX" CE)
 644         <COND (<MEMBER <SPNAME .CASE> '["BIND" "BINDID"]>
 645                <EMIT-MOVE <COND (<TYPE? .VAL VARTBL>
 646                                  <VAR-VALUE-ADDRESS .VAL>)
 647                                 (T
 648                                  <MA-IMM .VAL>)>
 649                           <COND (<=? <SPNAME .CASE> "BIND">
 650                                  <MA-ABS ,SPSTO-LOC>)
 651                                 (<MA-ABS ,BINDID-LOC>)> LONG>)
 652               (<NOT <MEMBER <SPNAME .CASE> ["PURVEC" "DBVEC"]>>
 653                <SET CE <FIND-CASE-ENTRY .CASE>>
 654                <CALL-RTE ,ISETS!-MIMOP CALL <> <> .VAL <CSENT-OFF .CE>>)>
 655         NORMAL>
 656
 657 <NEWSTRUC CASE-ENTRY VECTOR
 658           CSENT-KIND ATOM
 659           CSENT-OFF FIX
 660           CSENT-VTYP ATOM>
 661
 662 <DEFINE CREATE-CASE-ENTRY (KIND OFF VTYP)
 663         #DECL ((KIND VTYP) ATOM (OFF) FIX)
 664         <CHTYPE <VECTOR .KIND .OFF .VTYP> CASE-ENTRY>>
 665
 666 <GDECL (CASE-ENTRY-TABLE) <VECTOR [REST CASE-ENTRY]>>
 667
 668 <DEFINE FIND-CASE-ENTRY (KIND)
 669         <MAPF <>
 670               <FCN (CE)
 671                    <COND (<=? <SPNAME .KIND> <SPNAME <CSENT-KIND .CE>>>
 672                           <MAPLEAVE .CE>)>>
 673               ,CASE-ENTRY-TABLE>>
 674
 675 <DEFINE RECORD-GEN (TYPARG "TUPLE" ARGS)
 676         #DECL ((TYPARG) <OR ATOM FIX>)
 677         <COND (<TYPE? .TYPARG ATOM>
 678                <SET TYPARG <2 <MEMQ .TYPARG ,TYPE-WORDS>>>)>
 679         <CALL-STACK-FUNCTION .ARGS ,BRECORD!-MIMOP <> .TYPARG>
 680         NORMAL>
 681
 682 <DEFINE LIST-GEN (LEN RES "OPTIONAL" HINT)
 683         #DECL ((LEN) <OR FIX VARTBL> (RES) <OR VARTBL ATOM>)
 684         <CALL-RTE ,BLIST!-MIMOP CALL .RES LIST .LEN>
 685         NORMAL>
 686
 687 <DEFINE RTUPLE-GEN (TVAR FVAR "OPTIONAL" RES)
 688         <CALL-RTE ,IRTUPLE!-MIMOP JUMP <> <> .TVAR .FVAR>
 689         UNCONDITIONAL-BRANCH>
 690
 691 <DEFINE AGAIN-GEN (TVAR "OPTIONAL" RES)
 692         #DECL ((TVAR) VARTBL)
 693         <CALL-RTE ,IAGAIN!-MIMOP JUMP <> <> .TVAR>
 694         UNCONDITIONAL-BRANCH>
 695
 696 <DEFINE RETRY-GEN (TVAR "OPTIONAL" RES)
 697         #DECL ((TVAR) VARTBL)
 698         <CALL-RTE ,IRETRY!-MIMOP JUMP <> <> .TVAR>
 699         UNCONDITIONAL-BRANCH>
 700
 701 <DEFINE ACTIVATION-GEN ("OPTIONAL" VAR)
 702         <CALL-RTE ,IACTIVATION!-MIMOP CALL <> <>>
 703         NORMAL>
 704
 705 <DEFINE TUPLE-GEN (NUM DEST "OPTIONAL" HINT)
 706         #DECL ((NUM) <OR FIX VARTBL> (DEST) VARTBL)
 707         <CALL-RTE ,ITUPLE!-MIMOP CALL .DEST TUPLE .NUM>>
 708
 709 <DEFINE SBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
 710   #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
 711   <GET-AC ,AC-0 T>
 712   <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
 713          <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
 714         (T
 715          <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
 716   <CALL-RTE ,ISBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
 717   NORMAL>
 718
 719 <DEFINE USBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
 720   #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
 721   <GET-AC ,AC-0 T>
 722   <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
 723          <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
 724         (T
 725          <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
 726   <CALL-RTE ,UISBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
 727   NORMAL>
 728
 729 <DEFINE INTGO-GEN ("AUX" (LAB <MAKE-LABEL>))
 730         <COND (<AND <NOT ,BOOT-MODE>
 731                     <NOT ,GC-MODE>
 732                     <NOT ,DONT-INTERRUPT?>>
 733                <EMIT ,INST-TSTL <MA-ABS ,INTFLG-LOC>>
 734                <GEN-BRANCH ,INST-BEQL .LAB <>>
 735                <CALL-RTE ,LCKINT!-MIMOP CALL <> <>>
 736                <EMIT-LABEL .LAB <>>)>
 737         NORMAL>
 738
 739 <DEFINE TYPE-GEN (VAL RES "OPTIONAL" HINT "AUX" DAC)
 740         #DECL ((VAL) VARTBL (RES) <OR ATOM VARTBL>)
 741         <SET DAC <LOAD-VAR .VAL TYPE <> PREF-TYPE>>
 742         <DEST-DECL .DAC .RES FIX>>
 743
 744 <DEFINE NEWTYPE-GEN (VAL1 RES "OPTIONAL" HINT)
 745         #DECL ((VAL1) VARTBL (RES) <OR ATOM VARTBL>)
 746         <CALL-RTE ,INEWTYPE!-MIMOP CALL .RES FIX .VAL1>>
 747
 748 <DEFINE TYPEW-GEN (ARG1 ARG2 RES "OPTIONAL" HINT)
 749   #DECL ((ARG1 ARG2) VARTBL (RES) <OR ATOM VARTBL>)
 750   <CALL-RTE ,ITYPEW!-MIMOP CALL .RES TYPE-W .ARG1 .ARG2>>
 751
 752 <DEFINE TYPEWC-GEN (ARG1 RES "OPTIONAL" HINT "AUX" VAC)
 753   #DECL ((ARG1) VARTBL (RES) <OR ATOM VARTBL>)
 754   <CALL-RTE ,ITYPEWC!-MIMOP CALL .RES TYPE-C .ARG1>>
 755
 756 <DEFINE OPEN-GEN (MODE BYTESZ NAME RES "OPTIONAL" (HINT <>))
 757         #DECL ((MODE BYTESZ) <OR VARTBL FIX> (NAME) <OR STRING VARTBL>
 758                (RES) <OR ATOM VARTBL>)
 759         <CALL-RTE ,IOPEN!-MIMOP CALL .RES .HINT .MODE .BYTESZ .NAME>
 760         NORMAL>
 761
 762 <DEFINE CLOSE-GEN (CH "OPTIONAL" RES)
 763         #DECL ((CH) <OR FIX VARTBL>)
 764         <CALL-RTE ,ICLOSE!-MIMOP CALL <> <> .CH>
 765         NORMAL>
 766
 767 <DEFINE RESET-GEN (CH "OPTIONAL" RES)
 768         #DECL ((CH) <OR FIX VARTBL>)
 769         <CALL-RTE ,IRESET!-MIMOP CALL <> <> .CH>
 770         NORMAL>
 771
 772 <DEFINE READ-GEN (CHN STR NUMARGS GARB "OPTIONAL" (RES <>))
 773         #DECL ((CHN NUMARGS) <OR VARTBL FIX> (STR) VARTBL)
 774         <CALL-RTE ,IREAD!-MIMOP CALL .RES FIX .CHN .STR .NUMARGS .GARB>>
 775
 776 <DEFINE PRINT-GEN (CHN STR NUMARGS)
 777         #DECL ((CHN NUMARGS) <OR VARTBL FIX> (STR) VARTBL)
 778         <CALL-RTE ,IPRINT!-MIMOP CALL <> <> .CHN .STR .NUMARGS>>
 779
 780 <DEFINE RNTIME-GEN ("OPTIONAL" (RES <>))
 781         <CALL-RTE ,IRNTIME!-MIMOP CALL .RES <>>>
 782
 783 <DEFINE SAVE-GEN (CHN "OPTIONAL" (ATMZN <>) (PURZN <>) (RES <>))
 784         #DECL ((CHN) <OR VARTBL FIX>)
 785         <CALL-RTE ,ISAVE!-MIMOP CALL .RES <> .CHN .ATMZN .PURZN>
 786         NORMAL>
 787
 788 <DEFINE RESTORE-GEN (CHN "OPTIONAL" (RES <>))
 789         #DECL ((CHN) <OR VARTBL FIX>)
 790         <CALL-RTE ,IRESTORE!-MIMOP CALL .RES <> .CHN>
 791         NORMAL>
 792
 793 <DEFINE COMPERR-GEN () <CALL-RTE ,ICOMPERR!-MIMOP CALL <> <>> NORMAL>
 794
 795 <DEFINE UNWCNT-GEN () <CALL-RTE ,IUNWCNT!-MIMOP JUMP <> <>> NORMAL>
 796
 797 <DEFINE IRECORD-GEN (TYPEC NARGS NWORDS RES "OPTIONAL" (HINT <>))
 798         #DECL ((TYPEC NARGS NWORDS) <OR VARTBL FIX> (RES) <OR ATOM VARTBL>)
 799         <CALL-RTE ,BIREC!-MIMOP CALL .RES .HINT .TYPEC .NARGS .NWORDS>
 800         NORMAL>
 801
 802 <DEFINE ADJ-GEN (AMT "AUX" VAC LVAR)
 803         #DECL ((AMT) <OR FIX VARTBL>)
 804         <COND (<TYPE? .AMT FIX> <ADD-CONSTANT-TO-AC <* .AMT 8> ,AC-TP>)
 805               (<AND <SET LVAR <FIND-CACHE-VAR .AMT>>
 806                     <SET VAC <LINKVAR-VALUE-AC .LVAR>>>
 807                <EMIT ,INST-ASHL <MA-IMM 3> <MA-REG .VAC>
 808                      <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>
 809                <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG ,AC-TP>>)
 810               (ELSE
 811                <EMIT ,INST-ASHL <MA-IMM 3> <VAR-VALUE-ADDRESS .AMT>
 812                      <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>
 813                <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG ,AC-TP>>)>
 814         NORMAL>
 815
 816 <DEFINE NTHU-GEN (STRUC NUM RES "OPTIONAL" (HINT <>))
 817         <CALL-RTE ,INTHU!-MIMOP CALL .RES .HINT .STRUC .NUM>
 818         NORMAL>
 819
 820 <DEFINE RESTU-GEN (STRUC NUM RES "OPTIONAL" (HINT <>))
 821         <CALL-RTE ,IRESTU!-MIMOP CALL .RES .HINT .STRUC .NUM>
 822         NORMAL>
 823
 824 <DEFINE PUTU-GEN (STRUC NUM VAL "OPTIONAL" (HINT <>))
 825         <CALL-RTE ,IPUTU!-MIMOP CALL <> <> .STRUC .NUM .VAL>
 826         NORMAL>
 827
 828 <DEFINE ATIC-GEN (ARG "OPTIONAL" (RES <>) (HINT <>))
 829         <CALL-RTE ,IATIC!-MIMOP CALL .RES .HINT .ARG>
 830         NORMAL>
 831
 832 <DEFINE PFRAME-GEN (FRM RES "OPTIONAL" HINT "AUX" VAC TAC NPL TLAB)
 833         #DECL ((FRM) VARTBL (RES) <OR ATOM VARTBL>)
 834         <SET TAC <GET-AC>>
 835         <SET VAC <LOAD-VAR .FRM VALUE <> ANY-AC>>
 836         <EMIT ,INST-MOVL <MA-DISP .VAC -12> <MA-REG .VAC>>
 837         <SET TLAB <MAKE-LABEL>>
 838         <EMIT-LABEL .TLAB T>
 839         <EMIT ,INST-TSTB <MA-DISP .VAC -1>>
 840         <SET NPL <MAKE-LABEL>>
 841         <GEN-BRANCH ,INST-BLSS .NPL <>>
 842         <EMIT ,INST-MOVL <MA-DISP .VAC -4> <MA-REG .VAC>>
 843         <GEN-BRANCH ,INST-BRB .TLAB UNCONDITIONAL-BRANCH>
 844         <EMIT-LABEL .NPL <>>
 845         <EMIT ,INST-MOVL <TYPE-WORD FRAME> <MA-REG .TAC>>
 846         <DEST-PAIR .VAC .TAC .RES>
 847         NORMAL>
 848
 849 <DEFINE ARGS-GEN (FRM "OPTIONAL" (RES <>) (HINT <>))
 850         #DECL ((FRM) VARTBL)
 851         <CALL-RTE ,IARGS!-MIMOP CALL .RES .HINT .FRM>>
 852
 853 <DEFINE VALUE-GEN (VAL RES "OPTIONAL" HINT "AUX" VAC)
 854         #DECL ((RES) <OR ATOM VARTBL>)
 855         <SET VAC <GET-AC>>
 856         <MOVE-VALUE .VAL .VAC>
 857         <DEST-DECL .VAC .RES FIX>
 858         NORMAL>
 859
 860 <DEFINE OBJECT-GEN (TYP CNT VAL RES "AUX" TAC VAC (TDONE? <>))
 861   <COND (<==? .RES STACK>
 862          <COND (<TYPE? .TYP VARTBL>
 863                 <EMIT-PUSH <VAR-VALUE-ADDRESS .TYP> WORD>)
 864                (<EMIT-PUSH <MA-IMM .TYP> WORD>)>
 865          <COND (<TYPE? .CNT VARTBL>
 866                 <EMIT-PUSH <VAR-VALUE-ADDRESS .CNT> WORD>)
 867                (<EMIT-PUSH <MA-IMM .CNT> WORD>)>
 868          <COND (<TYPE? .VAL VARTBL>
 869                 <EMIT-PUSH <VAR-VALUE-ADDRESS .VAL> LONG>)
 870                (<EMIT-PUSH <MA-IMM .VAL> LONG>)>)
 871         (T
 872          <SET TAC <GET-AC DOUBLE T>>
 873          <COND (<NOT <TYPE? .CNT VARTBL>>
 874                 <COND (<==? .CNT 0>
 875                        <SET TDONE? T>
 876                        <COND (<TYPE? .TYP VARTBL>
 877                               <EMIT ,INST-MOVZWL <VAR-VALUE-ADDRESS .TYP>
 878                                     <MA-REG .TAC>>)
 879                              (T
 880                               <EMIT-MOVE <MA-IMM .TYP> <MA-REG .TAC> LONG>)>)
 881                       (<NOT <TYPE? .TYP VARTBL>>
 882                        <SET TDONE? T>
 883                        <EMIT-MOVE <MA-IMM <ORB .TYP <LSH .CNT 16>>>
 884                                   <MA-REG .TAC> LONG>)>)>
 885          <COND (<NOT .TDONE?>
 886                 <EMIT ,INST-MOVW <COND (<TYPE? .CNT VARTBL>
 887                                         <VAR-VALUE-ADDRESS .CNT>)
 888                                        (<MA-IMM .CNT>)> <MA-REG .TAC>>
 889                 <EMIT ,INST-ASHL <MA-LIT 16> <MA-REG .TAC> <MA-REG .TAC>>
 890                 <EMIT ,INST-MOVW <COND (<TYPE? .TYP VARTBL>
 891                                         <VAR-VALUE-ADDRESS .TYP>)
 892                                        (<MA-IMM .TYP>)> <MA-REG .TAC>>)>
 893          <EMIT ,INST-MOVL <COND (<TYPE? .VAL VARTBL>
 894                                  <VAR-VALUE-ADDRESS .VAL>)
 895                                 (<MA-IMM .VAL>)>
 896                <MA-REG <SET VAC <NEXT-AC .TAC>>>>
 897          <DEST-PAIR .VAC .TAC .RES T>)>
 898   NORMAL>
 899
 900 <DEFINE NTH1-GEN (VAL RES "OPTIONAL" (HINT <>))
 901         <CALL-RTE ,CINTH!-MIMOP CALL .RES .HINT .VAL>>
 902
 903 <DEFINE REST1-GEN (VAL RES "OPTIONAL" (HINT <>))
 904         <CALL-RTE ,CIRST!-MIMOP CALL .RES .HINT .VAL>>
 905
 906 <DEFINE EMPTY?-GEN (VAR DIR LABEL "AUX" XLABEL)
 907         #DECL ((VAR) VARTBL (DIR LABEL) ATOM)
 908         <CALL-RTE ,CIEMP!-MIMOP CALL <> <> .VAR>
 909         <COND (<==? .DIR +>
 910                <GEN-BRANCH ,INST-BRB <SET XLABEL <MAKE-LABEL>>
 911                            UNCONDITIONAL-BRANCH <> T>)>
 912         <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH <> <==? .DIR ->>
 913         <COND (<==? .DIR +> <EMIT-LABEL .XLABEL <>>)>>
 914
 915 <DEFINE GASSIGNED?-GEN (VAL RES "OPTIONAL" (HINT <>))
 916         <CALL-RTE ,CIGAS!-MIMOP CALL .RES .HINT .VAL>>
 917
 918 <DEFINE MONAD?-GEN (VAR DIR LABEL "AUX" XLABEL)
 919         #DECL ((VAR) VARTBL (DIR LABEL) ATOM)
 920         <CALL-RTE ,CIMON!-MIMOP CALL <> <> .VAR>
 921         <COND (<==? .DIR +>
 922                <GEN-BRANCH ,INST-BRB <SET XLABEL <MAKE-LABEL>>
 923                            UNCONDITIONAL-BRANCH <> T>)>
 924         <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH <> <==? .DIR ->>
 925         <COND (<==? .DIR +> <EMIT-LABEL .XLABEL <>>)>>
 926
 927 <DEFINE FGVAL-GEN (VAL RES "OPTIONAL" (HINT <>))
 928         <CALL-RTE ,CIGVL!-MIMOP CALL .RES .HINT .VAL>>
 929
 930 <DEFINE ACALL-GEN (SBR NARG "OPT" (RES <>) (HINT <>))
 931         <CALL-RTE ,IACALL!-MIMOP CALL .RES .HINT .SBR .NARG>>
 932
 933 ; "return 0 if pointer is not to stack; 1 if to unused stack area; -1 if to
 934    actual stack"
 935 <DEFINE ON-STACK?-GEN (OBJ RES "OPTIONAL" (HINT <>) (LABEL <MAKE-LABEL>) TAC)
 936   #DECL ((OBJ) VARTBL)
 937   <SET TAC <GET-AC PREF-VAL T>>
 938   <LOAD-CONSTANT .TAC 0>
 939   <DEST-DECL .TAC .RES FIX>
 940   <EMIT ,INST-CMPL <MA-ABS ,STKBOT-LOC> <VAR-VALUE-ADDRESS .OBJ>>
 941   <GEN-BRANCH ,INST-BGTR .LABEL <>>             ; "Below stack"
 942   <EMIT ,INST-CMPL <MA-ABS ,STKTOP-LOC> <VAR-VALUE-ADDRESS .OBJ>>
 943   <GEN-BRANCH ,INST-BLSS .LABEL <>>             ; "Above stack area"
 944   <LOAD-CONSTANT .TAC 1>                        ; "Assume loser"
 945   <EMIT ,INST-CMPL <MA-REG ,AC-TP> <VAR-VALUE-ADDRESS .OBJ>>
 946   <GEN-BRANCH ,INST-BLSS .LABEL <>>             ; "Above top of stack"
 947   <LOAD-CONSTANT .TAC -1>
 948   <EMIT-LABEL .LABEL <>>
 949   NORMAL>