mim/development/mim/vaxc/gcgen.mud

   1 <MSETG BIT0 1>
   2 <MSETG BIT1 2>
   3 <MSETG BIT2 4>
   4 <MSETG BIT3 8>
   5 <MSETG BIT4 16>
   6 <MSETG BIT5 32>
   7
   8 <MSETG ADDR-MASK-2 3>
   9
  10 <MSETG SHORT-MARK-BIT <CHTYPE <LSH 1 7> FIX>>
  11
  12 <MSETG MARK-BIT <CHTYPE <LSH 1 15> FIX>>
  13
  14 <MSETG DOPE-BIT <CHTYPE <LSH 1 5> FIX>>
  15
  16 <MSETG FLEN 28>
  17
  18 <MSETG LIST-LEN 12>
  19 <MSETG ATOM-LEN 20>
  20 <MSETG GBIND-LEN 20>
  21 <MSETG LBIND-LEN 32>
  22
  23 <DEFINE GCTEMP (NUM)
  24   <MA-DISP ,AC-TP <* .NUM -4>>>
  25
  26 <DEFINE CGC-RECORD-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM BOUNDS-ATOM RES
  27                         "OPTIONAL" (HINT <>) "AUX" RLEN STK? ALLOCADDR ENDADDR
  28                         (BOUNDS-LAB <MAKE-LABEL>) (IB-LAB <MAKE-LABEL>)
  29                         (F-LAB <MAKE-LABEL>) (EXIT-LAB <MAKE-LABEL>)
  30                         (M-LAB <MAKE-LABEL>))
  31   <COND (.HINT
  32          <SET HINT <PARSE-HINT .HINT RECORD-TYPE>>)>
  33   <COND (<==? .HINT ATOM>
  34          <SET RLEN ,ATOM-LEN>
  35          <SET STK? <>>)
  36         (<==? .HINT GBIND>
  37          <SET RLEN ,GBIND-LEN>
  38          <SET STK? <>>)
  39         (<==? .HINT LBIND>
  40          <SET RLEN ,LBIND-LEN>
  41          <SET STK? T>)
  42         (T
  43          <ERROR BAD-HINT-FOR-CGC-RECORD!-ERRORS .HINT CGC-RECORD-GEN>)>
  44   <MAPF <>
  45         <FUNCTION (X) <MUNG-AC ,.X>>
  46         '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
  47   <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
  48   <SET ALLOCADDR
  49        <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
  50   <COND (.STK?
  51          <EMIT ,INST-CMPL <MA-REG ,AC-TP> <VAR-VALUE-ADDRESS .VAR>>
  52          ; "See if this guy is on the stack"
  53          <EMIT-BRANCH ,INST-BLSS .BOUNDS-LAB <> ,LAST-INST-LENGTH>
  54          <EMIT ,INST-MOVQ <MA-DISP ,AC-M <ADD-MVEC <>>> <MA-REG ,AC-0>>
  55          <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
  56          <EMIT-LABEL .BOUNDS-LAB T>
  57          <FRAME-GEN .BOUNDS-ATOM>
  58          <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAR> <MA-AINC ,AC-TP>>
  59          <CALL-GEN .BOUNDS-ATOM 1>
  60          <EMIT ,INST-TSTL <MA-REG ,AC-1>>
  61          <EMIT-BRANCH ,INST-BNEQ .IB-LAB <> ,LAST-INST-LENGTH>
  62          <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-0>>
  63          <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
  64          <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
  65          <EMIT-LABEL .IB-LAB T>)>
  66   <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
  67   <EMIT ,INST-TSTB <MA-DISP ,AC-1 <+ .RLEN 1>>>
  68   <EMIT-BRANCH ,INST-BGEQ .M-LAB <> ,LAST-INST-LENGTH>
  69   <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
  70   <EMIT ,INST-MOVL <MA-DISP ,AC-1 <+ .RLEN 4>> <MA-REG ,AC-1>>
  71   <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
  72   ; "Jump if already marked"
  73   <EMIT-LABEL .M-LAB T>
  74   <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-1 <+ .RLEN 1>>>
  75   <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>
  76   <EMIT ,INST-ADDL3 <MA-IMM <+ .RLEN 8>> <MA-REG ,AC-3> <MA-REG ,AC-6>>
  77   <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
  78   <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
  79   <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
  80   <FRAME-GEN .NEXT-ATOM>
  81   <EMIT-PUSH <TYPE-WORD FIX> LONG>
  82   <EMIT ,INST-MOVL <MA-IMM <+ .RLEN 8>> <MA-AINC ,AC-TP>>
  83   <CALL-GEN .NEXT-ATOM 1>
  84   <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
  85   <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>
  86   <EMIT ,INST-ADDL3 <MA-IMM <+ .RLEN 8>> <MA-REG ,AC-3> <MA-REG ,AC-6>>
  87   <EMIT-LABEL .F-LAB T>
  88   <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-DISP ,AC-1 <+ .RLEN 4>>>
  89   <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
  90   <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
  91   <EMIT ,INST-MOVQ <MA-DISP ,AC-1 .RLEN> <MA-DISP ,AC-3 .RLEN>>
  92   <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 <+ .RLEN 1>>>
  93   <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-REG ,AC-1>>
  94   <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-0>>
  95   <EMIT-LABEL .EXIT-LAB T>
  96   <COND (<==? .RES STACK>
  97          <EMIT ,INST-MOVQ <MA-REG ,AC-0><MA-AINC ,AC-TP>>)
  98         (T
  99          <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
 100   NORMAL>
 101
 102 <DEFINE CGC-STBYTE-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES)
 103   <MAPF <>
 104         <FUNCTION (X) <MUNG-AC ,.X>>
 105         '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
 106   <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-0>>
 107   <EMIT ,INST-ADDL3 <MA-REG ,AC-0> <VAR-VALUE-ADDRESS .VAR>
 108         <MA-REG ,AC-1>>
 109   <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG ,AC-1>>
 110   <EMIT ,INST-BICB2 <MA-IMM 3> <MA-REG ,AC-1>>
 111   ; "Actual dope word pointer"
 112   <EMIT ,INST-SUBL3 <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1> <MA-REG ,AC-0>>
 113   ; "Number of bytes including slop in last word"
 114   <CGC-UV-ST .VAR .ALLOC-ATOM .END-ATOM .NEXT-ATOM .RES>>
 115
 116 <DEFINE CGC-UVECTOR-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES)
 117   <MAPF <>
 118         <FUNCTION (X) <MUNG-AC ,.X>>
 119         '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
 120   <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-0>>
 121   <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-0> <MA-REG ,AC-0>>
 122   <EMIT ,INST-ADDL3 <MA-REG ,AC-0> <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
 123   <CGC-UV-ST .VAR .ALLOC-ATOM .END-ATOM .NEXT-ATOM .RES>>
 124
 125 ; "Call this guy with ac-0 set up to have number of bytes to subtract from
 126    dope word pointer to get new pointer; ac-1 has pointer to dope word.  0-6
 127    have been munged."
 128 <DEFINE CGC-UV-ST (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES
 129                          "AUX" ENDADDR ALLOCADDR (M-LAB <MAKE-LABEL>)
 130                                (BLT-LOOP <MAKE-LABEL>) (NF-LAB <MAKE-LABEL>)
 131                                (F-LAB <MAKE-LABEL>) (SHT-LAB <MAKE-LABEL>)
 132                                (DONE-LAB <MAKE-LABEL>))
 133         #DECL ((VAR) VARTBL (ALLOC-ATOM END-ATOM NEXT-ATOM) ATOM
 134                (RES) <OR VARTBL ATOM>)
 135         <SET ENDADDR <MA-DEF-DISP ,AC-M
 136                                   <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
 137         <SET ALLOCADDR
 138              <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
 139                                  ;"Pointers to GVAL slots for AL and END-SPACE"
 140         <EMIT ,INST-TSTB <MA-DISP ,AC-1 1>>
 141         <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
 142         <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-1 1>>
 143                                ;"can be BBSS when assembler and friends hacked"
 144         <EMIT ,INST-PUSHL <MA-REG ,AC-0>>        ;"Save for making new pointer"
 145         <EMIT ,INST-MOVZWL <MA-DISP ,AC-1 2> <MA-REG ,AC-6>>
 146                                                      ;"Size of whole structure"
 147         <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-6> <MA-REG ,AC-6>>  ;"in bytes"
 148         <EMIT ,INST-PUSHL <MA-REG ,AC-6>>
 149         <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>       ;"Current allocation"
 150         <EMIT ,INST-ADDL2 <MA-REG ,AC-3> <MA-REG ,AC-6>>
 151         <EMIT-BRANCH ,INST-BVS .NF-LAB <> ,LAST-INST-LENGTH>
 152                                                 ;"See if overflowed--won't fit"
 153         <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
 154         <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
 155                                             ;"See if won't fit in current area"
 156         <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
 157         <EMIT-LABEL .NF-LAB T>
 158         <FRAME-GEN .NEXT-ATOM>
 159         <EMIT-PUSH <TYPE-WORD FIX> LONG>
 160         <EMIT ,INST-MOVL <MA-REGD ,AC-P> <MA-AINC ,AC-TP>>
 161         <EMIT ,INST-PUSHL <MA-REG ,AC-1>>
 162         <CALL-GEN .NEXT-ATOM 1>                           ;"Go to another area"
 163         <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>              ;"get AL back"
 164         <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG ,AC-1>>
 165         <EMIT ,INST-MOVL <MA-REGD ,AC-P> <MA-REG ,AC-6>>
 166                                                    ;"get stuff back from stack"
 167         <EMIT ,INST-ADDL2 <MA-REG ,AC-3> <MA-REG ,AC-6>>      ;"compute new AL"
 168         <EMIT-LABEL .F-LAB T>
 169         <EMIT ,INST-MOVAL <MA-DISP ,AC-6 -8> <MA-DISP ,AC-1 4>>
 170                                              ;"stuff relocation into dope word
 171                                                now points to 1st dw"
 172         <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
 173         <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>                ;"update AL"
 174         <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG ,AC-6>>
 175                                                    ;"Get gross byte count back"
 176         <EMIT ,INST-SUBL2 <MA-REG ,AC-6> <MA-REG ,AC-1>>  ;"Top old structure"
 177         <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-1>>
 178         <EMIT-LABEL .BLT-LOOP T>
 179         <EMIT ,INST-MOVL <MA-REG ,AC-6> <MA-REG ,AC-5>>
 180         <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-IMM 65535>>
 181         <GEN-BRANCH ,INST-BLSS .SHT-LAB <>>
 182         <EMIT ,INST-MOVL <MA-IMM 65535> <MA-REG ,AC-5>>
 183         <EMIT-LABEL .SHT-LAB T>
 184         <EMIT ,INST-MOVC3 <MA-REG ,AC-5> <MA-REGD ,AC-1> <MA-REGD ,AC-3>>
 185         <EMIT ,INST-SUBL2 <MA-IMM 65535> <MA-REG ,AC-6>>
 186         <GEN-BRANCH ,INST-BGTR .BLT-LOOP <>>
 187         <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 -7>>
 188                                                            ;"Turn off mark bit"
 189         <EMIT ,INST-SUBL3 <MA-IMM 8> <MA-REG ,AC-3> <MA-REG ,AC-1>>
 190         <EMIT ,INST-SUBL2 <MA-AINC ,AC-P> <MA-REG ,AC-1>>
 191         <GEN-BRANCH ,INST-BRB .DONE-LAB <>>
 192         <EMIT-LABEL .M-LAB T>
 193         <EMIT ,INST-MOVL <MA-DISP ,AC-1 4> <MA-REG ,AC-1>>
 194         ; "Point to top"
 195         <EMIT ,INST-SUBL2 <MA-REG ,AC-0> <MA-REG ,AC-1>>
 196         <EMIT-LABEL .DONE-LAB T>
 197         <COND (<==? .RES STACK>
 198                <EMIT-PUSH <VAR-TYPE-ADDRESS .VAR> LONG>
 199                <EMIT-PUSH ,AC-1 LONG>)
 200               (T
 201                <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
 202                <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
 203         NORMAL>
 204
 205 <DEFINE CGC-VECTOR-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM MARK-ATOM RES
 206                         "AUX" ENDADDR ALLOCADDR (NF-LAB <MAKE-LABEL>)
 207                               (F-LAB <MAKE-LABEL>) (LOOP-LAB <MAKE-LABEL>)
 208                               (NM-LAB <MAKE-LABEL>) (DONE-LAB <MAKE-LABEL>)
 209                               (M-LAB <MAKE-LABEL>))
 210   <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
 211   <SET ALLOCADDR
 212        <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
 213   <MAPF <>
 214         <FUNCTION (X) <MUNG-AC ,.X>>
 215         '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
 216   <EMIT ,INST-ADDL2 <MA-IMM <* 5 4>> <MA-REG ,AC-TP>>
 217   ; "Allocate temps"
 218   <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-2>>
 219   <EMIT ,INST-ASHL <MA-IMM 3> <MA-REG ,AC-2> <MA-REG ,AC-2>>
 220   <EMIT ,INST-MOVL <MA-REG ,AC-2> <GCTEMP 5>>
 221   <EMIT ,INST-ADDL3 <MA-REG ,AC-2> <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-3>>
 222   ; "2 has # of bytes in current pointer; 3 points to first dw"
 223   <EMIT ,INST-TSTB <MA-DISP ,AC-3 1>>
 224   <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
 225   ; "jump if already marked"
 226   <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 1>>
 227   <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 1>>
 228   <EMIT ,INST-MOVZWL <MA-DISP ,AC-3 2> <MA-REG ,AC-6>>
 229   ; "# of words in whole structure"
 230   <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-6> <MA-REG ,AC-6>>
 231   ; "Bytes in structure"
 232   <EMIT ,INST-MOVL <MA-REG ,AC-6> <GCTEMP 2>>
 233   <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
 234   <EMIT ,INST-ADDL2 <MA-REG ,AC-1> <MA-REG ,AC-6>>
 235   <EMIT-BRANCH ,INST-BVS .NF-LAB <> ,LAST-INST-LENGTH>
 236   <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
 237   <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
 238   <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
 239   <EMIT-LABEL .NF-LAB T>
 240   <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 3>>
 241   <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
 242   <FRAME-GEN .NEXT-ATOM>
 243   <EMIT-PUSH <TYPE-WORD FIX> LONG>
 244   <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-AINC ,AC-TP>>
 245   <CALL-GEN .NEXT-ATOM 1>
 246   <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
 247   <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-3>>
 248   <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-6>>
 249   <EMIT ,INST-ADDL2 <MA-REG ,AC-1> <MA-REG ,AC-6>>
 250   ; "New AL"
 251   <EMIT-LABEL .F-LAB T>
 252   <EMIT ,INST-MOVAL <MA-DISP ,AC-6 -8> <MA-DISP ,AC-3 4>>
 253   ; "Stuff pointer to new dw into old"
 254   <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-DISP ,AC-6 -8>>
 255   ; "copy dope words"
 256   <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-6 -7>>
 257   ; "Clear mark bit in new"
 258   <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
 259   <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
 260   <EMIT ,INST-SUBL2 <MA-IMM 8> <GCTEMP 2>>
 261   ; "Flush dope words from byte count"
 262   <EMIT ,INST-SUBL2 <GCTEMP 2> <MA-REG ,AC-3>>
 263   ; "Point to top of old (ac 1 points to top of new)"
 264   <EMIT ,INST-ASHL <MA-IMM -3> <GCTEMP 2> <GCTEMP 2>>
 265   ; "Number of elements to mark"
 266   <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
 267   <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-REG ,AC-4>>
 268   <EMIT-LABEL .LOOP-LAB T>
 269   <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-REG ,AC-0>>
 270   <EMIT ,INST-BITB <MA-BYTE-IMM 7> <MA-REG ,AC-0>>
 271   ; "See if this guy is structured"
 272   <EMIT-BRANCH ,INST-BEQL .NM-LAB <> ,LAST-INST-LENGTH>
 273   <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 3>>
 274   <EMIT ,INST-MOVL <MA-REG ,AC-4> <GCTEMP 4>>
 275   <FRAME-GEN .MARK-ATOM>
 276   <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>
 277   <CALL-GEN .MARK-ATOM 1>
 278   <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-3>>
 279   <EMIT ,INST-MOVL <GCTEMP 4> <MA-REG ,AC-4>>
 280   <EMIT-LABEL .NM-LAB T>
 281   <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-REGD ,AC-4>>
 282   <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-3>>
 283   <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-4>>
 284   <EMIT ,INST-DECL <GCTEMP 2>>
 285   <EMIT-BRANCH ,INST-BGTR .LOOP-LAB <> ,LAST-INST-LENGTH>
 286   <EMIT-LABEL .DONE-LAB T>
 287   <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-3>>
 288   <EMIT-LABEL .M-LAB T>
 289   <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
 290   <EMIT ,INST-MOVL <MA-DISP ,AC-3 4> <MA-REG ,AC-1>>
 291   <EMIT ,INST-SUBL2 <GCTEMP 5> <MA-REG ,AC-1>>
 292   <EMIT ,INST-SUBL2 <MA-IMM <* 5 4>> <MA-REG ,AC-TP>>
 293   <COND (<==? .RES STACK>
 294          <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>)
 295         (<DEST-PAIR ,AC-1 ,AC-0 .RES>)>
 296   NORMAL>
 297
 298 <DEFINE CGC-LIST-GEN
 299         (VAR ALLOC-ATOM END-ATOM NEXT-ATOM BOUNDS-ATOM MARK-ATOM CHOMP "OPT" RES
 300          "AUX" ENDADDR ALLOCADDR (M-LAB <MAKE-LABEL>) (DONE-LAB <MAKE-LABEL>)
 301                (LOOP-LAB <MAKE-LABEL>) (NF-LAB <MAKE-LABEL>)
 302                (F-LAB <MAKE-LABEL>) (NB-LAB <MAKE-LABEL>)
 303                (MC-LAB <MAKE-LABEL>) (UNDO? <>))
 304         <COND (<NOT <ASSIGNED? RES>>
 305                <SET RES .CHOMP>)
 306               (<SET UNDO? T>)>
 307         <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
 308         <SET ALLOCADDR
 309              <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
 310         <MAPF <>
 311               <FUNCTION (X) <MUNG-AC ,.X>>
 312               '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
 313         <EMIT ,INST-ADDL2 <MA-IMM <* 3 4>> <MA-REG ,AC-TP>>
 314         <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-3>>
 315         <EMIT ,INST-MOVL <MA-IMM 0> <GCTEMP 1>>
 316         <EMIT-LABEL .LOOP-LAB T>
 317         <EMIT ,INST-TSTB <MA-DISP ,AC-3 1>>
 318         <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
 319         <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 1>>
 320                                          ;"Mark bit set, need to hack this up."
 321         <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
 322         <EMIT ,INST-ADDL3 <MA-IMM ,LIST-LEN> <MA-REG ,AC-1> <MA-REG ,AC-6>>
 323         <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
 324         <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
 325         <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
 326         <EMIT-LABEL .NF-LAB T>
 327         <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
 328         <FRAME-GEN .NEXT-ATOM>
 329         <EMIT-PUSH <TYPE-WORD FIX> LONG>
 330         <EMIT-PUSH <MA-IMM ,LIST-LEN> LONG>
 331         <CALL-GEN .NEXT-ATOM 1>
 332         <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
 333         <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
 334         <EMIT ,INST-ADDL3 <MA-IMM ,LIST-LEN> <MA-REG ,AC-1> <MA-REG ,AC-6>>
 335         <EMIT-LABEL .F-LAB T>
 336         <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-5>>
 337         <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
 338         <EMIT ,INST-ADDL2 <MA-IMM 4> <MA-REG ,AC-1>>
 339                                             ;"Point to right part of list cell"
 340         <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-4>>
 341                                             ;"Pick up pointer to previous cell"
 342         <EMIT-BRANCH ,INST-BEQL .NB-LAB <> ,LAST-INST-LENGTH>
 343         <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-DISP ,AC-4 -4>>
 344                                          ;"Fix up cdr pointer in previous cell"
 345         <EMIT-LABEL .NB-LAB T>
 346         <EMIT ,INST-MOVL <MA-REG ,AC-1> <GCTEMP 1>>
 347                                                    ;"New previous cell pointer"
 348         <EMIT ,INST-MOVL <MA-DISP ,AC-3 -4> <MA-REG ,AC-4>>
 349                                                          ;"Pick up cdr pointer"
 350         <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-DISP ,AC-3 -4>>
 351                                                      ;"Relocation for old cell"
 352         <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-DISP ,AC-1 -4>>
 353                          ;"Make sure new cell doesn't have garbage in cdr slot"
 354         <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-REG ,AC-0>>
 355         <EMIT ,INST-BICL2 <MA-IMM ,MARK-BIT> <MA-REG ,AC-0>>
 356         <EMIT ,INST-BITB <MA-BYTE-IMM 7> <MA-REG ,AC-0>>
 357                                              ;"See if car's type needs marking"
 358         <EMIT-BRANCH ,INST-BEQL .MC-LAB <> ,LAST-INST-LENGTH>
 359         <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
 360         <EMIT ,INST-MOVL <MA-REG ,AC-4> <GCTEMP 3>>
 361         ;"Save pointer to old cell"
 362         ;"Save old cdr pointer"
 363         <FRAME-GEN .MARK-ATOM>
 364         <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>
 365         <CALL-GEN .MARK-ATOM 1>                                 ;"Mark the guy"
 366         <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
 367         <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-4>>
 368         <EMIT-LABEL .MC-LAB T>
 369         <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-2>>
 370         <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-REGD ,AC-2>>
 371         <COND (.UNDO?
 372                ; "Save old CDR in new cell in case want to undo all this"
 373                <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-REGD ,AC-2>>)>
 374         <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-REG ,AC-3>>
 375                                              ;"Move cdr pointer to right place"
 376         <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
 377                                                        ;"All done if empty cdr"
 378         <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
 379         <FRAME-GEN .BOUNDS-ATOM>
 380         <EMIT-PUSH <TYPE-WORD LIST> LONG>
 381         <EMIT-PUSH <MA-REG ,AC-3> LONG>
 382         <CALL-GEN .BOUNDS-ATOM 1>                   ;"Check bounds of list cdr"
 383         <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
 384         <EMIT ,INST-TSTL <MA-REG ,AC-1>>
 385         <EMIT-BRANCH ,INST-BNEQ .LOOP-LAB <> ,LAST-INST-LENGTH>
 386                                                       ;"Loop back if in bounds"
 387         <EMIT-BRANCH ,INST-BRB .DONE-LAB <> ,LAST-INST-LENGTH>
 388         <EMIT-LABEL .M-LAB T>
 389         <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-2>>
 390                                                 ;"Pick up pointer to last cell"
 391         <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
 392                                                ;"None, just clean up and leave"
 393         <EMIT ,INST-MOVL <MA-DISP ,AC-3 -4> <MA-DISP ,AC-2 -4>>
 394                                                           ;"Clean up last cell"
 395         <EMIT-LABEL .DONE-LAB T>
 396         <EMIT ,INST-SUBL2 <MA-IMM <* 3 4>> <MA-REG ,AC-TP>>
 397         <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
 398         <EMIT ,INST-MOVL <MA-DISP ,AC-1 -4> <MA-REG ,AC-1>>
 399         <COND (<==? .RES STACK>
 400                <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>)
 401               (T <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
 402         NORMAL>
 403
 404 <DEFINE MARKL-GEN (VAR VAL "AUX" VAC)
 405         #DECL ((VAR) VARTBL (VAL) FIX)
 406         <SET VAC <LOAD-VAR .VAR JUST-VALUE <> PREF-VAL>>
 407         <FINISH-MARK .VAC .VAL>
 408         NORMAL>
 409
 410 <DEFINE IMARKU-GEN (VAR VAL SHIFT "AUX" VAC)
 411         #DECL ((VAR) VARTBL (SHIFT) FIX (VAL) <OR FIX VARTBL>)
 412         <USE-AC <SET VAC <LOAD-VAR .VAR COUNT T PREF-VAL>>>
 413         <COND (<NOT <0? .SHIFT>>
 414                <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .VAC> <MA-REG .VAC>>)>
 415         <EMIT ,INST-ADDL2 <VAR-VALUE-ADDRESS .VAR> <MA-REG .VAC>>
 416         <COND (<0? .SHIFT>
 417                <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG .VAC>>
 418                <EMIT ,INST-BICB2
 419                      <MA-IMM ,ADDR-MASK-2>
 420                      <MA-REG .VAC>>)>
 421         <FINISH-MARK .VAC .VAL>
 422         .VAC>
 423
 424 <DEFINE FINISH-MARK (VAC VAL)
 425         #DECL ((VAC) AC (VAL) <OR FIX VARTBL>)
 426         <COND (<==? .VAL 0>
 427                <EMIT ,INST-BICW2 <MA-WORD-IMM ,MARK-BIT> <MA-DISP .VAC 0>>)
 428               (ELSE
 429                <EMIT ,INST-BISW2 <MA-WORD-IMM ,MARK-BIT> <MA-DISP .VAC 0>>
 430                <COND (<NOT <TYPE? .VAL FIX>>
 431                       <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAL>
 432                             <MA-DISP .VAC 4>>)>)>>
 433
 434 <DEFINE MARKUS-GEN (VAR VAL "OPT" (RES <>))
 435         #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
 436         <IMARKU-GEN .VAR .VAL 0>
 437         NORMAL>
 438
 439 <COND (<GASSIGNED? MARKUS-GEN><SETG MARKUB-GEN ,MARKUS-GEN>)>
 440
 441 <DEFINE MARKUV-GEN (VAR VAL)
 442         #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
 443         <IMARKU-GEN .VAR .VAL 3>
 444         NORMAL>
 445
 446 <DEFINE MARKUU-GEN (VAR VAL)
 447         #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
 448         <IMARKU-GEN .VAR .VAL 2>
 449         NORMAL>
 450
 451 <DEFINE MARKR-GEN (VAR VAL)
 452         #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
 453         <CALL-RTE ,IMARKR!-MIMOP CALL <> <> .VAR .VAL>
 454         NORMAL>
 455
 456 <DEFINE MARKL?-GEN (VAR RES "AUX" VAC)
 457         #DECL ((VAR) VARTBL (RES) <OR VARTBL ATOM>)
 458         <SET VAC <LOAD-VAR .VAR VALUE T PREF-VAL>>
 459         <FINISH-MARK? .VAC .RES>
 460         NORMAL>
 461
 462 <DEFINE FINISH-MARK? (VAC RES
 463                       "OPT" (REL <>) VAR
 464                       "AUX" (TLAB <MAKE-LABEL>) (ELAB <MAKE-LABEL>) NAC ADDR)
 465         #DECL ((VAC) AC)
 466         <EMIT ,INST-TSTB <MA-DISP .VAC 1>>
 467         <GEN-BRANCH ,INST-BLSS .TLAB <> <>>
 468         <EMIT ,INST-CLRL <MA-REG .VAC>>
 469         <COND (.REL
 470                <PROTECT .VAC>
 471                <EMIT ,INST-MOVL <TYPE-CODE FIX>
 472                      <MA-REG <SET NAC <GET-AC PREF-TYPE T>>>>)>
 473         <GEN-BRANCH ,INST-BRB .ELAB <> <>>
 474         <EMIT-LABEL .TLAB <>>
 475         <COND (.REL
 476                <EMIT ,INST-MOVL <SET ADDR <MA-DISP .VAC 4>> <MA-REG .VAC>>
 477                <LOAD-AC .VAC .ADDR>
 478                <PROTECT .VAC>
 479                <EMIT ,INST-MOVL <SET ADDR <VAR-TYPE-ADDRESS .VAR TYPE-WORD>>
 480                           <MA-REG .NAC>>)
 481               (ELSE <EMIT ,INST-MOVL <MA-IMM 1> <MA-REG .VAC>>)>
 482         <EMIT-LABEL .ELAB <>>
 483         <COND (<NOT .REL> <DEST-DECL .VAC .RES FIX>)
 484               (ELSE <DEST-PAIR .VAC .NAC .REL>)>>
 485
 486 <DEFINE IMARKU?-GEN (VAR RES SHIFT REL "AUX" VAC)
 487         #DECL ((VAR) VARTBL (SHIFT) FIX)
 488         <SET VAC <LOAD-VAR .VAR COUNT T PREF-VAL>>
 489         <COND (<NOT <0? .SHIFT>>
 490                <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .VAC>
 491                      <MA-REG .VAC>>)>
 492         <EMIT ,INST-ADDL2 <VAR-VALUE-ADDRESS .VAR> <MA-REG .VAC>>
 493         <COND (<0? .SHIFT>
 494                <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG .VAC>>
 495                <EMIT ,INST-BICB2 <MA-IMM ,ADDR-MASK-2> <MA-REG .VAC>>)>
 496         <FINISH-MARK? .VAC .RES .REL .VAR>
 497         .VAC>
 498
 499 <DEFINE MARKUU?-GEN (VAR RES "OPT" (REL <>))
 500         #DECL ((VAR) VARTBL)
 501         <IMARKU?-GEN .VAR .RES 2 .REL>
 502         NORMAL>
 503
 504 <DEFINE MARKUV?-GEN (VAR RES "OPT" (REL <>))
 505         #DECL ((VAR) VARTBL)
 506         <IMARKU?-GEN .VAR .RES 3 .REL>
 507         NORMAL>
 508
 509 <DEFINE MARKUS?-GEN (VAR RES "OPT" (REL <>))
 510         #DECL ((VAR) VARTBL)
 511         <IMARKU?-GEN .VAR .RES 0 .REL>
 512         NORMAL>
 513
 514 <COND (<GASSIGNED? MARKUS?-GEN><SETG MARKUB?-GEN ,MARKUS?-GEN>)>
 515
 516 <DEFINE MARKR?-GEN (VAR RES "OPT" (REL .RES))
 517         #DECL ((VAR) VARTBL (REL) <OR VARTBL FALSE>)
 518         <CALL-RTE ,IMARKR?!-MIMOP CALL .REL <> .VAR>
 519         NORMAL>
 520
 521 <DEFINE SWNEXT-GEN (VAR GCP RES)
 522         #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
 523         <CALL-RTE ,ISWNEXT!-MIMOP CALL .RES <> .VAR .GCP>
 524         NORMAL>
 525
 526 <DEFINE NEXTS-GEN (VAR RES)
 527         #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
 528         <CALL-RTE ,INEXTS!-MIMOP CALL .RES <> .VAR>
 529         NORMAL>
 530
 531 <DEFINE CONTENTS-GEN (VAR RES
 532                       "AUX" VAC (TAC <>) (TLAB <MAKE-LABEL>)
 533                             (TLAB2 <MAKE-LABEL>) (ELAB <MAKE-LABEL>))
 534         #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
 535         <PROTECT <SET VAC <LOAD-VAR .VAR JUST-VALUE <> PREF-VAL>>>
 536         <EMIT ,INST-MOVQ <MA-DISP .VAC 0>
 537               <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
 538                     (ELSE <SET TAC <GET-AC DOUBLE T>>)>>
 539         <EMIT ,INST-BITW <MA-WORD-IMM ,DOPE-BIT>
 540               <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
 541                     (ELSE <MA-REG .TAC>)>>
 542         <GEN-BRANCH ,INST-BEQL .TLAB2 <> <>>
 543         <EMIT ,INST-BICW2 <MA-WORD-IMM ,DOPE-BIT>
 544               <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
 545                     (ELSE <MA-REG .TAC>)>>
 546         <EMIT ,INST-ADDL3 <MA-IMM 4> <MA-REG .VAC>
 547               <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
 548                     (ELSE <MA-REG <NEXT-AC .TAC>>)>>
 549         <EMIT ,INST-CMPW <TYPE-CODE FRAME WORD>
 550               <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
 551                     (ELSE <MA-REG .TAC>)>>
 552         <GEN-BRANCH ,INST-BEQL .TLAB <> <>>
 553         <EMIT ,INST-CMPW <TYPE-CODE SFRAME WORD>
 554               <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
 555                     (T <MA-REG .TAC>)>>
 556         <GEN-BRANCH ,INST-BNEQ .TLAB2 <> <>>
 557         <EMIT-LABEL .TLAB <>>
 558         <EMIT ,INST-ADDL3 <MA-IMM ,FLEN> <MA-REG .VAC>
 559               <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
 560                     (ELSE <MA-REG <NEXT-AC .TAC>>)>>
 561         <EMIT-LABEL .TLAB2 <>>
 562         <COND (<N==? .RES STACK>
 563                <DEST-PAIR <NEXT-AC .TAC> .TAC .RES>)>
 564         NORMAL>
 565
 566 <DEFINE PUTS-GEN (VAR1 VAR2
 567                   "AUX" VAC (TAC <>) (TLAB <MAKE-LABEL>)
 568                   (ELAB <MAKE-LABEL>) LV)
 569         #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
 570         <PROTECT <SET VAC <LOAD-VAR .VAR1 JUST-VALUE <> PREF-VAL>>>
 571         <EMIT ,INST-BITW <MA-WORD-IMM ,DOPE-BIT> <MA-DISP .VAC 0>>
 572         <GEN-BRANCH ,INST-BNEQ .TLAB <> <>>
 573         <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR2> <MA-DISP .VAC 4>>
 574         <EMIT-LABEL .TLAB <>>
 575         NORMAL>
 576
 577 <DEFINE RELL-GEN (VAR)
 578         #DECL ((VAR) VARTBL)
 579         <CALL-RTE ,IRELL!-MIMOP CALL <> <> .VAR>>
 580
 581 <DEFINE RELU-GEN (VAR)
 582         #DECL ((VAR) VARTBL)
 583         <CALL-RTE ,IRELU!-MIMOP CALL <> <> .VAR>>
 584
 585 <DEFINE RELR-GEN (VAR)
 586         #DECL ((VAR) VARTBL)
 587         <CALL-RTE ,IRELR!-MIMOP CALL <> <> .VAR>>
 588
 589 <DEFINE ALLOCL-GEN (VAR DEST "AUX" VAC)
 590         <SET VAC <LOAD-VAR .VAR JUST-VALUE T PREF-VAL>>
 591         <EMIT ,INST-ADDL2 <MA-IMM 4> <MA-REG .VAC>>
 592         <DEST-DECL .VAC .DEST LIST>>
 593
 594 <DEFINE ALLOCUU-GEN (VAR OLD DEST "OPT" (HINT <>) "AUX" VAC1 VAC2)
 595         <PROTECT <SET VAC1 <LOAD-VAR .OLD TYPE-WORD <> PREF-VAL>>>
 596         <SET VAC2 <LOAD-VAR .VAR VALUE <> PREF-VAL>>
 597         <DEST-PAIR .VAC2 .VAC1 .DEST>>
 598
 599 <COND (<GASSIGNED? ALLOCUU-GEN><SETG ALLOCUV-GEN ,ALLOCUU-GEN>
 600
 601 <SETG ALLOCUS-GEN ,ALLOCUU-GEN>
 602
 603 <SETG ALLOCUB-GEN ,ALLOCUU-GEN>
 604
 605 <SETG ALLOCR-GEN ,ALLOCUU-GEN>)>
 606
 607 <DEFINE BLT-GEN (FROM TO NUMBER "OPT" (HINT <>) "AUX" (VAC <>)
 608                  (LAB <MAKE-LABEL>) (LAB1 <MAKE-LABEL>) VVAC)
 609         <MAPF <> <FUNCTION (X) <MUNG-AC ,.X>>
 610               '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
 611         <COND (<AND <TYPE? .NUMBER FIX>
 612                     <SET NUMBER <* .NUMBER 4>>
 613                     <L=? .NUMBER *177777*>>
 614                <LOAD-VAR .FROM JUST-VALUE T ,AC-1>
 615                <LOAD-VAR .TO JUST-VALUE T ,AC-3>
 616                <EMIT ,INST-MOVC3 <MA-WORD-IMM .NUMBER>
 617                      <MA-REGD ,AC-1>
 618                      <MA-REGD ,AC-3>>)
 619               (T
 620                <SET VAC <MA-REG <GET-AC ,AC-5 T>>>
 621                <SET VVAC <MA-REG <GET-AC ,AC-6 T>>>
 622                <COND (<TYPE? .NUMBER FIX>
 623                       <EMIT ,INST-MOVL <MA-IMM .NUMBER>
 624                             .VVAC>)
 625                      (ELSE
 626                       <EMIT ,INST-ASHL <MA-IMM 2> <VAR-VALUE-ADDRESS .NUMBER>
 627                             .VVAC>)>
 628                <LOAD-VAR .FROM JUST-VALUE T ,AC-1>
 629                <LOAD-VAR .TO JUST-VALUE T ,AC-3>
 630                <EMIT-LABEL .LAB T>
 631                <EMIT-MOVE .VVAC .VAC LONG>
 632                <EMIT ,INST-CMPL .VVAC <MA-IMM *177777*>>
 633                <GEN-BRANCH ,INST-BLSS .LAB1 <>>
 634                <EMIT-MOVE <MA-IMM *177777*> .VAC LONG>
 635                <EMIT-LABEL .LAB1 T>
 636                <EMIT ,INST-MOVC3 .VAC
 637                      <MA-REGD ,AC-1>
 638                      <MA-REGD ,AC-3>>
 639                <EMIT ,INST-SUBL2 <MA-IMM *177777*> .VVAC>
 640                <GEN-BRANCH ,INST-BGTR .LAB <>>)>
 641         NORMAL>
 642
 643 <DEFINE MPAGES-GEN (PGS DEST)
 644         <CALL-RTE ,IMPAGES!-MIMOP CALL .DEST <> .PGS>>