mim/development/mim/vaxc/recordgen.mud

   1
   2 <DEFINE PUTR-GEN (VAR NUM VAL
   3                   "OPTIONAL" (HINT <>) (PHINT <>)
   4                   "AUX" RD ETYP VAC ACN TCOFF VADDR VVAC ANYCOFF VOFF STACK? A1
   5                         LV RHINT)
   6    #DECL ((VAR) ANY (NUM) <OR FIX VARTBL> (VAL) ANY)
   7    <COND (<NOT <TYPE? .VAR VARTBL>> <SET HINT <TYPE .VAR>>)>
   8    <COND (.PHINT <SET PHINT <PARSE-HINT .PHINT TYPE>>)>
   9    <COND
  10     (<OR <TYPE? .NUM VARTBL> <NOT .HINT>>
  11      <CALL-RTE ,IPUTR!-MIMOP CALL <> <> .VAR .NUM .VAL>
  12      T)
  13     (ELSE
  14      <OR <SET RD <GET-RELE-DESCRIPTOR .NUM .HINT>>
  15          <ERROR "RECORD TYPE NOT FOUND" .NUM .HINT PUTR-GEN>>
  16      ; "This crock causes the actual contents of FR to be saved when
  17         bindind UNWIND, so it can be restored by the kernel.  CFRAME
  18         saves a pointer to the real frame, which is by no means the
  19         same thing when MAKTUP-FLAG is set."
  20      <COND (<AND ,MAKTUP-FLAG
  21                  <==? .NUM 2>
  22                  <OR <==? .VAL UNWIND>
  23                      <==? .VAL T$UNWIND>>
  24                  <AND .HINT
  25                       <SET RHINT <PARSE-HINT .HINT RECORD-TYPE>>
  26                       <OR <==? .RHINT LBIND>
  27                           <==? .RHINT T$LBIND>>>>
  28             <EMIT-PUSH <TYPE-WORD T$FRAME> LONG>
  29             <EMIT-PUSH <MA-REG ,AC-F> LONG>)>
  30      <SET STACK? <GET-RSTACK? .HINT>>
  31      <PROTECT-VAL .VAL>
  32      <COND (<TYPE? .VAR VARTBL> <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>)
  33            (ELSE <SET VAC <GET-AC PREF-VAL T>> <MOVE-VALUE .VAR .VAC>)>
  34      <PROTECT .VAC>
  35      <SET TCOFF <MA-DISP .VAC <RED-OFFSET-TYPCNT .RD>>>
  36      <SET ANYCOFF <MA-DISP .VAC <+ <RED-OFFSET-TYPCNT .RD> 2>>>
  37      <SET VOFF <MA-DISP .VAC <RED-OFFSET-VALUE .RD>>>
  38      <COND
  39       (<==? <SET ETYP <RED-KIND .RD>> ANY>
  40        <COND (<OR <FIX-CONSTANT? .VAL>
  41                   <AND <TYPE? .VAL VARTBL>
  42                        <SET LV <FIND-CACHE-VAR .VAL>>
  43                        <NOT <AND <LINKVAR-VALUE-STORED .LV>
  44                                  <LINKVAR-TYPE-STORED .LV>
  45                                  <LINKVAR-COUNT-STORED .LV>>>
  46                        <NOT <AND <SET A1 <LINKVAR-TYPE-WORD-AC .LV>>
  47                                  <==? <LINKVAR-VALUE-AC .LV> <NEXT-AC .A1>>>>>>
  48               <MOVE-VALUE .VAL .VOFF>
  49               <MOVE-TYPE .VAL .TCOFF .ANYCOFF>)
  50              (<TYPE? .VAL VARTBL>
  51               <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAL TYPE-WORD> .TCOFF>)
  52              (ELSE <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .VAL> .TCOFF>)>)
  53       (<OR <==? .ETYP SMALL-INT> <==? .ETYP SMALL-POS-INT>>
  54        <COND (<TYPE? .VAL FIX> <EMIT-MOVE <MA-IMM .VAL> .VOFF WORD>)
  55              (<TYPE? .VAL VARTBL>
  56               <COND (<SET VVAC <VAR-VALUE-IN-AC? .VAL>>
  57                      <EMIT-MOVE <MA-REG .VVAC> .VOFF WORD>)
  58                     (ELSE
  59                      <SET VADDR <MA-DISP ,AC-F <+ <VARTBL-LOC .VAL> 2>>>
  60                      <EMIT-MOVE .VADDR .VOFF WORD>)>)
  61              (<ERROR "BAD ARGUMENT" PUT-RECORD>)>)
  62       (<OR <==? .ETYP TYPE-C> <==? .ETYP VWORD1>>
  63        <COND
  64         (<RED-SBOOL .RD>
  65          <COND (<OR <==? .VAL <>>
  66                     <AND <TYPE? .VAL VARTBL> <==? <VARTBL-DECL .VAL> FALSE>>
  67                     <==? .PHINT FALSE>>
  68                 <COND (<==? .ETYP TYPE-C> <EMIT ,INST-MCOMW <MA-IMM 0> .VOFF>)
  69                       (ELSE <EMIT ,INST-CLRL .VOFF>)>)
  70                (<OR <NOT <TYPE? .VAL VARTBL>> <VARTBL-DECL .VAL> .PHINT>
  71                 <COND (<==? .ETYP TYPE-C>
  72                        <EMIT ,INST-MOVW
  73                              <COND (<TYPE? .VAL VARTBL>
  74                                     <VAR-VALUE-ADDRESS .VAL>)
  75                                    (ELSE <MA-IMM .VAL>)>
  76                              .VOFF>)
  77                       (ELSE <MOVE-VALUE .VAL .VOFF>)>)
  78                (<TYPE? .VAL VARTBL>
  79                 <TESTSET .VAL .VOFF <> <==? .ETYP TYPE-C>>)>)
  80         (ELSE <MOVE-VALUE .VAL .VOFF>)>)
  81       (<==? .ETYP COUNTVWORD>
  82        <COND (<AND <RED-SBOOL .RD>
  83                    <OR <==? .VAL <>>
  84                        <==? <VARTBL-DECL .VAR> FALSE>
  85                        <==? .PHINT FALSE>>>
  86               <EMIT ,INST-CLRL .VOFF>
  87               <EMIT ,INST-CLRW .TCOFF>)
  88              (<TYPE? .VAL VARTBL>
  89               <COND (<OR <NOT <RED-SBOOL .RD>> .PHINT <VARTBL-DECL .VAL>>
  90                      <MOVE-VALUE .VAL .VOFF>
  91                      <COUNT-STORE-REC .VAL .TCOFF>)
  92                     (ELSE <TESTSET .VAL .VOFF .TCOFF>)>)
  93              (ELSE
  94               <MOVE-VALUE .VAL .VOFF>
  95               <EMIT-MOVE <MA-IMM <LENGTH .VAL>> .TCOFF WORD>)>)
  96       (<==? .ETYP BYTE>
  97        <COND (<TYPE? .VAL FIX> <EMIT-MOVE <MA-IMM .VAL> .VOFF BYTE>)
  98              (ELSE <EMIT-MOVE <VAR-VALUE-ADDRESS .VAL> .VOFF BYTE>)>)
  99       (<==? .ETYP BOOLEAN> <TEST-BOOL .VOFF <RED-BIT-NUMBER .RD> .VAL>)>
 100      <CLEAR-STATUS>)>
 101    NORMAL>
 102
 103 <DEFINE TESTSET (VAR VADDR TCADDR "OPT" (HW <>) "AUX" ELAB FLAB)
 104         #DECL ((VAR) VARTBL (VADDR) EFF-ADDR (TCADDR) <OR FIX FALSE EFF-ADDR>)
 105         <SET FLAB <MAKE-LABEL>>
 106         <TYPE-TST-GEN .VAR FALSE - .FLAB>
 107         <EMIT <COND (.HW ,INST-CLRW) (ELSE ,INST-CLRL)> .VADDR>
 108         <AND <TYPE? .TCADDR EFF-ADDR> <EMIT ,INST-CLRW .TCADDR>>
 109         <SET ELAB <MAKE-LABEL>>
 110         <GEN-BRANCH ,INST-BRB .ELAB <>>
 111         <EMIT-LABEL .FLAB <>>
 112         <EMIT-MOVE <VAR-VALUE-ADDRESS .VAR> .VADDR
 113                    <COND (.HW WORD) (ELSE LONG)>>
 114         <COND (<TYPE? .TCADDR EFF-ADDR>
 115                <COUNT-STORE-REC .VAR .TCADDR>)>
 116         <EMIT-LABEL .ELAB <>>>
 117
 118 <DEFINE TEST-BOOL (VCADDR BITNO VAL "AUX" FLAB ELAB)
 119         #DECL ((VCADDR) EFF-ADDR (BITNO) FIX (VAL) VARTBL)
 120         <SET FLAB <MAKE-LABEL>>
 121         <TYPE-TST-GEN .VAL FALSE - .FLAB>
 122         <EMIT ,INST-BICL2 .VCADDR <MA-IMM <CHTYPE <LSH 1 .BITNO> FIX>>>
 123         <SET ELAB <MAKE-LABEL>>
 124         <GEN-BRANCH ,INST-BRB .ELAB <>>
 125         <EMIT ,INST-BISL .VCADDR <MA-IMM <CHTYPE <LSH 1 .BITNO> FIX>>>
 126         <EMIT-LABEL .ELAB <>>>
 127
 128 <DEFINE NTH-RECORD-GEN (VAR OFF RES
 129                         "OPTIONAL" (HINT1 <>) (HINT2 <>)
 130                         "AUX" RD (BRANCH? <>) VAC ACN TCOFF ANYCOFF VOFF TYP
 131                               NTYP DAC ETYP STACK? AC-LOADED)
 132    #DECL ((VAR) ANY (OFF) <OR VARTBL FIX> (HINT2) <OR FALSE HINT>
 133           (RES) <OR ATOM VARTBL>)
 134    <COND (<NOT <TYPE? .VAR VARTBL>> <SET HINT1 <TYPE .VAR>>)>
 135    <COND (<OR <NOT .HINT1> <TYPE? .OFF VARTBL>>
 136           <CALL-RTE ,INTHR!-MIMOP CALL .RES <> .VAR .OFF>)
 137          (ELSE
 138           <OR <SET RD <GET-RELE-DESCRIPTOR .OFF .HINT1>>
 139               <ERROR "RECORD TYPE NOT FOUND" .HINT1 .OFF NTH-RECORD-GEN>>
 140           <SET STACK? <GET-RSTACK? .HINT1>>
 141           <SET TYP <RED-OBJTYP .RD>>
 142           <SET NTYP <AND .HINT2 <PARSE-HINT .HINT2 TYPE>>>
 143           <COND (<N==? .RES STACK> <SET BRANCH? <GET-RELE-BRANCH? .HINT2>>)>
 144           <COND (<TYPE? .VAR VARTBL>
 145                  <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>)
 146                 (ELSE <SET VAC <GET-AC VALUE T>> <MOVE-VALUE .VAR .VAC>)>
 147           <PROTECT .VAC>
 148           <SET TCOFF <MA-DISP .VAC <RED-OFFSET-TYPCNT .RD>>>
 149           <SET ANYCOFF <MA-DISP .VAC <+ <RED-OFFSET-TYPCNT .RD> 2>>>
 150           <SET VOFF <MA-DISP .VAC <RED-OFFSET-VALUE .RD>>>
 151           <COND (<==? .VAR .RES>
 152                  <DEAD-VAR .VAR>)>
 153           <COND (<==? <SET ETYP <RED-KIND .RD>> ANY>
 154                  <RANY-OFF .RES .TCOFF .VOFF .VAC>)
 155                 (<AND <OR <==? .ETYP VWORD1> <==? .ETYP COUNTVWORD>> .BRANCH?>
 156                  <SET AC-LOADED <BRANCH-VALUE .VOFF .BRANCH? <RED-LENGTH .RD>>>
 157                  <GEN-NTH .VOFF
 158                           .TYP
 159                           .VAC
 160                           .RES
 161                           <RED-LENGTH .RD>
 162                           <>
 163                           <COND (<RED-LENGTH .RD> .AC-LOADED)>
 164                           <COND (<RED-LENGTH .RD> <NEXT-AC .AC-LOADED>)
 165                                 (ELSE .AC-LOADED)>>)
 166                 (<AND <==? .ETYP TYPE-C> .BRANCH?>
 167                  <SET AC-LOADED <BRANCH-HW .VOFF .BRANCH?>>
 168                  <GEN-NTH .VOFF
 169                           .TYP
 170                           .VAC
 171                           .RES
 172                           <RED-LENGTH .RD>
 173                           T
 174                           <>
 175                           .AC-LOADED>)
 176                 (<OR <==? .ETYP VWORD1> <==? .ETYP TYPE-C>>
 177                  <COND (<RED-SBOOL .RD>
 178                         <TEST-NTH .VOFF
 179                                   .TYP
 180                                   .VAC
 181                                   .RES
 182                                   <RED-LENGTH .RD>
 183                                   .NTYP
 184                                   <==? .ETYP TYPE-C>>)
 185                        (<GEN-NTH .VOFF
 186                                  .TYP
 187                                  .VAC
 188                                  .RES
 189                                  <RED-LENGTH .RD>
 190                                  <==? .ETYP TYPE-C>>)>)
 191                 (<==? .ETYP COUNTVWORD>
 192                  <COND (<RED-SBOOL .RD>
 193                         <TEST-NTH .VOFF .TYP .VAC .RES .TCOFF .NTYP>)
 194                        (<GEN-NTH .VOFF .TYP .VAC .RES .TCOFF>)>)
 195                 (<==? .ETYP SMALL-FR-OFFSET>
 196                  <PROTECT <SET DAC <GET-AC PREF-VAL T>>>
 197                  <EMIT ,INST-CVTWL .VOFF <MA-REG .DAC>>
 198                  <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG .DAC>>
 199                  <DEST-DECL .DAC .RES T$LBIND>)
 200                 (<OR <==? .ETYP SMALL-INT> <==? .ETYP SMALL-POS-INT>>
 201                  <PROTECT <SET DAC <GET-AC PREF-VAL T>>>
 202                  <COND (<==? .ETYP SMALL-INT>
 203                         <EMIT ,INST-CVTWL .VOFF <MA-REG .DAC>>)
 204                        (ELSE <EMIT ,INST-MOVZWL .VOFF <MA-REG .DAC>>)>
 205                  <DEST-DECL .DAC .RES FIX>)
 206                 (<==? .ETYP BYTE>
 207                  <PROTECT <SET DAC <GET-AC PREF-VAL T>>>
 208                  <EMIT ,INST-MOVZBL .VOFF <MA-REG .DAC>>
 209                  <DEST-DECL .DAC .RES FIX>)
 210                 (<==? .ETYP BOOLEAN>
 211                  <COND (.BRANCH?
 212                         <BOOL-NTH-BRANCH .VOFF <RED-BIT-NUMBER .RD> .BRANCH?>)
 213                        (<BOOL-NTH .VOFF <RED-BIT-NUMBER .RD> .RES>)>)>)>
 214    NORMAL>
 215
 216 <DEFINE BRANCH-VALUE (VADDR BRANCH? TWO? "AUX" AC)
 217         #DECL ((VADDR) EFF-ADDR (BRANCH?) <LIST ATOM ATOM>)
 218         <SET AC <GET-AC <COND (.TWO? DOUBLE)(ELSE PREF-VAL)> T>>
 219         <EMIT ,INST-MOVL .VADDR
 220               <MA-REG <COND (.TWO? <NEXT-AC .AC>)(ELSE .AC)>>>
 221         <COND (<==? <1 .BRANCH?> ->
 222                <GEN-BRANCH ,INST-BNEQ <2 .BRANCH?> <>>)
 223               (ELSE
 224                <GEN-BRANCH ,INST-BEQL <2 .BRANCH?> <>>)>
 225         .AC>
 226
 227 <DEFINE BRANCH-HW (VADDR BRANCH? "AUX" (AC <GET-AC PREF-VAL T>))
 228         #DECL ((VADDR) EFF-ADDR (BRANCH?) <LIST ATOM ATOM>)
 229         <EMIT ,INST-CVTWL .VADDR <MA-REG .AC>>
 230         <COND (<==? <1 .BRANCH?> ->
 231                <GEN-BRANCH ,INST-BGEQ <2 .BRANCH?> <>>)
 232               (ELSE
 233                <GEN-BRANCH ,INST-BLSS <2 .BRANCH?> <>>)>
 234         .AC>
 235
 236 <DEFINE RANY-OFF (RES TCOFF VOFF VAC "AUX" TAC)
 237         #DECL ((RES) <OR ATOM VARTBL> (TCADDR VADDR) EFF-ADDR (VAC) AC)
 238         <COND (<==? .RES STACK> <EMIT-PUSH .TCOFF DOUBLE>)
 239               (ELSE
 240                <COND (<AND <N==? .VAC ,AC-0>
 241                            <NOT <AC-PROT <SET TAC <PREV-AC .VAC>>>>
 242                            <OR <ALL-DEAD? .TAC> <ALL-STORED? .TAC>>>
 243                       <MUNG-AC .VAC>
 244                       <GET-AC .TAC T>
 245                       <EMIT ,INST-MOVQ .TCOFF <MA-REG .TAC>>)
 246                      (ELSE
 247                       <PROTECT <SET TAC <GET-AC DOUBLE T>>>
 248                       <EMIT ,INST-MOVQ .TCOFF <MA-REG .TAC>>
 249                       <SET VAC <NEXT-AC .TAC>>)>
 250                <DEST-PAIR .VAC .TAC .RES>)>>
 251
 252 <DEFINE TEST-NTH (VADDR TYP VAC RES CADDR HTYP
 253                   "OPT" (HW <>)
 254                   "AUX" FLAB ELAB RVAC RTAC VPUSH (TYPV <>))
 255    #DECL ((VADDR) EFF-ADDR (TYP) ATOM (VAC) AC (RES) <OR ATOM VARTBL>
 256           (CADDR) <OR EFF-ADDR FALSE FIX> (HTYP) <OR FALSE ATOM>)
 257    <COND (<AND .TYP <SET TYPV <MEMQ .TYP ,TYPE-WORDS>>> <SET TYPV <2 .TYPV>>)>
 258    <COND (<TYPE? .RES VARTBL>
 259           <COND (<OR <NOT .HTYP> .CADDR>
 260                  <SET RTAC <GET-AC DOUBLE T>>
 261                  <SET RVAC <NEXT-AC .RTAC>>
 262                  <PROTECT .RTAC>)
 263                 (ELSE <SET RVAC <FIND-APP-AC .VAC .TYP>>)>
 264           <PROTECT .RVAC>)>
 265    <SET ELAB <MAKE-LABEL>>
 266    <SET FLAB <MAKE-LABEL>>
 267    <COND (<NOT .HTYP>
 268           <EMIT <COND (.HW ,INST-TSTW) (ELSE ,INST-TSTL)> .VADDR>
 269           <GEN-BRANCH <COND (.HW ,INST-BGEQ) (ELSE ,INST-BNEQ)> .FLAB <>>
 270           <COND (<==? .RES STACK>
 271                  <EMIT-PUSH <TYPE-WORD FALSE> LONG>
 272                  <CLEAR-PUSH>)
 273                 (ELSE <MOVE-TYPE <> .RTAC> <MOVE-VALUE <> .RVAC>)>
 274           <GEN-BRANCH ,INST-BRB .ELAB <>>
 275           <EMIT-LABEL .FLAB <>>)>
 276    <COND
 277     (<==? .RES STACK>
 278      <COND (.CADDR
 279             <COND (<TYPE? .CADDR FIX>
 280                    <COND (.TYPV
 281                           <SET VPUSH <CHTYPE <ORB .TYPV <LSH .CADDR 16>> FIX>>
 282                           <EMIT-PUSH <MA-IMM .VPUSH> LONG>)
 283                          (ELSE
 284                           <EMIT-PUSH <TYPE-CODE .TYP> WORD>
 285                           <EMIT-PUSH <MA-IMM .CADDR> WORD>)>)
 286                   (ELSE
 287                    <EMIT-PUSH <TYPE-CODE .TYP> WORD>
 288                    <EMIT-PUSH .CADDR WORD>)>)
 289            (<EMIT-PUSH <TYPE-WORD .TYP> LONG>)>
 290      <COND (.HW <EMIT ,INST-MOVZWL .VADDR <MA-AINC ,AC-TP>>)
 291            (ELSE <EMIT-PUSH .VADDR LONG>)>)
 292     (ELSE
 293      <COND
 294       (<NOT .HTYP>
 295        <COND
 296         (<AND <TYPE? .CADDR FIX> <TYPE? .TYPV FIX>>
 297          <SET VPUSH <CHTYPE <ORB .TYPV <LSH .CADDR 16>> FIX>>
 298          <LOAD-CONSTANT .RTAC .VPUSH>)
 299         (ELSE
 300          <COND
 301           (.CADDR
 302            <COND (<TYPE? .CADDR FIX>
 303                   <LOAD-CONSTANT .RTAC <MA-IMM <CHTYPE <LSH .CADDR 16> FIX>>>
 304                   <EMIT ,INST-MOVW <TYPE-CODE .TYP> <MA-REG .RTAC>>)
 305                  (ELSE <EMIT ,INST-MOVL .CADDR <MA-REG .RTAC>>)>)
 306           (ELSE <EMIT ,INST-MOVL <TYPE-WORD .TYP> <MA-REG .RTAC>>)>
 307          <USE-AC .RTAC>)>)
 308       (ELSE
 309        <COND (<TYPE? .CADDR FIX> <LOAD-CONSTANT .RTAC .CADDR>)
 310              (.CADDR <MOVE-TO-AC .RTAC .CADDR WORD>)>)>
 311      <COND (.HW <EMIT ,INST-MOVZWL .VADDR <MA-REG .RVAC>>)
 312            (ELSE <EMIT-MOVE .VADDR <MA-REG .RVAC> LONG>)>)>
 313    <COND (<NOT .HTYP>
 314           <EMIT-LABEL .ELAB <>>
 315           <AND <TYPE? .RES VARTBL> <DEST-PAIR .RVAC .RTAC .RES>>)
 316          (<TYPE? .RES VARTBL>
 317           <COND (.CADDR <DEST-COUNT-DECL .RVAC .RTAC .RES .TYP>)
 318                 (ELSE <DEST-DECL .RVAC .RES .TYP>)>)>>
 319
 320 <DEFINE FIND-APP-AC (VAC TYP "OPTIONAL" (RES <>))
 321         #DECL ((VAC) AC (TYP) <OR FALSE ATOM>)
 322         <COND (<OR <NOT .TYP> <STRUCTURED-TYPE? .TYP>>
 323                <COND (<FREE-VALUE-AC? STORED> <GET-AC PREF-VAL T>)
 324                      (ELSE <MUNG-AC .VAC> .VAC)>)
 325               (<GET-AC PREF-VAL T>)>>
 326
 327 <DEFINE GEN-NTH (VADDR TYP VAC RES CADDR
 328                  "OPT" (HW <>) (RTAC <>) (RVAC <>)
 329                  "AUX" VPUSH (NO-LOAD <>))
 330         #DECL ((VADDR) EFF-ADDR (TYP) ATOM (VAC) AC (RES) <OR ATOM VARTBL>
 331                (CADDR) <OR EFF-ADDR FALSE FIX>)
 332         <COND (<==? .RES STACK>
 333                <COND (<AND <TYPE? .CADDR FIX> <MEMQ .TYP ,TYPE-WORDS>>
 334                       <SET VPUSH
 335                            <CHTYPE <ORB <TYPE-CODE .TYP VALUE> <LSH .CADDR 16>>
 336                                    FIX>>
 337                       <EMIT-PUSH <MA-IMM .VPUSH> LONG>)
 338                      (.CADDR
 339                       <EMIT-PUSH <TYPE-CODE .TYP> WORD>
 340                       <EMIT-PUSH .CADDR WORD>)
 341                      (<EMIT-PUSH <TYPE-WORD .TYP> LONG>)>
 342                <COND (.HW <EMIT ,INST-MOVZWL .VADDR <MA-AINC ,AC-TP>>)
 343                      (ELSE <EMIT-PUSH .VADDR LONG>)>)
 344               (ELSE
 345                <COND (<AND <NOT .RTAC> .CADDR>
 346                       <SET RTAC <GET-AC DOUBLE T>>
 347                       <PROTECT <SET RVAC <NEXT-AC .RTAC>>>)
 348                      (<NOT .RVAC> <PROTECT <SET RVAC <FIND-APP-AC .VAC .TYP>>>)
 349                      (ELSE <SET NO-LOAD T>)>
 350                <COND (.CADDR
 351                       <COND (<TYPE? .CADDR FIX> <LOAD-CONSTANT .RTAC .CADDR>)
 352                             (ELSE <EMIT ,INST-MOVZWL .CADDR <MA-REG .RTAC>>)>
 353                       <COND (<NOT .NO-LOAD>
 354                              <EMIT-MOVE .VADDR <MA-REG .RVAC> LONG>)>
 355                       <DEST-COUNT-DECL .RVAC .RTAC .RES .TYP>)
 356                      (<NOT .NO-LOAD>
 357                       <COND (.HW <EMIT ,INST-MOVZWL .VADDR <MA-REG .RVAC>>)
 358                             (ELSE
 359                              <EMIT-MOVE .VADDR <MA-REG .RVAC> LONG>)>
 360                       <DEST-DECL .RVAC .RES .TYP>)
 361                      (ELSE
 362                       <DEST-DECL .RVAC .RES .TYP>)>
 363                <LOAD-AC .RVAC .VADDR>)>>
 364
 365 <DEFINE BOOL-NTH (VADDR BNO RES "AUX" ELAB FLAB RVAC RTAC)
 366         #DECL ((VADDR) EFF-ADDR (BNO) FIX (RES) <OR ATOM VARTBL>
 367                (BRANCH?) <OR LIST FALSE>)
 368         <SET ELAB <MAKE-LABEL>>
 369         <SET FLAB <MAKE-LABEL>>
 370         <COND (<TYPE? .RES VARTBL>
 371                <SET RTAC <GET-AC PREF-TYPE>>
 372                <SET RVAC <GET-AC PREF-VAL>>
 373                <DEST-PAIR .RVAC .RTAC .RES>)>
 374         <GEN-BRANCH ,INST-BBC <MA-IMM .BNO> .VADDR  .FLAB <>>
 375         <COND (<==? .RES STACK>
 376                <EMIT-PUSH <ADDR-TYPE-MQUOTE T> LONG>
 377                <EMIT-PUSH <ADDR-VALUE-MQUOTE T> LONG>)
 378               (ELSE <MOVE-TYPE T .RTAC> <MOVE-VALUE T .RVAC>)>
 379         <GEN-BRANCH ,INST-BRB .ELAB <>>
 380         <EMIT-LABEL .FLAB <>>
 381         <COND (<==? .RES STACK>
 382                <EMIT-PUSH <TYPE-WORD FALSE> LONG>
 383                <CLEAR-PUSH>)
 384               (ELSE <MOVE-TYPE <> .RTAC> <MOVE-VALUE <> .RVAC>)>
 385         <EMIT-LABEL .ELAB <>>>
 386
 387 <DEFINE BOOL-NTH-BRANCH (VADDR BNO BRANCH)
 388         #DECL ((VADDR) EFF-ADDR (BNO) FIX (BRANCH) <LIST ATOM ATOM>)
 389         <EMIT ,INST-BTST NO-SIZE-WORD .VADDR <EXTWORD-DATA .BNO>>
 390         <COND (<==? <1 .BRANCH> ->
 391                <GEN-BRANCH ,INST-BBC <MA-IMM .BNO> .VADDR <2 .BRANCH> <>>)
 392               (ELSE
 393                <GEN-BRANCH ,INST-BBS <MA-IMM .BNO> .VADDR <2 .BRANCH> <>>)>>
 394
 395 <DEFINE COUNT-STORE-REC (VAL TCADDR "AUX" (LV <FIND-CACHE-VAR .VAL>) AC)
 396         #DECL ((VAL) VARTBL)
 397         <COND (<OR <NOT .LV>
 398                    <LINKVAR-COUNT-STORED .LV>
 399                    <LINKVAR-COUNT-AC .LV>>
 400                <EMIT-MOVE <VAR-COUNT-ADDRESS .VAL> .TCADDR WORD>)
 401               (<SET AC <LINKVAR-TYPE-WORD-AC .LV>>
 402                <EMIT ,INST-ROTL <MA-BYTE-IMM 16> <MA-REG .AC>
 403                      <MA-REG <SET AC <GET-AC ANY-AC T>>>>
 404                <EMIT-MOVE <MA-REG .AC> .TCADDR WORD>)>>
 405