mim/development/mim/vaxc/nrpgen.mud

   1
   2 <DEFINE NTH-LIST-GEN (SVAR NUM RES "OPTIONAL" (HINT <>) "AUX" VAC)
   3         #DECL ((SVAR) <OR VARTBL <PRIMTYPE LIST>> (NUM) <OR FIX VARTBL>
   4                (RES) <OR ATOM VARTBL> (HINT) <OR FALSE HINT>)
   5   <COND (<NTH-LOOK-AHEAD NTHL!-MIMOP .SVAR .NUM .RES .HINT>)
   6         (T
   7          <COND (<==? .NUM 1> <NTH-FIXOFFSET-GEN .SVAR 1 .RES .HINT>)
   8                (<TYPE? .NUM FIX>
   9                 <SET VAC <LIST-REST-CONSTANT-GEN .SVAR <- .NUM 1>>>
  10                 <FINISH-NTH-FIXOFFSET-GEN .VAC 1 .RES .HINT>)
  11                (<TYPE? .NUM VARTBL>
  12                 <SET VAC <LIST-REST-VAR-GEN .SVAR .NUM NTH>>
  13                 <FINISH-NTH-FIXOFFSET-GEN .VAC 1 .RES .HINT>)>
  14          <CLEAR-STATUS>
  15          NORMAL)>>
  16
  17 <DEFINE REST-LIST-GEN (SVAR NUM RES "OPTIONAL" HINT "AUX" VAC)
  18         #DECL ((SVAR) <OR VARTBL <PRIMTYPE LIST>> (NUM) <OR FIX VARTBL>
  19                (RES) <OR VARTBL ATOM>)
  20         <COND (<==? .RES STACK> <EMIT-PUSH <TYPE-WORD LIST> LONG>)>
  21         <COND (<TYPE? .NUM FIX>
  22                <SET VAC <LIST-REST-CONSTANT-GEN .SVAR .NUM .RES>>)
  23               (ELSE <SET VAC <LIST-REST-VAR-GEN .SVAR .NUM REST .RES>>)>
  24         <COND (<N=? .RES STACK> <DEST-DECL .VAC .RES LIST>)>
  25         <CLEAR-STATUS>
  26         NORMAL>
  27
  28 <DEFINE LIST-REST-CONSTANT-GEN (SVAR NUM
  29                                 "OPTIONAL" (RES <>)
  30                                 "AUX" VAC LDISP CAC LABEL VAC1)
  31         #DECL ((SVAR) VARTBL (NUM) FIX (RES) <OR FALSE VARTBL ATOM>)
  32         <COND (<SET VAC <OR <VAR-VALUE-IN-AC? .SVAR>
  33                             <LOAD-VAR .SVAR VALUE <> PREF-VAL>>>
  34                <PROTECT .VAC>
  35                <COND (<AND <TYPE? .RES VARTBL>
  36                            <SET VAC1 <VAR-VALUE-IN-AC? .RES>>>
  37                       ; "If the loser's already in an ac, use that"
  38                       <DEAD-VAR .RES>
  39                       <STORE-AC .VAC1 T>
  40                       <EMIT-MOVE <MA-DISP .VAC ,LIST-NEXT-OFFSET>
  41                                  <MA-REG .VAC1> LONG>
  42                       <UNPROTECT .VAC>
  43                       <SET VAC .VAC1>
  44                       <SET NUM <- .NUM 1>>)
  45                      (<OR <AND <==? .RES STACK> <1? .NUM>>
  46                           <WILL-DIE? .SVAR>>)
  47                      (T
  48                       <SET VAC1 <GET-AC PREF-VAL T>>
  49                       <EMIT-MOVE <MA-DISP .VAC ,LIST-NEXT-OFFSET>
  50                                  <MA-REG .VAC1> LONG>
  51                       <UNPROTECT .VAC>
  52                       <SET VAC .VAC1>
  53                       <SET NUM <- .NUM 1>>)>)>
  54         <PROTECT .VAC>
  55         <SET LDISP <MA-DISP .VAC ,LIST-NEXT-OFFSET>>
  56         <COND (<0? .NUM>)
  57               (<==? .NUM 1>
  58                <COND (<==? .RES STACK> <EMIT-PUSH .LDISP LONG>)
  59                      (<EMIT-MOVE .LDISP <MA-REG .VAC> LONG>)>)
  60               (ELSE
  61                <PROTECT <SET CAC <GET-AC PREF-VAL T>>>
  62                <COND (<==? .RES STACK> <LOAD-CONSTANT .CAC <- .NUM 2>>)
  63                      (ELSE <LOAD-CONSTANT .CAC <- .NUM 1>>)>
  64                <SET LABEL <MAKE-LABEL>>
  65                <EMIT-LABEL .LABEL T>
  66                <EMIT-MOVE .LDISP <MA-REG .VAC> LONG>
  67                <GEN-BRANCH ,INST-SOBGEQ .LABEL <> <MA-REG .CAC>>
  68                <COND (<==? .RES STACK> <EMIT-PUSH .LDISP LONG>)>)>
  69         .VAC>
  70
  71 <DEFINE LIST-REST-VAR-GEN (SVAR NVAR OP
  72                            "OPTIONAL" (RES <>)
  73                            "AUX" (STATUS? <>) VAC CAC SLABEL ELABEL LADDR)
  74         #DECL ((SVAR) <OR VARTBL <PRIMTYPE LIST>> (NVAR) VARTBL (OP) ATOM
  75                (RES) <OR FALSE ATOM VARTBL>)
  76         <PROTECT-VAL .NVAR>
  77         <COND (<TYPE? .SVAR LIST>
  78                <SET VAC <GEN-CONSTANT .SVAR PREF-VAL NONE NONE>>)
  79               (ELSE <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>)>
  80         <PROTECT-USE .VAC>
  81         <COND (<AND <SET CAC <VAR-VALUE-IN-AC? .NVAR>> <AVAILABLE? .CAC>>
  82                <PROTECT-USE .CAC>
  83                <COND (<OR <==? .OP NTH> <==? .RES STACK>>
  84                       <EMIT ,INST-DECL <MA-REG .CAC>>
  85                       <SET STATUS? T>)>)
  86               (ELSE
  87                <PROTECT-USE <SET CAC <GET-AC PREF-VAL T>>>
  88                <COND (<OR <==? .OP NTH> <==? .RES STACK>>
  89                       <EMIT ,INST-SUBL3 <MA-IMM 1> <VAR-VALUE-ADDRESS .NVAR>
  90                             <MA-REG .CAC>>
  91                       <SET STATUS? T>)
  92                      (ELSE
  93                       <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .NVAR>
  94                             <MA-REG .CAC>>
  95                       <SET STATUS? T>)>)>
  96         <COND (<==? .CAC ,STATUS-AC> <SET STATUS? T>)>
  97         <COND (<NOT .STATUS?>
  98                <EMIT ,INST-TSTL <MA-REG .CAC>>)>
  99         <SET ELABEL <MAKE-LABEL>>
 100         <GEN-BRANCH ,INST-BLEQ .ELABEL <>>
 101         <SET SLABEL <MAKE-LABEL>>
 102         <EMIT-LABEL .SLABEL T>
 103         <SET LADDR <MA-DISP .VAC ,LIST-NEXT-OFFSET>>
 104         <EMIT-MOVE .LADDR <MA-REG .VAC> LONG>
 105         <GEN-BRANCH ,INST-SOBGTR .SLABEL <> <MA-REG .CAC>>
 106         <EMIT-LABEL .ELABEL <>>
 107         <COND (<AND <==? .OP REST> <==? .RES STACK>> <EMIT-PUSH .LADDR LONG>)>
 108         .VAC>
 109
 110 <DEFINE FINISH-NTH-FIXOFFSET-GEN (SVAC OFF RES HINT "OPT" (INDXAC <>)
 111                                   "AUX" (TYP <>) RVAC TYPADDR CNTADDR VALADDR
 112                                         DAC)
 113         #DECL ((SVAC) AC (OFF) FIX (RES) <OR VARTBL ATOM>
 114                (HINT) <OR FALSE HINT> (INDXAC) <OR FALSE AC>)
 115         <SET OFF <* <- .OFF 1> 8>>
 116         <SET TYPADDR <MA-DISP .SVAC .OFF>>
 117         <SET CNTADDR <MA-DISP .SVAC <+ .OFF 2>>>
 118         <SET VALADDR <MA-DISP .SVAC <+ .OFF 4>>>
 119         <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
 120         <COND (<AND <==? .RES STACK> <NOT ,GC-MODE>>
 121                <COND (.INDXAC
 122                       <EMIT ,INST-MOVQ <MA-INDX .INDXAC> .TYPADDR
 123                             <MA-AINC ,AC-TP>>)
 124                      (ELSE
 125                       <EMIT ,INST-MOVQ .TYPADDR <MA-AINC ,AC-TP>>)>)
 126               (ELSE
 127                <SET RVAC <GET-AC DOUBLE T>>
 128                <COND (.INDXAC
 129                       <EMIT ,INST-MOVQ <MA-INDX .INDXAC> .TYPADDR
 130                             <MA-REG .RVAC>>)
 131                      (ELSE
 132                       <EMIT ,INST-MOVQ .TYPADDR <MA-REG .RVAC>>)>
 133                <DEST-PAIR <NEXT-AC .RVAC> .RVAC .RES VALUE>)>>
 134
 135 <DEFINE FNTH-DET-VALUE-AC (SVAC TYP)
 136         #DECL ((SVAC) AC (TYP) <OR FALSE ATOM>)
 137         <COND (<AND .TYP <NOT <STRUCTURED-TYPE? .TYP>> <FREE-VALUE-AC? STORED>>
 138                <PROTECT <GET-AC VALUE T>>)
 139               (<ALL-DEAD? .SVAC> .SVAC)
 140               (ELSE
 141                <PROTECT <GET-AC PREF-VAL T>>)>>
 142
 143 <DEFINE NTH-FIXOFFSET-GEN (SVAR OFF RES HINT "AUX" VAC)
 144         #DECL ((SVAR) VARTBL (OFF) FIX (REST) <OR ATOM VARTBL>
 145                (HINT) <OR FALSE HINT>)
 146         <PROTECT <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>>
 147         <FINISH-NTH-FIXOFFSET-GEN .VAC .OFF .RES .HINT>>
 148
 149 <DEFINE NTH-VECTOR-GEN (SVAR OFF RES "OPTIONAL" (HINT <>))
 150   #DECL ((SVAR) <OR VARTBL <PRIMTYPE VECTOR>> (OFF) <OR FIX VARTBL>
 151          (RES) <OR ATOM VARTBL> (HINT) <OR FALSE HINT>)
 152   <COND (<NTH-LOOK-AHEAD NTHUV!-MIMOP .SVAR .OFF .RES .HINT>)
 153         (T
 154          <COND (<TYPE? .OFF FIX> <NTH-FIXOFFSET-GEN .SVAR .OFF .RES .HINT>)
 155                (ELSE <NTH-VECTOR-VAR-GEN .SVAR .OFF .RES .HINT>)>
 156          <CLEAR-STATUS>
 157          NORMAL)>>
 158
 159 <DEFINE NTH-VECTOR-VAR-GEN (SVAR OFF RES HINT "AUX" VAC  DAC)
 160         #DECL ((SVAR) <OR VARTBL <PRIMTYPE VECTOR>> (OFF) VARTBL
 161                (RES) <OR ATOM VARTBL> (HINT) <OR FALSE HINT>)
 162         <SET DAC <LOAD-VAR .OFF VALUE <> PREF-VAL>>
 163         <PROTECT-USE .DAC>
 164         <COND (<NOT <TYPE? .SVAR VARTBL>>
 165                <PROTECT-USE <SET VAC <GET-AC PREF-VAL T>>>
 166                <EMIT ,INST-MOVL <ADDR-VALUE-MQUOTE .SVAR> <MA-REG .VAC>>)
 167               (ELSE
 168                <PROTECT-USE <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>>)>
 169         <FINISH-NTH-FIXOFFSET-GEN .VAC 0 .RES .HINT .DAC>>
 170
 171 <DEFINE REST-VECTOR-GEN (SVAR NUM RES "OPTIONAL" (HINT <>) "AUX" (TYP <>))
 172         #DECL ((SVAR) <OR VARTBL <PRIMTYPE VECTOR>> (NUM) <OR FIX VARTBL>
 173                (RES) <OR VARTBL ATOM>)
 174         <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
 175         <REST-BLOCK-GEN .SVAR .NUM .RES 3 .TYP>>
 176
 177 <DEFINE REST-BYTE-GEN (SVAR NUM RES "OPTIONAL" HINT)
 178         #DECL ((SVAR) <OR VARTBL <PRIMTYPE BYTES>> (NUM) <OR FIX VARTBL>
 179                (RES) <OR VARTBL ATOM>)
 180         <REST-BLOCK-GEN .SVAR .NUM .RES 0 BYTES>>
 181
 182 <DEFINE REST-STRING-GEN (SVAR NUM RES "OPTIONAL" HINT)
 183         #DECL ((SVAR) <OR VARTBL <PRIMTYPE STRING>> (NUM) <OR FIX VARTBL>
 184                (RES) <OR VARTBL ATOM>)
 185         <REST-BLOCK-GEN .SVAR .NUM .RES 0 STRING>>
 186
 187 <DEFINE REST-UVECTOR-GEN (SVAR NUM RES "OPTIONAL" HINT)
 188         #DECL ((SVAR) <OR VARTBL <PRIMTYPE UVECTOR>> (NUM) <OR FIX VARTBL>
 189                (RES) <OR VARTBL ATOM>)
 190         <REST-BLOCK-GEN .SVAR .NUM .RES 2 UVECTOR>>
 191
 192 <MSETG TYP-MASK <PUTBITS -1 <BITS 6 16> 0>>
 193
 194 <MSETG PTYP-MASK <PUTBITS 0 <BITS 3 16> -1>>
 195
 196 <DEFINE REST-BLOCK-GEN (SVAR NUM RES SHFT TYP "OPTIONAL" (INS <>) (ELAC <>)
 197                         (PUT? <>) (TYPE-ADDR <>))
 198         #DECL ((SVAR) ANY (SHFT) FIX (NUM) <OR FIX VARTBL>
 199                (RES) <OR VARTBL ATOM> (TYP) <OR ATOM FALSE>)
 200         <COND (<==? .SVAR .RES>
 201                <COND (<TYPE? .NUM FIX> <FIX-R-B-G-SELF .SVAR .NUM .SHFT .TYP
 202                                                        .INS .ELAC .PUT?
 203                                                        .TYPE-ADDR>)
 204                      (ELSE <R-B-G-SELF .SVAR .NUM .SHFT .TYP>)>)
 205               (<NOT <TYPE? .SVAR VARTBL>>
 206                <R-B-G-Q .SVAR .NUM .RES .SHFT <PRIMTYPE .SVAR>>)
 207               (<TYPE? .NUM FIX> <FIX-R-B-G-OTHER .SVAR .NUM .RES .SHFT .TYP
 208                                                  .INS .ELAC .PUT? .TYPE-ADDR>)
 209               (ELSE <R-B-G .SVAR .NUM .RES .SHFT .TYP>)>
 210         <CLEAR-STATUS>
 211         NORMAL>
 212
 213 <DEFINE FIX-R-B-G-SELF (SVAR NUM SHFT TYP INS ELAC PUT? TYPE-ADDR
 214                         "AUX" (VAC <>) (TAC <>) (CAC <>) LV)
 215         #DECL ((NUM SHFT) FIX (SVAR) VARTBL (TYP) <OR ATOM FALSE>)
 216         <COND (<SET LV <FIND-CACHE-VAR .SVAR>>
 217                <COND (<SET VAC <LINKVAR-VALUE-AC .LV>>
 218                       <PROTECT .VAC>)>
 219                <COND (<NOT <SET TAC <LINKVAR-TYPE-WORD-AC .LV>>>
 220                       <COND (<AND <NOT <LINKVAR-COUNT-STORED .LV>>
 221                                   <SET CAC <LINKVAR-COUNT-AC .LV>>>
 222                              <PROTECT .CAC>)>)
 223                      (T
 224                       <PROTECT .TAC>)>)>
 225         <DEAD-VAR .SVAR>
 226         <COND (.VAC <MUNG-AC .VAC>)>
 227         <COND (.TAC <MUNG-AC .TAC>)
 228               (.CAC <MUNG-AC .CAC>)>
 229         <COND (.INS
 230                <COND (<NOT .VAC>
 231                       <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>)>)>
 232         <COND (.TAC
 233                <EMIT ,INST-ADDL2
 234                      <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
 235                      <MA-REG .TAC>>)
 236               (.CAC
 237                <COND (<==? .NUM 1> <EMIT ,INST-DECL <MA-REG .CAC>>)
 238                      (ELSE <EMIT ,INST-SUBL2 <MA-IMM .NUM> <MA-REG .CAC>>)>)
 239               (ELSE
 240                <COND (<==? .NUM 1> <EMIT ,INST-DECW <VAR-COUNT-ADDRESS .SVAR>>)
 241                      (ELSE
 242                       <EMIT ,INST-SUBW2
 243                             <MA-IMM .NUM>
 244                             <VAR-COUNT-ADDRESS .SVAR>>)>)>
 245         <SET NUM <SHIFT-NUM .NUM .SHFT>>
 246         <COND (.INS
 247                <COND (<TYPE? .INS ATOM>)
 248                      (.PUT?
 249                       <COND
 250                        (.TYPE-ADDR
 251                         ; "Can happen putting into a vector"
 252                         <EMIT ,INST-MOVL .TYPE-ADDR <MA-AINC .VAC>>
 253                         <EMIT ,INST-MOVL <COND (<TYPE? .ELAC AC> <MA-REG .ELAC>)
 254                                                (.ELAC)>
 255                               <MA-AINC .VAC>>)
 256                        (T
 257                         <EMIT .INS <COND (<TYPE? .ELAC AC> <MA-REG .ELAC>)
 258                                          (.ELAC)>
 259                               <MA-AINC .VAC>>)>)
 260                      (<EMIT .INS <MA-AINC .VAC> <COND (<TYPE? .ELAC AC>
 261                                                        <MA-REG .ELAC>)
 262                                                       (.ELAC)>>)>)
 263               (<==? .NUM 1>
 264                <EMIT ,INST-INCL
 265                      <COND (.VAC <MA-REG .VAC>)
 266                            (ELSE <VAR-VALUE-ADDRESS .SVAR>)>>)
 267               (ELSE
 268                <EMIT ,INST-ADDL2
 269                      <MA-IMM .NUM>
 270                      <COND (.VAC <MA-REG .VAC>)
 271                            (ELSE <VAR-VALUE-ADDRESS .SVAR>)>>)>
 272         <COND (.VAC
 273                <DEST-DECL .VAC .SVAR .TYP>)>
 274         <COND (.TAC
 275                <COND (.VAC <DEST-PAIR .VAC .TAC .SVAR>)
 276                      (T <LINK-VAR-TO-AC .SVAR .TAC TYPE-WORD>)>)
 277               (.CAC
 278                <COND (.VAC <DEST-COUNT-DECL .VAC .CAC .SVAR .TYP>)
 279                      (T
 280                       <LINK-VAR-TO-AC .SVAR .CAC COUNT>
 281                       <INDICATE-CACHED-VARIABLE-DECL .SVAR .TYP>)>)>
 282         T>
 283
 284 <DEFINE FIX-R-B-G-OTHER (SVAR NUM RES SHFT TYP INS ELAC PUT? TYPE-ADDR
 285                          "AUX" (VAC <>) (CAC <>) LV (CN <>))
 286         #DECL ((NUM SHFT) FIX (SVAR) VARTBL (TYP) <OR ATOM FALSE>)
 287         <COND (.INS
 288                <COND (<NOT <SET VAC <VAR-VALUE-IN-AC? .SVAR>>>
 289                       <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>)>)>
 290         <SET LV <FIND-CACHE-VAR .SVAR>>
 291         <COND (<AND .LV <SET CAC <LINKVAR-TYPE-WORD-AC .LV>>>
 292                <COND (<TYPE? .RES VARTBL>
 293                       <MUNG-AC .CAC>
 294                       <PROTECT .CAC>
 295                       <EMIT ,INST-ADDL2
 296                             <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
 297                             <MA-REG .CAC>>)
 298                      (ELSE
 299                       <EMIT ,INST-ADDL3
 300                             <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
 301                             <MA-REG .CAC>
 302                             <MA-AINC ,AC-TP>>)>)
 303               (<AND .LV <SET CAC <LINKVAR-COUNT-AC .LV>>
 304                     <NOT <LINKVAR-COUNT-STORED .LV>> .TYP>
 305                <SET CN T>
 306                <COND (<TYPE? .RES VARTBL>
 307                       <MUNG-AC .CAC>
 308                       <PROTECT .CAC>
 309                       <COND (<==? .NUM 1> <EMIT ,INST-DECL <MA-REG .CAC>>)
 310                             (ELSE
 311                              <EMIT ,INST-SUBL2 <MA-IMM .NUM> <MA-REG .CAC>>)>)
 312                      (ELSE
 313                       <EMIT-PUSH <TYPE-CODE .TYP> WORD>
 314                       <EMIT ,INST-SUBW3
 315                             <MA-IMM .NUM>
 316                             <MA-REG .CAC>
 317                             <MA-AINC ,AC-TP>>)>)
 318               (ELSE
 319                <COND (.CAC <MUNG-AC .CAC> <SET LV <FIND-CACHE-VAR .SVAR>>)>
 320                <COND (<==? .RES STACK>)
 321                      (<AND .LV <LINKVAR-VALUE-AC .LV>>
 322                       <SET CAC <GET-AC PREF-TYPE T>>)
 323                      (ELSE
 324                       <SET CAC <GET-AC DOUBLE T>>
 325                       <SET VAC <NEXT-AC .CAC>>)>
 326                <EMIT ,INST-ADDL3
 327                      <MA-IMM <CHTYPE <LSH <- .NUM> 16> FIX>>
 328                      <VAR-TYPE-ADDRESS .SVAR TYPE-WORD>
 329                      <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
 330                            (ELSE <MA-REG .CAC>)>>)>
 331         <SET NUM <SHIFT-NUM .NUM .SHFT>>
 332         <COND (.INS
 333                <COND (<NOT <TYPE? .INS ATOM>>
 334                       <COND (.PUT?
 335                              <COND (.TYPE-ADDR
 336                                     <EMIT ,INST-MOVL .TYPE-ADDR <MA-AINC .VAC>>
 337                                     <EMIT ,INST-MOVL <COND (<TYPE? .ELAC AC>
 338                                                             <MA-REG .ELAC>)
 339                                                            (.ELAC)>
 340                                           <MA-AINC .VAC>>)
 341                                    (T
 342                                     <EMIT .INS <COND (<TYPE? .ELAC AC>
 343                                                       <MA-REG .ELAC>)
 344                                                      (.ELAC)>
 345                                           <MA-AINC .VAC>>)>)
 346                             (T
 347                              <EMIT .INS <MA-AINC .VAC> <COND (<TYPE? .ELAC AC>
 348                                                               <MA-REG .ELAC>)
 349                                                              (.ELAC)>>)>)>)
 350               (<==? .RES STACK>
 351                <COND (<SET VAC <VAR-VALUE-IN-AC? .SVAR>>
 352                       <EMIT ,INST-MOVAL <MA-DISP .VAC .NUM> <MA-AINC ,AC-TP>>)
 353                      (T
 354                       <EMIT ,INST-ADDL3
 355                             <MA-IMM .NUM>
 356                             <VAR-VALUE-ADDRESS .SVAR>
 357                             <MA-AINC ,AC-TP>>)>)
 358               (<AND .LV <SET VAC <LINKVAR-VALUE-AC .LV>>>
 359                <MUNG-AC .VAC>
 360                <COND (<==? .NUM 1> <EMIT ,INST-INCL <MA-REG .VAC>>)
 361                      (ELSE <EMIT ,INST-ADDL2 <MA-IMM .NUM> <MA-REG .VAC>>)>)
 362               (ELSE
 363                <COND (<VAR-VALUE-IN-AC? .SVAR>
 364                       <EMIT ,INST-MOVAL <MA-DISP <VAR-VALUE-IN-AC? .SVAR> .NUM>
 365                             <MA-REG <COND (.VAC)
 366                                           (T <SET VAC <GET-AC PREF-VAL T>>)>>>)
 367                      (T
 368                       <EMIT ,INST-ADDL3
 369                             <MA-IMM .NUM>
 370                             <VAR-VALUE-ADDRESS .SVAR>
 371                             <MA-REG <COND (.VAC)
 372                                           (ELSE <SET VAC
 373                                                      <GET-AC PREF-VAL T>>)>>>)>)>
 374         <COND (<N==? .RES STACK>
 375                <COND (<NOT .CN> <DEST-PAIR .VAC .CAC .RES>)
 376                      (ELSE <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)>)>>
 377
 378 <DEFINE R-B-G-SELF (SVAR NUM SHFT TYP "AUX" (VAC <>) (TAC <>) (CAC <>)
 379                     LV (NAC <>) (COUNT-STORED? <>))
 380         #DECL ((SHFT) FIX (NUM SVAR) VARTBL (TYP) <OR ATOM FALSE>)
 381         <COND (<SET LV <FIND-CACHE-VAR .SVAR>>
 382                <COND (<SET VAC <LINKVAR-VALUE-AC .LV>>
 383                       <PROTECT .VAC>)>
 384                <COND (<NOT <SET TAC <LINKVAR-TYPE-WORD-AC .LV>>>
 385                       <COND (<AND <NOT <LINKVAR-COUNT-STORED .LV>>
 386                                   <SET CAC <LINKVAR-COUNT-AC .LV>>>
 387                              <PROTECT .CAC>)>)
 388                      (T
 389                       <MUNG-AC .TAC>)>)>
 390         <DEAD-VAR .SVAR>
 391         <COND (.VAC <MUNG-AC .VAC>)>
 392         <COND (.TAC)
 393               (.CAC <MUNG-AC .CAC>)>
 394         <COND (<NOT <0? .SHFT>> <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>)>
 395         <COND (.TAC
 396                <SET TAC <>>
 397                <EMIT ,INST-SUBW2
 398                      <VAR-VALUE-ADDRESS .NUM>
 399                      <VAR-COUNT-ADDRESS .SVAR>>
 400                <SET COUNT-STORED? T>)
 401               (.CAC
 402                <EMIT ,INST-SUBL2 <VAR-VALUE-ADDRESS .NUM> <MA-REG .CAC>>)
 403               (ELSE
 404                <SET COUNT-STORED? T>
 405                <EMIT ,INST-SUBW2
 406                      <VAR-VALUE-ADDRESS .NUM>
 407                      <VAR-COUNT-ADDRESS .SVAR>>)>
 408         <COND (<AND <NOT .VAC> <NOT <0? .SHFT>>>
 409                <SET VAC <LOAD-VAR .SVAR JUST-VALUE <> PREF-VAL>>)>
 410         <COND (<0? .SHFT>
 411                <EMIT ,INST-ADDL2
 412                      <VAR-VALUE-ADDRESS .NUM>
 413                      <COND (.VAC <MA-REG .VAC>)
 414                            (ELSE <VAR-VALUE-ADDRESS .SVAR>)>>)
 415               (<==? .SHFT 2>
 416                <EMIT ,INST-MOVAL <MA-INDX .NAC> <MA-REGD .VAC> <MA-REG .VAC>>)
 417               (ELSE
 418                <EMIT ,INST-MOVAQ
 419                      <MA-INDX .NAC>
 420                      <MA-REGD .VAC>
 421                      <MA-REG .VAC>>)>
 422         <COND (.VAC
 423                <DEST-DECL .VAC .SVAR .TYP>)>
 424         <COND (.CAC
 425                <COND (.VAC <DEST-COUNT-DECL .VAC .CAC .SVAR .TYP>)
 426                      (T
 427                       <LINK-VAR-TO-AC .SVAR .CAC COUNT <>>
 428                       <INDICATE-CACHED-VARIABLE-DECL .SVAR .TYP>)>)>
 429         <SET LV <FIND-CACHE-VAR .SVAR>>
 430         <LINKVAR-TYPE-STORED .LV T>
 431         <LINKVAR-COUNT-STORED .LV .COUNT-STORED?>>
 432
 433 <DEFINE R-B-G (SVAR NUM RES SHFT TYP
 434                "AUX" (VAC <>) (CAC <>) LV (CN <>) (NAC <>)
 435                      (FORCE-CHTYPE? <>))
 436         #DECL ((SHFT) FIX (NUM SVAR) VARTBL (TYP) <OR ATOM FALSE>)
 437         <SET LV <FIND-CACHE-VAR .SVAR>>
 438         <COND (<NOT <0? .SHFT>>
 439                <PROTECT <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>>)>
 440         <COND (<AND .LV <SET CAC <LINKVAR-TYPE-WORD-AC .LV>>>
 441                ; "Structure has type word in AC"
 442                <COND (<TYPE? .RES VARTBL>
 443                       <COND (<AND .TYP <N==? <VARTBL-DECL .RES> .TYP>>
 444                              <SET FORCE-CHTYPE? T>)>
 445                       <MUNG-AC .CAC>
 446                       ; "Clobber type word, so COUNT-ADDRESS returns winnage"
 447                       <SET CAC <>>
 448                       <EMIT ,INST-SUBW3
 449                             <VAR-VALUE-ADDRESS .NUM>
 450                             <VAR-COUNT-ADDRESS .SVAR>
 451                             <VAR-COUNT-ADDRESS .RES T>>)
 452                      (ELSE
 453                       <EMIT-PUSH <MA-REG .CAC> LONG>
 454                       ; "Recycle type word AC onto stack"
 455                       <EMIT ,INST-SUBW2
 456                             <VAR-VALUE-ADDRESS .NUM>
 457                             <MA-DISP ,AC-TP -2>>)>)
 458               (<AND .LV <SET CAC <LINKVAR-COUNT-AC .LV>> .TYP>
 459                ; "Structure has count in AC, so winnage is possible"
 460                <SET CN T>
 461                <COND (<TYPE? .RES VARTBL>
 462                       <MUNG-AC .CAC>
 463                       <PROTECT .CAC>
 464                       <EMIT ,INST-SUBL2
 465                             <VAR-VALUE-ADDRESS .NUM>
 466                             <MA-REG .CAC>>)
 467                      (ELSE
 468                       <EMIT-PUSH <TYPE-CODE .TYP> WORD>
 469                       <EMIT ,INST-SUBW3
 470                             <VARTBL-VALUE-ADDRESS .NUM>
 471                             <MA-REG .CAC>
 472                             <MA-AINC ,AC-TP>>)>)
 473               (ELSE
 474                <COND (.CAC
 475                       ; "Will hit this if type is unknown"
 476                       <MUNG-AC .CAC>
 477                       <SET LV <FIND-CACHE-VAR .SVAR>>)>
 478                <COND (<==? .RES STACK>)
 479                      (ELSE
 480                       ; "Get an AC for the result"
 481                       <SET CAC <GET-AC PREF-TYPE T>>
 482                       <PROTECT .CAC>
 483                       <EMIT ,INST-CLRL <MA-REG .CAC>>)>
 484                <COND (<==? .RES STACK>
 485                       <COND (.TYP <EMIT-PUSH <TYPE-CODE .TYP> WORD>)
 486                             (ELSE <EMIT ,INST-CLRW <MA-AINC ,AC-TP>>)>
 487                       <EMIT ,INST-SUBW3
 488                             <VAR-VALUE-ADDRESS .NUM>
 489                             <VAR-COUNT-ADDRESS .SVAR>
 490                             <MA-AINC ,AC-TP>>)
 491                      (ELSE
 492                       <EMIT ,INST-SUBW3
 493                             <VAR-VALUE-ADDRESS .NUM>
 494                             <VAR-COUNT-ADDRESS .SVAR>
 495                             <MA-REG .CAC>>
 496                       <COND (<NOT .TYP>
 497                              <EMIT ,INST-ASHL
 498                                    <MA-IMM 16>
 499                                    <MA-REG .CAC>
 500                                    <MA-REG .CAC>>)
 501                             (ELSE <SET CN T>)>)>)>
 502         <COND (<0? .SHFT>
 503                <COND (<AND <N==? .RES STACK>
 504                            .LV
 505                            <SET VAC <LINKVAR-VALUE-AC .LV>>>
 506                       <MUNG-AC .VAC>
 507                       <EMIT ,INST-ADDL2
 508                             <VAR-VALUE-ADDRESS .NUM>
 509                             <MA-REG .VAC>>)
 510                      (<N==? .RES STACK>
 511                       <EMIT ,INST-ADDL3
 512                             <VAR-VALUE-ADDRESS .NUM>
 513                             <VAR-VALUE-ADDRESS .SVAR>
 514                             <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>)
 515                      (ELSE
 516                       <EMIT ,INST-ADDL3
 517                             <VAR-VALUE-ADDRESS .NUM>
 518                             <VAR-VALUE-ADDRESS .SVAR>
 519                             <MA-AINC ,AC-TP>>)>)
 520               (ELSE
 521                <SET VAC <LOAD-VAR .SVAR JUST-VALUE <N==? .RES STACK> PREF-VAL>>
 522                <COND (<==? .SHFT 2>
 523                       <EMIT ,INST-MOVAL
 524                             <MA-INDX .NAC>
 525                             <MA-REGD .VAC>
 526                             <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
 527                                   (ELSE <MA-REG .VAC>)>>)
 528                      (ELSE
 529                       <EMIT ,INST-MOVAQ
 530                             <MA-INDX .NAC>
 531                             <MA-REGD .VAC>
 532                             <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
 533                                   (ELSE <MA-REG .VAC>)>>)>)>
 534         <COND (<OR <NOT .TYP> .FORCE-CHTYPE?
 535                    <AND <N==? .TYP <VARTBL-DECL .SVAR>> <NOT .CN>>>
 536                <DO-TYPE-CHANGE
 537                 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
 538                       (.CAC <MA-REG .CAC>)
 539                       (ELSE <VAR-TYPE-ADDRESS .RES>)>
 540                 <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
 541                       (ELSE <MA-REG .VAC>)>
 542                 .TYP
 543                 .SHFT>
 544                <COND (<N==? .RES STACK>
 545                       <COND (.CAC <DEST-PAIR .VAC .CAC .RES>)
 546                             (ELSE
 547                              <DEAD-VAR .RES>
 548                              <LINK-VAR-TO-AC .RES .VAC VALUE <>>
 549                              <SET LV <FIND-CACHE-VAR .RES>>
 550                              <PUT .LV ,LINKVAR-COUNT-STORED T>
 551                              <PUT .LV ,LINKVAR-TYPE-STORED T>
 552                              <PUT .LV ,LINKVAR-TYPE-AC <>>
 553                              <PUT .LV ,LINKVAR-COUNT-AC <>>
 554                              <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)>)>)
 555               (<N==? .RES STACK>
 556                <COND (<NOT .CN>
 557                       <COND (.CAC <DEST-PAIR .VAC .CAC .RES>)
 558                             (ELSE
 559                              <DEAD-VAR .RES>
 560                              <LINK-VAR-TO-AC .RES .VAC VALUE <>>
 561                              <SET LV <FIND-CACHE-VAR .RES>>
 562                              <PUT .LV ,LINKVAR-COUNT-STORED T>
 563                              <PUT .LV ,LINKVAR-TYPE-STORED T>
 564                              <PUT .LV ,LINKVAR-TYPE-AC <>>
 565                              <PUT .LV ,LINKVAR-COUNT-AC <>>
 566                              <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)>)
 567                      (ELSE <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)>)>>
 568
 569 <DEFINE R-B-G-Q (SVAR NUM RES SHFT TYP "AUX" NAC VAC CAC)
 570         #DECL ((NUM) VARTBL (SHFT) FIX (TYP) ATOM)
 571         <COND (<==? .RES STACK>
 572                <EMIT-PUSH <TYPE-CODE <PRIMTYPE .SVAR>> WORD>
 573                <EMIT ,INST-SUBW3
 574                      <VAR-VALUE-ADDRESS .NUM>
 575                      <MA-IMM <LENGTH .SVAR>>
 576                      <MA-AINC ,AC-TP>>)
 577               (ELSE
 578                <EMIT ,INST-SUBL3 <VAR-VALUE-ADDRESS .NUM>
 579                      <MA-IMM <LENGTH .SVAR>>
 580                      <MA-REG <SET CAC <GET-AC DOUBLE T>>>>)>
 581         <COND (.CAC <SET VAC <NEXT-AC .CAC>>)>
 582         <COND (<0? .SHFT>
 583                <EMIT ,INST-ADDL3 <VAR-VALUE-ADDRESS .NUM>
 584                      <ADDR-VALUE-M <ADD-MVEC .SVAR>>
 585                      <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
 586                            (ELSE .VAC)>>)
 587               (ELSE
 588                <EMIT ,INST-MOVL <ADDR-VALUE-M <ADD-MVEC .SVAR>>
 589                      <COND (.VAC) (ELSE <SET VAC <GET-AC PREF-VAL T>>)>>
 590                <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>
 591                <EMIT <COND (<==? .SHFT 2> ,INST-MOVAL)
 592                            (ELSE ,INST-MOVAQ)>
 593                      <MA-INDX .NAC>
 594                      <MA-REGD .VAC>
 595                      <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
 596                            (ELSE <MA-REG .VAC>)>>)>
 597         <COND (<N==? .RES STACK>
 598                <DEST-COUNT-DECL .VAC .CAC .RES <PRIMTYPE .SVAR>>)>>
 599
 600
 601 <DEFINE DO-TYPE-CHANGE (TADDR VADDR TYP SHFT "AUX" T1)
 602         <COND (.TYP <EMIT ,INST-MOVW <TYPE-CODE .TYP> .TADDR>)
 603               (ELSE
 604                <EMIT-MOVE <TYPE-CODE VECTOR> .TADDR WORD>
 605                <GEN-COMP-INST .VADDR <MA-REG ,AC-TP> LONG>
 606                <SET T1 <MAKE-LABEL>>
 607                <GEN-BRANCH ,INST-BGTR .T1 <>>
 608                <EMIT-MOVE <TYPE-CODE TUPLE> .TADDR WORD>
 609                <EMIT-LABEL .T1 <>>)>>
 610
 611 <DEFINE SHIFT-NUM (NUM SHFT)
 612         #DECL ((NUM SHFT) FIX)
 613         <COND (<0? .SHFT> .NUM)
 614               (<==? .SHFT 2> <* .NUM 4>)
 615               (ELSE <* .NUM 8>)>>
 616
 617 <DEFINE LIST-LENGTH-GEN (SVAR RES "OPTIONAL" HINT "AUX" VAC CAC SLABEL ELABEL)
 618         #DECL ((SVAR) VARTBL (RES) <OR ATOM VARTBL>)
 619         <AND <SET VAC <VAR-VALUE-IN-AC? .SVAR>> <PROTECT .VAC>>
 620         <SET CAC <GET-AC PREF-VAL T>>
 621         <EMIT ,INST-CLRL <MA-REG .CAC>>
 622         <PROTECT .CAC>
 623         <SET VAC <LOAD-VAR .SVAR VALUE T PREF-VAL>>
 624         <PROTECT-USE .VAC>
 625         <SET SLABEL <MAKE-LABEL>>
 626         <SET ELABEL <MAKE-LABEL>>
 627         <COND (<N==? .VAC ,STATUS-AC> <EMIT ,INST-TSTL <MA-REG .VAC>>)>
 628         <GEN-BRANCH ,INST-BEQL .ELABEL <>>
 629         <EMIT-LABEL .SLABEL T>
 630         <EMIT ,INST-INCL <MA-REG .CAC>>
 631         <EMIT-MOVE <MA-DISP .VAC ,LIST-NEXT-OFFSET> <MA-REG .VAC> LONG>
 632         <GEN-BRANCH ,INST-BNEQ .SLABEL <>>
 633         <EMIT-LABEL .ELABEL <>>
 634         <DEST-DECL .CAC .RES FIX>
 635         <CLEAR-STATUS>
 636         NORMAL>
 637
 638 <DEFINE BLOCK-LENGTH-GEN (SVAR RES "OPTIONAL" HINT HINT2 "AUX" VAC AC LV)
 639         #DECL ((SVAR) ANY (RES) <OR ATOM VARTBL>)
 640         <COND (<NOT <TYPE? .SVAR VARTBL>>
 641                <COND (<==? .RES STACK>
 642                       <PUSH-CONSTANT <LENGTH .SVAR>>)
 643                      (T
 644                       <SET VAC <GET-AC PREF-VAL T>>
 645                       <COND (<EMPTY? .SVAR>
 646                              <EMIT ,INST-CLRL <MA-REG .VAC>>)
 647                             (T
 648                              <EMIT ,INST-MOVL <MA-IMM <LENGTH .SVAR>>
 649                                    <MA-REG .VAC>>)>
 650                       <DEST-DECL .VAC .RES FIX>)>)
 651               (<==? .RES STACK>
 652                <EMIT-PUSH <TYPE-CODE FIX> LONG>
 653                <COND (<AND <SET LV <FIND-CACHE-VAR .SVAR>>
 654                            <NOT <LINKVAR-COUNT-STORED .LV>>>
 655                       <SET VAC <LOAD-VAR .SVAR COUNT T PREF-VAL>>
 656                       <EMIT-PUSH <MA-REG .VAC> LONG>)
 657                      (T
 658                       <EMIT ,INST-MOVZWL
 659                             <ADDR-VAR-COUNT .SVAR> <MA-AINC ,AC-TP>>)>)
 660                 (T
 661                <COND (<AND <SET LV <FIND-CACHE-VAR .SVAR>>
 662                            <NOT <LINKVAR-COUNT-STORED .LV>>>
 663                       <PROTECT <SET VAC <LOAD-VAR .SVAR COUNT T PREF-VAL>>>)
 664                      (ELSE
 665                       <SET VAC <GET-AC PREF-VAL T>>
 666                       <EMIT ,INST-MOVZWL <ADDR-VAR-COUNT .SVAR>
 667                             <MA-REG .VAC>>)>
 668                <DEST-DECL .VAC .RES FIX>)>
 669                NORMAL>
 670
 671 <DEFINE LIST-EMP-GEN (SVAR DIR LABEL "OPTIONAL" HINT "AUX" CC STATUS? VAC LAC)
 672         #DECL ((SVAR) VARTBL (DIR LABEL) ATOM)
 673         <COND (<NOT <AND <SET VAC <VAR-VALUE-IN-AC? .SVAR>>
 674                          <==? .VAC ,STATUS-AC>>>
 675                <EMIT ,INST-TSTL <VAR-VALUE-ADDRESS .SVAR>>)>
 676         <COND (<==? .DIR +> <SET CC ,COND-CODE-EQ>)
 677               (ELSE <SET CC ,COND-CODE-NE>)>
 678         <GEN-BRANCH <NTH ,BRANCHES <+ .CC 1>> .LABEL <> <>>
 679         <CLEAR-STATUS>
 680         NORMAL>
 681
 682 <DEFINE BLOCK-EMP-GEN (SVAR DIR LABEL "OPTIONAL" HINT)
 683         #DECL ((DIR LABEL) ATOM)
 684         <COND (<TYPE? .SVAR VARTBL>
 685                <ZERO-COUNT-TEST-GEN .SVAR .DIR .LABEL>
 686                <CLEAR-STATUS>)
 687               (<OR <TYPE? .SVAR ATOM> <NOT <EMPTY? .SVAR>>>
 688                <COND (<==? .DIR ->
 689                       <GEN-BRANCH ,INST-BBR .LABEL <>>)>)
 690               (<==? .DIR +>
 691                <GEN-BRANCH ,INST-BBR .LABEL <>>)>
 692         NORMAL>
 693
 694 <DEFINE ZERO-COUNT-TEST-GEN (VAR DIR LABEL
 695                              "AUX" STATUS? VADDR VAC LVAR (USE-CMP <>))
 696         #DECL ((VAR) VARTBL (DIR) ATOM (LABEL) ATOM)
 697         <COND (<OR <NOT <SET LVAR <FIND-CACHE-VAR .VAR>>>
 698                    <LINKVAR-COUNT-STORED .LVAR>>
 699                <SET VADDR <VAR-COUNT-ADDRESS .VAR>>)
 700               (<SET VAC <LINKVAR-COUNT-AC .LVAR>>
 701                <SET VADDR <MA-REG .VAC>>)
 702               (<SET VAC <LINKVAR-TYPE-WORD-AC .LVAR>>
 703                <SET VADDR <MA-REG .VAC>>
 704                <SET USE-CMP T>)
 705               (T
 706                <SET VADDR <VAR-COUNT-ADDRESS .VAR>>)>
 707         <COND (<NOT <SET STATUS? <STATUS? .VAR COUNT>>>
 708                <COND (.USE-CMP
 709                       <EMIT ,INST-CMPL .VADDR <MA-IMM *177777*>>)
 710                      (ELSE <EMIT ,INST-TSTW .VADDR>)>)
 711               (ELSE <SET USE-CMP <>>)>
 712         <COND (<==? .DIR +> <GEN-BRANCH ,INST-BLEQU .LABEL <>>)
 713               (ELSE <GEN-BRANCH ,INST-BGTRU .LABEL <>>)>>
 714
 715 <DEFINE PUTREST-GEN (VAL1 VAL2 "AUX" VAC OFF NADDR)
 716         #DECL ((VAL1) VARTBL (VAL2) <OR <PRIMTYPE LIST> VARTBL>)
 717         <PROTECT <SET VAC <LOAD-VAR .VAL1 VALUE <> PREF-VAL>>>
 718         <SET NADDR <MA-DISP .VAC ,LIST-NEXT-OFFSET>>
 719         <COND (<TYPE? .VAL2 LIST>
 720                <COND (<EMPTY? .VAL2> <EMIT ,INST-CLRL .NADDR>)
 721                      (ELSE
 722                       <SET OFF <ADD-MVEC .VAL2>>
 723                       <EMIT ,INST-MOVL <ADDR-VALUE-M .OFF> .NADDR>)>)
 724               (<EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAL2> .NADDR>)>
 725         <CLEAR-STATUS>
 726         NORMAL>
 727
 728 <DEFINE PUT-LIST-GEN (VAR OFF VAL "OPTIONAL" (HINT <>) "AUX" VAC)
 729         #DECL ((VAR) VARTBL (OFF) <OR FIX VARTBL> (VAL) ANY)
 730         <COND (.HINT <SET HINT <PARSE-HINT .HINT TYPE>>)>
 731         <PROTECT-VAL .VAL>
 732         <COND (<==? .OFF 1> <SLOT-CLOBBER .VAR 1 .VAL <> .HINT>)
 733               (<TYPE? .OFF FIX>
 734                <SET VAC <LIST-REST-CONSTANT-GEN .VAR <- .OFF 1>>>
 735                <FINISH-SLOT-CLOBBER .VAC 1 .VAL <> .HINT>)
 736               (ELSE
 737                <SET VAC <LIST-REST-VAR-GEN .VAR .OFF NTH>>
 738                <FINISH-SLOT-CLOBBER .VAC 1 .VAL <> .HINT>)>
 739         <CLEAR-STATUS>
 740         NORMAL>
 741
 742 <DEFINE SLOT-CLOBBER (VAR OFF VAL UVC HINT "AUX" VAC ROFF)
 743         #DECL ((VAR) VARTBL (OFF) FIX (VAL) ANY (UVC) BOOLEAN)
 744         <PROTECT <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>>
 745         <FINISH-SLOT-CLOBBER .VAC .OFF .VAL .UVC .HINT>>
 746
 747 <DEFINE FINISH-SLOT-CLOBBER (VAC OFF VAL UVC HINT
 748                              "OPT" (INDXAC <>)
 749                              "AUX" DTADDR DVADDR DCADDR ROFF
 750                                    (KLUDGE
 751                                     <TUPLE <COND (.INDXAC <MA-INDX .INDXAC>)
 752                                                  (ELSE <>)>>) LAC GAC DCL
 753                                    FX? LVAR (DONE? <>))
 754         #DECL ((VAC) AC (OFF) FIX (VAL) ANY (UVC) BOOLEAN
 755                (INDXAC) <OR AC FALSE> (KLUDGE) TUPLE (LAC GAC) <OR AC FALSE>
 756                (LVAR) <OR FALSE LINKVAR>)
 757         <COND (.INDXAC <PROTECT .INDXAC>) (ELSE <SET KLUDGE <REST .KLUDGE>>)>
 758         <COND (.UVC <SET ROFF <* <- .OFF 1> 4>>)
 759               (ELSE <SET ROFF <* <- .OFF 1> 8>>)>
 760         <PROTECT .VAC>
 761         <COND (<NOT <TYPE? .VAL VARTBL>>
 762                <COND (<SET FX? <FIX-CONSTANT? .VAL>>
 763                       <COND (.UVC
 764                              <COND (<0? .FX?>
 765                                     <EMIT ,INST-CLRL
 766                                           !.KLUDGE
 767                                           <MA-DISP .VAC .ROFF>>)
 768                                    (<AND <L? .FX? 0>
 769                                          <G? .FX? -64>>
 770                                     ; "Lets us use literal"
 771                                     <EMIT ,INST-MNEGL
 772                                           <MA-IMM <- .FX?>>
 773                                           !.KLUDGE <MA-DISP .VAC .ROFF>>)
 774                                    (<EMPTY? .KLUDGE>
 775                                     <EMIT-MOVE <MA-IMM .FX?> <MA-DISP .VAC .ROFF>
 776                                                LONG>)
 777                                    (ELSE
 778                                     <EMIT ,INST-MOVL
 779                                           <MA-IMM .FX?>
 780                                           !.KLUDGE
 781                                           <MA-DISP .VAC .ROFF>>)>)
 782                             (ELSE
 783                              <COND (.INDXAC
 784                                     <COND (<OR <AVAILABLE? .INDXAC>
 785                                                <NOT <SET LAC <FREE-AC?>>>>
 786                                            <MUNG-AC .INDXAC>
 787                                            <EMIT ,INST-ASHL <MA-IMM 1>
 788                                                  <MA-REG .INDXAC>
 789                                                  <MA-REG .INDXAC>>)
 790                                           (ELSE
 791                                            <EMIT ,INST-ASHL <MA-IMM 1>
 792                                                  <MA-REG .INDXAC>
 793                                                  <MA-REG <SET INDXAC .LAC>>>)>
 794                                     <PUT .KLUDGE 1 <MA-INDX .INDXAC>>)>
 795                              <COND (<NOT .HINT>
 796                                     <EMIT-MOVE <TYPE-WORD <TYPE .VAL>>
 797                                                <MA-DISP .VAC .ROFF>
 798                                                LONG
 799                                                .KLUDGE>)>
 800                              <COND (<0? .FX?>
 801                                     <EMIT ,INST-CLRL
 802                                           !.KLUDGE
 803                                           <MA-DISP .VAC <+ .ROFF 4>>>)
 804                                    (<AND <L? .FX? 0>
 805                                          <G? .FX? -64>>
 806                                     <EMIT ,INST-MNEGL
 807                                           <MA-IMM <- .FX?>>
 808                                           !.KLUDGE
 809                                           <MA-DISP .VAC <+ .ROFF 4>>>)
 810                                    (ELSE
 811                                     <EMIT-MOVE <MA-IMM .FX?>
 812                                                <MA-DISP .VAC <+ .ROFF 4>>
 813                                                LONG
 814                                                .KLUDGE>)>)>)
 815                      (.UVC
 816                       <EMIT ,INST-MOVL
 817                             <ADDR-VALUE-MQUOTE .VAL>
 818                             !.KLUDGE
 819                             <MA-DISP .VAC .ROFF>>)
 820                      (ELSE
 821                       <EMIT ,INST-MOVQ
 822                             <ADDR-TYPE-MQUOTE .VAL>
 823                             !.KLUDGE
 824                             <MA-DISP .VAC .ROFF>>)>)
 825               (.UVC
 826                <EMIT ,INST-MOVL
 827                      <VAR-VALUE-ADDRESS .VAL>
 828                      !.KLUDGE
 829                      <MA-DISP .VAC .ROFF>>)
 830               (ELSE
 831                <SET LVAR <FIND-CACHE-VAR .VAL>>
 832                <COND (<AND .LVAR
 833                            <SET LAC <LINKVAR-TYPE-WORD-AC .LVAR>>
 834                            <SET GAC <LINKVAR-VALUE-AC .LVAR>>
 835                            <==? .GAC <NEXT-AC .LAC>>>
 836                       <SET DONE? T>
 837                       <EMIT ,INST-MOVQ
 838                             <MA-REG .LAC>
 839                             !.KLUDGE
 840                             <MA-DISP .VAC .ROFF>>)
 841                      (<OR <NOT .LVAR>
 842                           <AND <LINKVAR-VALUE-STORED .LVAR>
 843                                <LINKVAR-TYPE-STORED .LVAR>
 844                                <OR <AND .HINT
 845                                         <NOT <COUNT-NEEDED? .HINT>>>
 846                                    <AND <SET DCL <VARTBL-DECL .VAL>>
 847                                         <NOT <COUNT-NEEDED? .DCL>>>
 848                                    <LINKVAR-COUNT-STORED .LVAR>>>>
 849                       <SET DONE? T>
 850                       <EMIT ,INST-MOVQ
 851                             <ADDR-VAR-TYPE-VALUE .VAL>
 852                             !.KLUDGE
 853                             <MA-DISP .VAC .ROFF>>)
 854                      (ELSE
 855                       <COND (.INDXAC
 856                              <COND (<OR <AVAILABLE? .INDXAC>
 857                                         <NOT <SET LAC <FREE-AC?>>>>
 858                                     <MUNG-AC .INDXAC>
 859                                     <EMIT ,INST-ASHL <MA-IMM 1>
 860                                           <MA-REG .INDXAC> <MA-REG .INDXAC>>)
 861                                    (ELSE
 862                                     <EMIT ,INST-ASHL <MA-IMM 1>
 863                                           <MA-REG .INDXAC>
 864                                           <MA-REG <SET INDXAC .LAC>>>)>
 865                              <PUT .KLUDGE 1 <MA-INDX .INDXAC>>)>
 866                       <COND (<AND .HINT
 867                                   <NOT <COUNT-NEEDED? .HINT>>>)
 868                             (<OR <NOT .LVAR>
 869                                  <AND <LINKVAR-TYPE-STORED .LVAR>
 870                                       <OR <AND <SET DCL <VARTBL-DECL .VAL>>
 871                                                <NOT <COUNT-NEEDED? .DCL>>>
 872                                           <LINKVAR-COUNT-STORED .LVAR>>>
 873                                   <LINKVAR-TYPE-WORD-AC .LVAR>>
 874                              <EMIT ,INST-MOVL
 875                                    <VAR-TYPE-ADDRESS .VAL TYPEWORD>
 876                                    !.KLUDGE
 877                                    <MA-DISP .VAC .ROFF>>)
 878                             (ELSE
 879                              <COND (<SET DCL <VARTBL-DECL .VAL>>
 880                                     <COND (<NOT <COUNT-NEEDED? .DCL>>
 881                                            <COND (<NOT .HINT>
 882                                                   ; "Will do right thing
 883                                                      with atoms & stuff
 884                                                      (they really need count)"
 885                                                   <STORE-TYPE .DCL
 886                                                               <MA-DISP .VAC .ROFF>
 887                                                               !.KLUDGE>)>)
 888                                           (<LINKVAR-COUNT-STORED .LVAR>
 889                                            ; "Could be better if could get
 890                                               around indexing stuff"
 891                                            <STORE-TYPE .DCL <ADDR-VAR-TYPE .VAL>>
 892                                            <PUT .LVAR ,LINKVAR-TYPE-STORED
 893                                                 T>
 894                                            <EMIT ,INST-MOVL
 895                                                  <ADDR-VAR-TYPE .VAL>
 896                                                  !.KLUDGE
 897                                                  <MA-DISP .VAC .ROFF>>)
 898                                           (ELSE
 899                                            <STORE-TYPE .DCL <ADDR-VAR-TYPE .VAL>>
 900                                            <EMIT ,INST-MOVW
 901                                                  <MA-REG
 902                                                   <LINKVAR-COUNT-AC .LVAR>>
 903                                                  <ADDR-VAR-COUNT .VAL>>
 904                                            <LINKVAR-COUNT-STORED .LVAR T>
 905                                            <LINKVAR-TYPE-STORED .LVAR T>
 906                                            <EMIT ,INST-MOVL
 907                                                  <ADDR-VAR-TYPE .VAL>
 908                                                  !.KLUDGE
 909                                                  <MA-DISP .VAC .ROFF>>)>)
 910                                    (ELSE
 911                                     <COND (<LINKVAR-TYPE-STORED .LVAR>
 912                                            <EMIT ,INST-MOVW
 913                                                  <MA-REG
 914                                                   <LINKVAR-COUNT-AC .LVAR>>
 915                                                  <ADDR-VAR-COUNT .VAL>>
 916                                            <LINKVAR-COUNT-STORED .LVAR T>)
 917                                           (ELSE
 918                                            <EMIT ,INST-MOVW
 919                                                  <MA-REG
 920                                                    <LINKVAR-TYPE-AC .LVAR>>
 921                                                  <ADDR-VAR-TYPE .VAL>>
 922                                            <LINKVAR-TYPE-STORED .LVAR T>)>
 923                                     <EMIT ,INST-MOVL
 924                                           <ADDR-VAR-TYPE .VAL>
 925                                           !.KLUDGE
 926                                           <MA-DISP .VAC .ROFF>>)>)>
 927                       <COND (<NOT .DONE?>
 928                              <EMIT ,INST-MOVL
 929                                    <VAR-VALUE-ADDRESS .VAL>
 930                                    !.KLUDGE
 931                                    <MA-DISP .VAC <+ .ROFF 4>>>)>)>)>
 932         .VAC>
 933
 934 <DEFINE PUT-VEC-GEN (VAR OFF VAL "OPTIONAL" (HINT <>) (UVC <>))
 935         #DECL ((VAR) VARTBL (OFF) <OR FIX VARTBL> (VAL) ANY)
 936         <AND .HINT <SET HINT <PARSE-HINT .HINT TYPE>>>
 937         <PROTECT-VAL .VAL>
 938         <COND (<TYPE? .OFF FIX>
 939                <SLOT-CLOBBER .VAR .OFF .VAL .UVC .HINT>)
 940               (ELSE
 941                <VAR-SLOT-CLOBBER .VAR .OFF .VAL .UVC .HINT>)>
 942         <CLEAR-STATUS>
 943         NORMAL>
 944
 945 <DEFINE PROTECT-VAL (VAL "AUX" LV)
 946   #DECL ((VAL) ANY (LV) <OR FALSE LINKVAR>)
 947   <COND (<AND <TYPE? .VAL VARTBL>
 948               <SET LV <FIND-CACHE-VAR .VAL>>>
 949          ; "Protect ACs for value, so don't clobber it when loading
 950             stuff."
 951          <COND (<LINKVAR-VALUE-AC .LV>
 952                 <PROTECT <LINKVAR-VALUE-AC .LV>>)>
 953          <COND (<LINKVAR-TYPE-WORD-AC .LV>
 954                 <PROTECT <LINKVAR-TYPE-WORD-AC .LV>>)>
 955          <COND (<LINKVAR-TYPE-AC .LV>
 956                 <PROTECT <LINKVAR-TYPE-AC .LV>>)>
 957          <COND (<LINKVAR-COUNT-AC .LV>
 958                 <PROTECT <LINKVAR-COUNT-AC .LV>>)>)>>
 959
 960 <DEFINE VAR-SLOT-CLOBBER (VAR OFF VAL UVC HINT "AUX" VAC NAC)
 961         #DECL ((VAR) VARTBL (OFF) VARTBL (VAL) ANY (UVC) BOOLEAN)
 962         <PROTECT-VAL .VAR>
 963         <PROTECT-USE <SET NAC <LOAD-VAR .OFF VALUE <> PREF-VAL>>>
 964         <PROTECT-USE <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>>
 965         <FINISH-SLOT-CLOBBER .VAC 0 .VAL .UVC .HINT .NAC>
 966         .VAC>
 967
 968 <DEFINE NTH-STRING-GEN (S N R "OPTIONAL" (H <>))
 969   <COND (<NTH-LOOK-AHEAD NTHUS!-MIMOP .S .N .R .H>)
 970         (T
 971          <NTH-STRING-GEN-1 .S .N .R CHARACTER>)>>
 972
 973 <DEFINE NTH-BYTE-GEN (S N R "OPTIONAL" (H <>))
 974   <COND (<NTH-LOOK-AHEAD NTHUB!-MIMOP .S .N .R .H>)
 975         (T <NTH-STRING-GEN-1 .S .N .R FIX>)>>
 976
 977 <DEFINE NTH-STRING-GEN-1 (SVAR NUM RES TYP "AUX" VAC RVAC ACN NAC)
 978         #DECL ((SVAR) <OR VARTBL STRING BYTES> (NUM) <OR VARTBL FIX>)
 979         <COND (<TYPE? .SVAR VARTBL>
 980                <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>)
 981               (ELSE
 982                <SET VAC <GET-AC PREF-VAL T>>
 983                <MOVE-VALUE .SVAR .VAC>)>
 984         <PROTECT-USE .VAC>
 985         <SET RVAC <GET-AC PREF-VAL T>>
 986         <PROTECT .RVAC>
 987         <COND (<TYPE? .NUM FIX>
 988                <EMIT ,INST-MOVZBL
 989                      <MA-DISP .VAC <- .NUM 1>>
 990                      <MA-REG .RVAC>>)
 991               (ELSE
 992                <PROTECT-USE <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>>
 993                <EMIT ,INST-MOVZBL <MA-INDX .NAC>
 994                      <MA-DISP .VAC -1> <MA-REG .RVAC>>)>
 995         <DEST-DECL .RVAC .RES .TYP>
 996         NORMAL>
 997
 998 <DEFINE PUT-STRING-GEN (SVAR NUM VAL "OPTIONAL" (INS PUTUS!-MIMOP)
 999                         "AUX" VAC CADDR CVAC DADDR NAC)
1000         #DECL ((SVAR) VARTBL (NUM) <OR VARTBL FIX> (VAL) <OR VARTBL
1001                                                              CHARACTER
1002                                                              FIX>)
1003         <PROTECT-VAL .VAL>
1004         <SET VAC <LOAD-VAR .SVAR VALUE <> PREF-VAL>>
1005         <PROTECT-USE .VAC>
1006         <COND (<TYPE? .VAL CHARACTER> <SET CADDR <MA-IMM <ASCII .VAL>>>)
1007               (<TYPE? .VAL FIX> <SET CADDR <MA-IMM .VAL>>)
1008               (ELSE
1009                <COND (<SET CVAC <VAR-VALUE-IN-AC? .VAL>>
1010                       <PROTECT-USE .CVAC>
1011                       <SET CADDR <MA-REG .CVAC>>)
1012                      (ELSE
1013                       <SET CADDR <ADDR-VAR-CHAR-VALUE .VAL>>)>)>
1014         <COND (<TYPE? .NUM FIX>
1015                <SET DADDR <MA-DISP .VAC <- .NUM 1>>>
1016                <EMIT ,INST-MOVB .CADDR .DADDR>)
1017               (ELSE
1018                <PROTECT-USE <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>>
1019                <SET DADDR <MA-DISP .VAC -1>>
1020                <EMIT ,INST-MOVB .CADDR <MA-INDX .NAC> .DADDR>)>
1021         NORMAL>
1022
1023 <DEFINE PUT-BYTE-GEN (SVAR OFF VAL)
1024   <PUT-STRING-GEN .SVAR .OFF .VAL PUTUB!-MIMOP>>
1025
1026 <DEFINE NTH-UVECTOR-GEN NUG (UVAR NUM RES
1027                          "OPTIONAL" (HINT <>)
1028                          "AUX" TYP VAC TAC CADDR RVAC (NAC <>) VAL)
1029         #DECL ((UVAR) <OR VARTBL UVECTOR> (NUM) <OR VARTBL FIX>
1030                (RES) <OR VARTBL ATOM> (HINT) <OR FALSE HINT>)
1031         <COND (<TYPE? .UVAR UVECTOR> <SET TYP FIX> ;<SET TYP <UTYPE .UVAR>>)
1032               (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>)
1033               (ELSE <SET TYP FIX>)>
1034         <COND (<SET VAL <NTH-LOOK-AHEAD NTHUU!-MIMOP .UVAR .NUM .RES .TYP>>
1035                <RETURN .VAL .NUG>)>
1036         <COND (<TYPE? .NUM FIX>
1037                <COND (<TYPE? .UVAR VARTBL>
1038                       <SET VAC <LOAD-VAR .UVAR VALUE <> PREF-VAL>>)
1039                      (ELSE
1040                       <SET VAC <GET-AC PREF-VAL T>>
1041                       <MOVE-VALUE .UVAR .VAC>)>
1042                <PROTECT-USE .VAC>)>
1043         <COND (<NOT .TYP>
1044                <ERROR>
1045                <PROTECT-USE <SET TAC <LOAD-VAR .UVAR COUNT <> DATA>>>
1046                <EMIT-SHIFT ,INST-ASHL 2 .TAC LONG>
1047                <ADD-TO-AC .TAC <VAR-VALUE-ADDRESS .UVAR>>
1048                <COND (<==? .RES STACK>
1049                       <EMIT-PUSH <MA-DISP .TAC 0> WORD>
1050                       <CLEAR-PUSH WORD>)
1051                      (<MOVE-TO-AC .TAC <MA-DISP .TAC 4> WORD>)>)>
1052         <COND (<TYPE? .RES VARTBL>
1053                <PROTECT <SET RVAC <GET-AC PREF-VAL T>>>)>
1054         <COND (<TYPE? .NUM FIX>
1055                <SET CADDR <MA-DISP .VAC <* <- .NUM 1> 4>>>)
1056               (ELSE
1057                <SET NAC <LOAD-VAR .NUM VALUE <> PREF-VAL>>
1058                <PROTECT-USE .NAC>
1059                <COND (<TYPE? .UVAR VARTBL>
1060                       <SET VAC <LOAD-VAR .UVAR VALUE <> PREF-VAL>>)
1061                      (ELSE
1062                       <SET VAC <GET-AC PREF-VAL T>>
1063                       <MOVE-VALUE .UVAR <MA-REG .VAC>>)>
1064                <PROTECT-USE .VAC>
1065                <SET CADDR <MA-DISP .VAC -4>>)>
1066         <COND (<==? .RES STACK>
1067                <COND (.TYP <EMIT-PUSH <TYPE-WORD .TYP> LONG>)>
1068                <COND (.NAC
1069                       <EMIT ,INST-MOVL <MA-INDX .NAC> .CADDR
1070                             <MA-AINC ,AC-TP>>)
1071                      (ELSE
1072                       <EMIT ,INST-MOVL .CADDR <MA-AINC ,AC-TP>>)>)
1073               (ELSE
1074                <COND (.NAC
1075                       <EMIT ,INST-MOVL <MA-INDX .NAC> .CADDR
1076                             <MA-REG .RVAC>>)
1077                      (ELSE
1078                       <EMIT ,INST-MOVL .CADDR <MA-REG .RVAC>>)>
1079                <COND (.TYP <DEST-DECL .RVAC .RES .TYP>)
1080                      (ELSE <DEST-TYPE-VALUE .RVAC .TAC .RES>)>)>
1081         NORMAL>
1082
1083 <DEFINE PUT-UVECTOR-GEN (VAR OFF VAL "OPTIONAL" (HINT <>))
1084         #DECL ((VAR) VARTBL (OFF) <OR FIX VARTBL> (VAL) ANY)
1085         <PUT-VEC-GEN .VAR .OFF .VAL .HINT T>>
1086
1087 <DEFINE BACKU-GEN (STR NUM RES "OPTIONAL" (HINT <>))
1088         <CALL-RTE ,IBACKU!-MIMOP CALL .RES .HINT .STR .NUM>
1089         NORMAL>
1090
1091 <DEFINE TOPU-GEN (STR RES "OPTIONAL" (HINT <>))
1092         <CALL-RTE ,ITOPU!-MIMOP CALL .RES .HINT .STR>
1093         NORMAL>
1094
1095 <SETG SAVES <IVECTOR 3 <>>>
1096
1097 <DEFINE MOVE-WORDS-GEN (FROM TO CT "TUPLE" HINTS "AUX" (TYPE <>) SHIFT)
1098   <MAPF <>
1099     <FUNCTION (H)
1100       <COND (<SET TYPE <PARSE-HINT .H TYPE>>
1101              <MAPLEAVE>)>>
1102     .HINTS>
1103   <COND (.TYPE
1104          <COND (<==? .TYPE VECTOR> <SET SHIFT 3>)
1105                (T <SET SHIFT 2>)>
1106          <DO-BLT .FROM .TO .CT .SHIFT>)
1107         (T
1108          <ERROR BAD-HINT!-ERRORS .HINTS MOVE-WORDS-GEN>)>>
1109
1110 <DEFINE MOVE-STRING-GEN (FROM TO CT "OPTIONAL" (HINT <>))
1111   <DO-BLT .FROM .TO .CT 0>>
1112
1113 <DEFINE DO-BLT (FROM TO CT SHIFT
1114                          "AUX" (SAVES ,SAVES) TAC)
1115   #DECL ((SAVES) VECTOR)
1116   <COND (<AND <TYPE? .FROM VARTBL>
1117               <SET TAC <VAR-VALUE-IN-AC? .FROM>>>
1118          ; "If this guy is in AC, save everything, but remember that
1119             he's here."
1120          <STORE-AC .TAC>
1121          <PROTECT .TAC>
1122          <1 .SAVES .TAC>)
1123         (<1 .SAVES <>>)>
1124   <COND (<AND <TYPE? .TO VARTBL>
1125               <SET TAC <VAR-VALUE-IN-AC? .TO>>>
1126          <STORE-AC .TAC>
1127          <PROTECT .TAC>
1128          <2 .SAVES .TAC>)
1129         (<2 .SAVES <>>)>
1130   <SET TAC <>>
1131   <COND (<NOT <TYPE? .CT VARTBL>>
1132          <SET CT <LSH .CT .SHIFT>>)
1133         (T
1134          <COND (<G? .SHIFT 0>
1135                 <SET TAC <LOAD-VAR .CT VALUE T PREF-VAL>>
1136                 <PROTECT .TAC>
1137                 <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .TAC> <MA-REG .TAC>>
1138                 <3 .SAVES .TAC>)
1139                (<SET TAC <VAR-VALUE-IN-AC? .CT>>
1140                 <STORE-AC .TAC>
1141                 <PROTECT .TAC>
1142                 <3 .SAVES .TAC>)
1143                (T
1144                 <3 .SAVES <>>)>)>
1145   ; "Now clobber all the ACs that don't have our arguments"
1146   <COND (<NOT <MEMQ ,AC-0 .SAVES>> <MUNG-AC ,AC-0>)>
1147   <COND (<NOT <MEMQ ,AC-1 .SAVES>> <MUNG-AC ,AC-1>)>
1148   <COND (<NOT <MEMQ ,AC-2 .SAVES>> <MUNG-AC ,AC-2>)>
1149   <COND (<NOT <MEMQ ,AC-3 .SAVES>> <MUNG-AC ,AC-3>)>
1150   <COND (<NOT <MEMQ ,AC-4 .SAVES>> <MUNG-AC ,AC-4>)>
1151   <COND (<NOT <MEMQ ,AC-5 .SAVES>> <MUNG-AC ,AC-5>)>
1152   <EMIT ,INST-MOVC3
1153         <COND (<TYPE? .CT VARTBL>
1154                <COND (<3 .SAVES> <MA-REG <3 .SAVES>>)
1155                      (<VAR-VALUE-ADDRESS .CT>)>)
1156               (T
1157                <MA-IMM .CT>)>
1158         <COND (<TYPE? .FROM VARTBL>
1159                <COND (<1 .SAVES> <MA-REGD <1 .SAVES>>)
1160                      (T
1161                       <GEN-LOC .FROM 4 T>)>)
1162               (T
1163                <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .FROM> 4>>)>
1164         <COND (<TYPE? .TO VARTBL>
1165                <COND (<2 .SAVES> <MA-REGD <2 .SAVES>>)
1166                      (T
1167                       <GEN-LOC .TO 4 T>)>)
1168               (T
1169                <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .TO> 4>>)>>
1170   ; "Clobber acs that had our arguments"
1171   <MAPF <>
1172     <FUNCTION (X)
1173       <COND (<AND .X <L=? <AC-NUMBER .X> 5>>
1174              <MUNG-AC .X>)>>
1175     .SAVES>
1176   NORMAL>
1177
1178 <DEFINE STRING-EQUAL?-GEN (STR1 STR2 DIR LABEL "AUX" ELABEL
1179                            (SAVES ,SAVES) TAC LV)
1180   #DECL ((DIR LABEL) ATOM (SAVES) VECTOR)
1181   <COND (<AND <NOT <TYPE? .STR1 VARTBL>>
1182               <NOT <TYPE? .STR2 VARTBL>>>
1183          ; "Handle constants, just for fun"
1184          <COND (<==? .DIR ->
1185                 <COND (<N=? .STR1 .STR2>
1186                        <UCBRANCH-GEN .DIR .LABEL>)>)
1187                (<=? .STR1 .STR2>
1188                 <UCBRANCH-GEN .DIR .LABEL>)>
1189          UNCONDITIONAL-BRANCH)
1190         (T
1191          ; "First, make sure lengths are equal"
1192          <COND (<AND <TYPE? .STR1 VARTBL> <SET TAC <VAR-TYPE-WORD-IN-AC? .STR1>>>
1193                 <STORE-AC .TAC T <SET LV <FIND-CACHE-VAR .STR1>>>
1194                 <STORE-AC .TAC <>>)>
1195          <COND (<AND <TYPE? .STR2 VARTBL> <SET TAC <VAR-TYPE-WORD-IN-AC? .STR2>>>
1196                 <STORE-AC .TAC T <SET LV <FIND-CACHE-VAR .STR2>>>
1197                 <STORE-AC .TAC <>>)>
1198          <EMIT ,INST-CMPW
1199                <COND (<TYPE? .STR1 VARTBL> <VAR-COUNT-ADDRESS .STR1>)
1200                      (T <MA-IMM <LENGTH .STR1>>)>
1201                <COND (<TYPE? .STR2 VARTBL> <VAR-COUNT-ADDRESS .STR2>)
1202                      (T <MA-IMM <LENGTH .STR2>>)>>
1203          <SET ELABEL <MAKE-LABEL>>
1204          <COND (<==? .DIR ->
1205                 ; "Jump if different lengths, since that's all we need."
1206                 <GEN-BRANCH ,INST-BNEQ .LABEL <> <> <> T>)
1207                (T
1208                 ; "Jump to failure location"
1209                 <GEN-BRANCH ,INST-BNEQ .ELABEL <> <> <> T>)>
1210          <1 .SAVES <>>
1211          ; "Try to get an AC with length"
1212          <COND (<TYPE? .STR1 VARTBL>
1213                 <COND (<SET TAC <VAR-COUNT-IN-AC? .STR1>>
1214                        <PROTECT .TAC>
1215                        <1 .SAVES .TAC>)>)>
1216          <COND (<AND <NOT <1 .SAVES>>
1217                      <TYPE? .STR2 VARTBL>>
1218                 <COND (<SET TAC <VAR-COUNT-IN-AC? .STR2>>
1219                        <PROTECT .TAC>
1220                        <1 .SAVES .TAC>)>)>
1221          ; "Try to get AC with 1st string pointer"
1222          <COND (<AND <TYPE? .STR1 VARTBL>
1223                      <SET TAC <VAR-VALUE-IN-AC? .STR1>>>
1224                 <PROTECT .TAC>
1225                 <2 .SAVES .TAC>)
1226                (<2 .SAVES <>>)>
1227          ; "2nd string pointer"
1228          <COND (<AND <TYPE? .STR2 VARTBL>
1229                      <SET TAC <VAR-VALUE-IN-AC? .STR2>>>
1230                 <PROTECT .TAC>
1231                 <3 .SAVES .TAC>)
1232                (<3 .SAVES <>>)>
1233          ; "Make sure nothing left in these acs"
1234          <COND (<NOT <MEMQ ,AC-0 .SAVES>> <MUNG-AC ,AC-0>)
1235                (<STORE-AC ,AC-0>)>
1236          <COND (<NOT <MEMQ ,AC-1 .SAVES>> <MUNG-AC ,AC-1>)
1237                (<STORE-AC ,AC-1>)>
1238          <COND (<NOT <MEMQ ,AC-2 .SAVES>> <MUNG-AC ,AC-2>)
1239                (<STORE-AC ,AC-2>)>
1240          <COND (<NOT <MEMQ ,AC-3 .SAVES>> <MUNG-AC ,AC-3>)
1241                (<STORE-AC ,AC-3>)>
1242          ; "Do compare"
1243          <EMIT ,INST-CMPC3
1244                ; "Length operand"
1245                <COND (<1 .SAVES> <MA-REG <1 .SAVES>>)
1246                      (<NOT <TYPE? .STR1 VARTBL>>
1247                       <MA-IMM <LENGTH .STR1>>)
1248                      (<NOT <TYPE? .STR2 VARTBL>>
1249                       <MA-IMM <LENGTH .STR2>>)
1250                      (T
1251                       <VAR-COUNT-ADDRESS .STR1>)>
1252                ; "First pointer"
1253                <COND (<2 .SAVES> <MA-REGD <2 .SAVES>>)
1254                      (<TYPE? .STR1 VARTBL>
1255                       <GEN-LOC .STR1 4 T>)
1256                      (T
1257                       <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR1> 4>>)>
1258                ; "Second pointer"
1259                <COND (<3 .SAVES> <MA-REGD <3 .SAVES>>)
1260                      (<TYPE? .STR2 VARTBL>
1261                       <GEN-LOC .STR2 4 T>)
1262                      (T
1263                       <MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR2> 4>>)>>
1264          ; "Clobber the acs we munged"
1265          <MUNG-AC ,AC-0>
1266          <MUNG-AC ,AC-1>
1267          <MUNG-AC ,AC-2>
1268          <MUNG-AC ,AC-3>
1269          ; "And jump to the right place"
1270          <COND (<==? .DIR ->
1271                 <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
1272                (T
1273                 <GEN-BRANCH ,INST-BEQL .LABEL <>>)>
1274          ; "Will jump here if lengths not equal and dir +"
1275          <EMIT-LABEL .ELABEL <>>
1276          CONDITIONAL-BRANCH)>>
1277
1278 <DEFINE STRCOMP-GEN (STR1 STR2 RES "AUX" TAC LVAR
1279                      LAB1 LAB2 LV)
1280   <COND (<AND <NOT <TYPE? .STR1 VARTBL>>
1281               <NOT <TYPE? .STR2 VARTBL>>>
1282          <COND (<TYPE? .RES ATOM>
1283                 <PUSH-CONSTANT <STRCOMP .STR1 .STR2>>)
1284                (T
1285                 <SET-GEN .RES <STRCOMP .STR1 .STR2>>)>)
1286         (T
1287          <GET-AC ,AC-4 T>
1288          <GET-AC ,AC-3 T>
1289          <MUNG-AC ,AC-0>
1290          <MUNG-AC ,AC-1>
1291          <MUNG-AC ,AC-2>
1292          <EMIT-MOVE <MA-IMM 0> <MA-REG ,AC-4> LONG>
1293          <COND (<NOT <TYPE? .STR1 VARTBL>>
1294                 <SET LVAR <MA-IMM <LENGTH .STR1>>>)
1295                (<SET TAC <VAR-COUNT-IN-AC? .STR1>>
1296                 <SET LVAR <MA-REG .TAC>>)
1297                (T
1298                 <COND (<SET TAC <VAR-TYPE-WORD-IN-AC? .STR1>>
1299                        <STORE-AC .TAC T <SET LV <FIND-CACHE-VAR .STR1>>>
1300                        <STORE-AC .TAC <>>)>
1301                 <SET LVAR <VAR-COUNT-ADDRESS .STR1>>)>
1302          <EMIT-MOVE .LVAR <MA-REG ,AC-3> LONG>
1303          <EMIT ,INST-CMPW
1304                <MA-REG ,AC-3>
1305                <COND (<NOT <TYPE? .STR2 VARTBL>>
1306                       <MA-IMM <LENGTH .STR2>>)
1307                      (<SET TAC <VAR-COUNT-IN-AC? .STR2>>
1308                       <MA-REG .TAC>)
1309                      (T
1310                       <COND (<SET TAC <VAR-TYPE-WORD-IN-AC? .STR2>>
1311                              <STORE-AC .TAC T <FIND-CACHE-VAR .STR1>>
1312                              <STORE-AC .TAC <>>)>
1313                       <VAR-COUNT-ADDRESS .STR2>)>>
1314          <SET LAB1 <MAKE-LABEL>>
1315          <SET LAB2 <MAKE-LABEL>>
1316          <GEN-BRANCH ,INST-BEQL .LAB1 <> <> <> T>
1317          <GEN-BRANCH ,INST-BLSS .LAB2 <> <> <> T>
1318          ; "First is longer than second, so bias toward returning 1"
1319          <EMIT-MOVE <MA-IMM 1> <MA-REG ,AC-4> LONG>
1320          ; "Get right length into ac-3"
1321          <EMIT-MOVE <COND (<TYPE? .STR2 VARTBL>
1322                            <VAR-COUNT-ADDRESS .STR2>)
1323                           (T
1324                            <MA-IMM <LENGTH .STR2>>)>
1325                     <MA-REG ,AC-3> LONG>
1326          <GEN-BRANCH ,INST-BRB .LAB1 UNCONDITIONAL-BRANCH <> <> T>
1327          <EMIT-LABEL .LAB2 <>>
1328          ; "First is shorter"
1329          <EMIT-MOVE <MA-IMM -1> <MA-REG ,AC-4> LONG>
1330          <EMIT-LABEL .LAB1 <>>
1331          <EMIT ,INST-CMPC3
1332                <MA-REG ,AC-3>
1333                <COND (<TYPE? .STR1 VARTBL>
1334                       <COND (<SET TAC <VAR-VALUE-IN-AC? .STR1>>
1335                              <MA-REGD .TAC>)
1336                             (T
1337                              <GEN-LOC .STR1 4 T>)>)
1338                      (<MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR1> 4>>)>
1339                <COND (<TYPE? .STR2 VARTBL>
1340                       <COND (<SET TAC <VAR-VALUE-IN-AC? .STR2>>
1341                              <MA-REGD .TAC>)
1342                             (T
1343                              <GEN-LOC .STR2 4 T>)>)
1344                      (<MA-DEF-DISP ,AC-M <+ <ADD-MVEC .STR2> 4>>)>>
1345          <SET LAB1 <MAKE-LABEL>>
1346          <SET LAB2 <MAKE-LABEL>>
1347          ; "Just return what's in AC-4"
1348          <GEN-BRANCH ,INST-BEQL .LAB1 <> <> <> T>
1349          <GEN-BRANCH ,INST-BLSS .LAB2 <> <> <> T>
1350          <EMIT-MOVE <MA-IMM 1> <MA-REG ,AC-4> LONG>
1351          <GEN-BRANCH ,INST-BRB .LAB1 UNCONDITIONAL-BRANCH <> <> T>
1352          <EMIT-LABEL .LAB2 <>>
1353          <EMIT-MOVE <MA-IMM -1> <MA-REG ,AC-4> LONG>
1354          <EMIT-LABEL .LAB1 <>>
1355          <COND (<==? .RES STACK>
1356                 <EMIT-PUSH <TYPE-WORD FIX> LONG>
1357                 <EMIT-PUSH <MA-REG ,AC-4> LONG>)
1358                (T
1359                 <DEST-DECL ,AC-4 .RES FIX>)>)>
1360   NORMAL>