mim/development/mim/vaxc/acmerge.mud

   1 <COND (<NOT <GASSIGNED? INST-NULLF>>
   2        <SETG INST-NULLF <CHTYPE <LSH ,INST-NULL 24> FIX>>)>
   3
   4 <DEFINE SAVE-LOAD-STATE ()
   5         #DECL ((VALUE) SLOAD-STATE)
   6         <MAPF ,VECTOR
   7               <FCN (AC)
   8                    <AND <NOT <AC-USE .AC>>
   9                         <CHTYPE <VECTOR <AC-LLOAD .AC> <AC-LLOAD-EA .AC>>
  10                                 AC-LOAD-STATE>>>
  11               ,ALL-ACS>>
  12
  13 <DEFINE SET-AC-LOAD-STATE (LSTATE)
  14         #DECL ((LSTATE) SLOAD-STATE)
  15         <MAPF <>
  16               <FCN (AC ACLS)
  17                    <COND (.ACLS
  18                           <PUT .AC ,AC-USE <>>
  19                           <PUT .AC ,AC-LLOAD <ACL-LLOAD .ACLS>>
  20                           <PUT .AC ,AC-LLOAD-EA <ACL-LLOAD-EA .ACLS>>)
  21                          (<PUT .AC ,AC-USE T>
  22                           <PUT .AC ,AC-LLOAD <>>
  23                           <PUT .AC ,AC-LLOAD-EA <>>)>>
  24               ,ALL-ACS
  25               .LSTATE>>
  26
  27 <DEFINE SAVE-STATE ("AUX" (CACHE ,VARIABLE-CACHE))
  28         #DECL ((SSTATE) <OR FALSE VECTOR> (VALUE) <PRIMTYPE VECTOR>)
  29         <MAPF ,VECTOR <FCN (LVAR) <COPY-LINKVAR .LVAR>> .CACHE>>
  30
  31 <DEFINE PAIR-MERGE-STATE (SSTATE1 SSTATE2
  32                           "OPTIONAL" (SSTATE <>) LEN
  33                           "AUX" LKV2)
  34         #DECL ((SSTATE1 SSTATE2) AC-STATE
  35                (SSTATE) <OR FALSE <PRIMTYPE VECTOR>>)
  36         <SET LEN <MAX <LENGTH .SSTATE1> <LENGTH .SSTATE2>>>
  37         <COND (.SSTATE <SET SSTATE <ADJUST-LENGTH .SSTATE .LEN>>)
  38               (ELSE <SET SSTATE <IVECTOR .LEN>>)>
  39         <SET SSTATE <REST .SSTATE <LENGTH .SSTATE>>>
  40         <MAPF <>
  41               <FCN (LKV1)
  42                    <COND (<SET LKV2 <LINK-FIND .LKV1 .SSTATE2>>
  43                           <COND (<SET LKV2 <ADJUST-LINKS .LKV1 .LKV2>>
  44                                  <SET SSTATE <BACK .SSTATE>>
  45                                  <PUT .SSTATE 1 .LKV2>)>)>>
  46               .SSTATE1>
  47         .SSTATE>
  48
  49 <DEFINE LINK-FIND (LK1 LINKS "AUX" (VAR <LINKVAR-VAR .LK1>))
  50         #DECL ((LK1) LINKVAR (LINKS) <VECTOR [REST LINKVAR]>)
  51         <MAPF <>
  52               <FCN (LK2)
  53                    <COND (<==? <LINKVAR-VAR .LK2> .VAR> <MAPLEAVE .LK2>)>>
  54               .LINKS>>
  55
  56 <DEFINE ADJUST-LINKS (LK1 LK2
  57                       "AUX" DECL (VAC <>) (TAC <>) (TWAC <>) (CAC <>) MXREFS)
  58         #DECL ((LK1 LK2) LINKVAR)
  59         <COND (<==? <LINKVAR-DECL .LK1> <LINKVAR-DECL .LK2>>
  60                <SET DECL <LINKVAR-DECL .LK1>>)
  61               (ELSE <SET DECL <>>)>
  62         <COND (<==? <LINKVAR-TYPE-AC .LK1> <LINKVAR-TYPE-AC .LK2>>
  63                <SET TAC <LINKVAR-TYPE-AC .LK1>>)>
  64         <COND (<==? <LINKVAR-VALUE-AC .LK1> <LINKVAR-VALUE-AC .LK2>>
  65                <SET VAC <LINKVAR-VALUE-AC .LK1>>)>
  66         <COND (<==? <LINKVAR-COUNT-AC .LK1> <LINKVAR-COUNT-AC .LK2>>
  67                <SET CAC <LINKVAR-COUNT-AC .LK1>>)>
  68         <COND (<==? <LINKVAR-TYPE-WORD-AC .LK1> <LINKVAR-TYPE-WORD-AC .LK2>>
  69                <SET TWAC <LINKVAR-TYPE-WORD-AC .LK1>>)>
  70         <COND (<OR .VAC .TAC .TWAC .CAC>
  71                <SET LK1 <COPY-LINKVAR .LK1>>
  72                <PUT .LK1 ,LINKVAR-DECL .DECL>
  73                <PUT .LK1 ,LINKVAR-TYPE-AC .TAC>
  74                <PUT .LK1 ,LINKVAR-VALUE-AC .VAC>
  75                <PUT .LK1 ,LINKVAR-TYPE-WORD-AC .TWAC>
  76                <PUT .LK1 ,LINKVAR-COUNT-AC .CAC>
  77                <SET MXREFS
  78                     <MERGE-XREFS <LINKVAR-POTENTIAL-SAVES .LK1>
  79                                  <LINKVAR-POTENTIAL-SAVES .LK2>>>
  80                <PUT .LK1
  81                     ,LINKVAR-VALUE-STORED
  82                     <AND <LINKVAR-VALUE-STORED .LK1>
  83                          <LINKVAR-VALUE-STORED .LK2>>>
  84                <PUT .LK1
  85                     ,LINKVAR-TYPE-STORED
  86                     <AND <LINKVAR-TYPE-STORED .LK1>
  87                          <LINKVAR-TYPE-STORED .LK2>>>
  88                <PUT .LK1
  89                     ,LINKVAR-COUNT-STORED
  90                     <AND <LINKVAR-COUNT-STORED .LK1>
  91                          <LINKVAR-COUNT-STORED .LK2>>>
  92                <PUT .LK1 ,LINKVAR-POTENTIAL-SAVES .MXREFS>)>>
  93
  94 <DEFINE MERGE-XREFS (LX1 LX2)
  95         #DECL ((LX1 LX2) <LIST [REST XREF-INFO]>)
  96         <MAPF ,LIST
  97               <FCN (XF1) <COND (<MEMQ .XF1 .LX2> <MAPRET .XF1>) (<MAPRET>)>>
  98               .LX1>>
  99
 100 <DEFINE SET-AC-STATE (SSTATE)
 101         #DECL ((SSTATE) AC-STATE)
 102         <FLUSH-VAR-TEMP-DECLS>
 103         <SETG VARIABLE-CACHE <REST ,VARIABLE-CACHE <LENGTH ,VARIABLE-CACHE>>>
 104         <MAPF <>
 105               <FUNCTION (AC "AUX" (VARS <AC-VARS .AC>))
 106                       <USE-AC .AC>
 107                       <PUT .AC ,AC-VARS <REST .VARS <LENGTH .VARS>>>>
 108               ,ALL-ACS>
 109         <MAPF <>
 110               <FCN (LV "AUX" (VAR <LINKVAR-VAR .LV>) DCL)
 111                    <CACHE-VAR .VAR .LV>
 112                    <AND <SET DCL <LINKVAR-DECL .LV>>
 113                         <INDICATE-VAR-TEMP-DECL .VAR .DCL>>>
 114               .SSTATE>
 115         <MAPF <>
 116               <FCN (FLKV "AUX" VAC (LKV <FIND-CACHE-VAR <LINKVAR-VAR .FLKV>>))
 117                    <AND <SET VAC <LINKVAR-VALUE-AC .LKV>>
 118                         <PLACE-LV-IN-AC .VAC .LKV>>
 119                    <AND <SET VAC <LINKVAR-TYPE-AC .LKV>>
 120                         <PLACE-LV-IN-AC .VAC .LKV>>
 121                    <AND <SET VAC <LINKVAR-COUNT-AC .LKV>>
 122                         <PLACE-LV-IN-AC .VAC .LKV>>
 123                    <AND <SET VAC <LINKVAR-TYPE-WORD-AC .LKV>>
 124                         <PLACE-LV-IN-AC .VAC .LKV>>>
 125               .SSTATE>
 126         T>
 127
 128 <DEFINE PROCESS-LABEL-MERGE (LABEL UCB? PATCH
 129                              "AUX" SSTATE NSSTATE (PRE-STATE <>))
 130         #DECL ((LABEL) LABEL-REF (UCB?) BOOLEAN (PATCH) FIX)
 131         <COND (<NOT .UCB?> <SET PRE-STATE <SAVE-STATE>>)>
 132         <SET SSTATE <COMPUTE-MERGE-STATE .PRE-STATE .LABEL>>
 133         <OR .UCB? <ADJUST-PRE-LABEL .PRE-STATE .SSTATE .PATCH>>
 134         <MAPF <>
 135               <FCN (XREF)
 136                    <COND (<SET NSSTATE <XREF-INFO-SAVED-AC-INFO .XREF>>
 137                           <ADJUST-JUMP .XREF .NSSTATE .SSTATE>)>>
 138               <LABEL-REF-XREFS .LABEL>>
 139         <SET SSTATE <COMPUTE-MERGE-STATE .PRE-STATE .LABEL>>
 140         <COND (.SSTATE <SET-AC-STATE .SSTATE>)
 141               (<MAPF <> ,CLEAR-VARS-FROM-AC ,ALL-ACS>)>
 142         <CLEAN-UP-LABEL .LABEL>>
 143
 144 <DEFINE CLEAN-UP-LABEL (LABEL)
 145         #DECL ((LABEL) LABEL-REF)
 146         <MAPF <>
 147               <FCN (JUMP)
 148                    <PUT .JUMP ,XREF-INFO-SAVED-AC-INFO <>>
 149                    <PUT .JUMP ,XREF-INFO-SLSTATE <>>>
 150               <LABEL-REF-XREFS .LABEL>>>
 151
 152 <DEFINE COMPUTE-MERGE-STATE (PSSTATE LABEL "AUX" NSSTATE (SSTATE .PSSTATE))
 153         #DECL ((PSSTATE) <OR FALSE AC-STATE> (LABEL) LABEL-REF)
 154         <MAPF <>
 155               <FCN (XREF)
 156                    <COND (<SET NSSTATE <XREF-INFO-SAVED-AC-INFO .XREF>>
 157                           <COND (<NOT .PSSTATE>
 158                                  <SET PSSTATE .NSSTATE>
 159                                  <SET SSTATE .PSSTATE>)
 160                                 (ELSE
 161                                  <SET SSTATE
 162                                       <PAIR-MERGE-STATE .PSSTATE .NSSTATE>>
 163                                  <SET PSSTATE .SSTATE>)>)>>
 164               <LABEL-REF-XREFS .LABEL>>
 165         .SSTATE>
 166
 167 <DEFINE ADJUST-JUMP (XREF JSSTATE LSSTATE "AUX" SVEC)
 168         #DECL ((XREF) XREF-INFO (JSSTATE LSSTATE) AC-STATE)
 169         <SET-AC-LOAD-STATE <XREF-INFO-SLSTATE .XREF>>
 170         <SET SVEC <GEN-INSERT .JSSTATE .LSSTATE .XREF>>
 171         <SET SVEC
 172              <PRE-INSERT .SVEC
 173                          <XREF-INFO-STATUS .XREF>
 174                          <XREF-INFO-LILEN .XREF>
 175                          <XREF-INFO-CP .XREF>>>
 176         <PUT .XREF ,XREF-INFO-STACK-SAVE-CODE .SVEC>>
 177
 178 <DEFINE PRE-INSERT (CDV STATUS? LILEN CP "AUX" INS1 (INS2 <>) RES)
 179         #DECL ((CDV) CODEVEC (STATUS?) ANY (LILEN CP) FIX)
 180         <COND (<OR <==? .STATUS? UNCONDITIONAL-BRANCH> <EMPTY? .CDV>> .CDV)
 181               (ELSE
 182                <SET INS1 <NTH-CODE <- .CP .LILEN>>>
 183                <COND (<G=? .LILEN 2>
 184                       <SET INS2
 185                            <REPEAT ((L ()) (NLILEN 0)) #DECL ((L) LIST)
 186                                    <COND (<G=? <SET NLILEN <+ .NLILEN 1>>
 187                                                .LILEN>
 188                                           <RETURN .L>)>
 189                                    <SET L (<NTH-CODE <- .CP .NLILEN>> !.L)>
 190                                    <PUT-CODE <- .CP .NLILEN> ,INST-NULLF>>>)>
 191                <COND (<TYPE? .STATUS? AC>
 192                       <SET RES <RE-GEN .CDV .STATUS? .INS1 .INS2>>)
 193                      (<==? .LILEN 1> <SET RES <UVECTOR !.CDV .INS1>>)
 194                      (<SET RES <UVECTOR !.CDV .INS1 !.INS2>>)>
 195                <PUT-CODE <- .CP .LILEN> ,INST-NULLF>
 196                .RES)>>
 197
 198 <DEFINE RE-GEN (CDV AC INS1 INS2)
 199         #DECL ((INS1) FIX (INS2) <OR FALSE <LIST [REST FIX]>>
 200                (CDV) CODEVEC (AC) AC)
 201         <SETG RE-GEN-POST ()>
 202         <SETG RE-GEN-PRE ()>
 203         <INT-RE-GEN .CDV .AC <>>
 204         <COND (.INS2 <UVECTOR !,RE-GEN-PRE .INS1 !.INS2 !,RE-GEN-POST>)
 205               (<UVECTOR !,RE-GEN-PRE .INS1 !,RE-GEN-POST>)>>
 206
 207
 208 <DEFINE GET-I-FIELD (X) <CHTYPE <LSH .X -24> FIX>>
 209
 210 <DEFINE GET-S-FIELD (X "AUX" (OP1 <CHTYPE <ANDB <LSH .X -16> *377*> FIX>))
 211         <COND (<==? <CHTYPE <ANDB .OP1 *360*> FIX> ,AM-REG>
 212                <CHTYPE <ANDB .OP1 *17*> FIX>)
 213               (ELSE -1)>>
 214
 215 <DEFINE INT-RE-GEN (CDV AC PSAVE)
 216         #DECL ((AC) AC (CDV) CODEVEC (PSAVE) <OR FALSE PTN-SAVE>)
 217         <REPEAT (IFLD IREG INST)
 218                 <COND (<EMPTY? .CDV> <RETURN>)>
 219                 <SET IFLD <GET-I-FIELD <SET INST <1 .CDV>>>>
 220                 <SET IREG <GET-S-FIELD .INST>>
 221                 <COND (<==? .IFLD ,INST-PSTORE>
 222                        <SET PSAVE <GET-PTNS <CHTYPE <ANDB .INST
 223                                                           *377777*> FIX>>>
 224                        <PSTORE-RE-GEN <PTNS-CODE .PSAVE> .AC .PSAVE .INST>
 225                        <SET CDV <REST .CDV>>)
 226                       (<AND <OR <==? .IFLD ,INST-MOVW>
 227                                 <==? .IFLD ,INST-MOVL>
 228                                 <==? .IFLD ,INST-MOVB>>
 229                             <==? .IREG <AC-NUMBER .AC>>>
 230                        <GROUP-INST POST .PSAVE .INST (<2 .CDV>)>
 231                        <SET CDV <REST .CDV 2>>)
 232                       (ELSE
 233                        <COND (<OR <==? .IFLD ,INST-MOVB>
 234                                   <==? .IFLD ,INST-MOVW>
 235                                   <==? .IFLD ,INST-MOVL>>
 236                               <GROUP-INST PRE .PSAVE .INST (<2 .CDV>)>
 237                               <SET CDV <REST .CDV 2>>)
 238                              (ELSE
 239                               <GROUP-INST PRE .PSAVE .INST <>>
 240                               <SET CDV <REST .CDV>>)>)>>>
 241
 242 <DEFINE PSTORE-RE-GEN (CDV AC PSAVE INST)
 243         #DECL ((AC) AC (CDV) CODEVEC (PSAVE) <OR FALSE PTN-SAVE> (INST) FIX)
 244         <COND (<==? <TEST-PRE-POST .CDV .AC> ALL-PRE>
 245                <GROUP-INST PRE <> .INST <>>)
 246               (<==? <TEST-PRE-POST .CDV .AC> ALL-POST>
 247                <GROUP-INST POST <> .INST <>>)
 248               (<INT-RE-GEN .CDV .AC .PSAVE>)>>
 249
 250 <DEFINE TEST-PRE-POST (CDV AC "AUX" (MODE <>))
 251         #DECL ((AC) AC (CDV) CODEVEC)
 252         <REPEAT (IFLD IREG IMOD INST)
 253                 <COND (<EMPTY? .CDV> <RETURN .MODE>)>
 254                 <SET IFLD <GET-I-FIELD <SET INST <1 .CDV>>>>
 255                 <SET IREG <GET-S-FIELD .INST>>
 256                 <COND (<AND <OR <==? .IFLD ,INST-MOVW> <==? .IFLD ,INST-MOVL>>
 257                             <==? .IREG <AC-NUMBER .AC>>>
 258                        <COND (<N==? .MODE ALL-PRE> <SET MODE ALL-POST>)
 259                              (<RETURN MIXED>)>
 260                        <SET CDV <REST .CDV 2>>)
 261                       (ELSE
 262                        <COND (<==? .MODE ALL-POST> <RETURN MIXED>)
 263                              (<SET MODE ALL-PRE>)>
 264                        <COND (<OR <==? .IFLD ,INST-MOVB>
 265                                   <==? .IFLD ,INST-MOVW>
 266                                   <==? .IFLD ,INST-MOVL>>
 267                               <SET CDV <REST .CDV 2>>)
 268                              (<SET CDV <REST .CDV>>)>)>>>
 269
 270 <DEFINE GROUP-INST (MODE PSAVE INST1 INST2 "AUX" ADD NPSAVE)
 271         #DECL ((MODE) ATOM (PSAVE) <OR FALSE PTN-SAVE> (INST1) FIX
 272                (INST2) <OR FALSE LIST>)
 273         <COND (.PSAVE
 274                <COND (.INST2 <SET ADD <UVECTOR .INST1 !.INST2>>)
 275                      (<SET ADD <UVECTOR .INST1>>)>
 276                <SET NPSAVE <COPY-PSAVE .PSAVE .ADD>>
 277                <COND (<==? .MODE PRE> <SETG RE-GEN-PRE (.NPSAVE !,RE-GEN-PRE)>)
 278                      (<SETG RE-GEN-POST (.NPSAVE !,RE-GEN-POST)>)>)
 279               (ELSE
 280                <COND (<==? .MODE PRE>
 281                       <COND (.INST2
 282                              <SETG RE-GEN-PRE (.INST1 !.INST2 !,RE-GEN-PRE)>)
 283                             (<SETG RE-GEN-PRE (.INST1 !,RE-GEN-PRE)>)>)
 284                      (<COND (.INST2
 285                              <SETG RE-GEN-POST (.INST1 !.INST2 !,RE-GEN-POST)>)
 286                             (<SETG RE-GEN-POST (.INST1 !,RE-GEN-POST)>)>)>)>>
 287
 288 <DEFINE GEN-INSERT (JSSTATE LSSTATE "OPTIONAL" (XREF <>))
 289         #DECL ((JSSTATE LSSTATE) AC-STATE)
 290         <START-CODE-INSERT>
 291         <MAPF <>
 292               <FCN (JLV "AUX" LLV (VAR <LINKVAR-VAR .JLV>))
 293                    <COND (<SET LLV <FIND-CACHE-VAR .VAR .LSSTATE>>
 294                           <CHECK-VALUE-STORED .JLV .LLV .XREF>
 295                           <CHECK-TYPE-STORED .JLV .LLV .XREF>
 296                           <CHECK-COUNT-STORED .JLV .LLV .XREF>)
 297                          (ELSE <ISTORE-VAR .JLV .XREF>)>>
 298               .JSSTATE>
 299         <END-CODE-INSERT>>
 300
 301 <DEFINE ADJUST-PRE-LABEL (JSSTATE LSSTATE PATCH "AUX" SVEC)
 302         #DECL ((JSSTATE LSSTATE) AC-STATE (PATCH) FIX)
 303         <SET SVEC <GEN-INSERT .JSSTATE .LSSTATE>>
 304         <INSERT-PATCH .PATCH .SVEC>>
 305
 306 <DEFINE CHECK-VALUE-STORED (JLV LLV XREF
 307                             "AUX" DADDR VAC (VAR <LINKVAR-VAR .JLV>) SVEC)
 308         #DECL ((JLV LLV) LINKVAR (XREF) <OR FALSE XREF-INFO>)
 309         <COND (<AND <LINKVAR-VALUE-AC .JLV>
 310                     <NOT <LINKVAR-VALUE-AC .LLV>>
 311                     <NOT <LINKVAR-VALUE-STORED .JLV>>>
 312                <START-CODE-INSERT>
 313                <COND (<NOT <SET VAC <LINKVAR-VALUE-AC .JLV>>>
 314                       <ERROR "VARIABLE NOT IN AC" CHECK-VALUE-STORED>)>
 315                <SET DADDR <ADDR-VAR-VALUE .VAR>>
 316                <EMIT-STORE-AC .VAC .DADDR LONG>
 317                <PUT .JLV ,LINKVAR-VALUE-STORED T>
 318                <SET SVEC <END-CODE-INSERT>>
 319                <EMIT-POTENTIAL-STORE .SVEC VALUE .JLV>
 320                <AND .XREF <KILL-STORES .XREF VALUE .VAR>>)>>
 321
 322 <DEFINE KILL-STORES (XREF KIND VAR)
 323         #DECL ((XREF) XREF-INFO (KIND) ATOM (VAR) VARTBL)
 324         <MAPF <>
 325               <FCN (PSAVE)
 326                    <COND (<AND <==? <PTNS-VAR .PSAVE> .VAR>
 327                                <STRONGER-SAVE? .KIND <PTNS-KIND .PSAVE>>>
 328                           <KILL-PSAVE .PSAVE>)>>
 329               <XREF-INFO-PSAVES .XREF>>>
 330
 331 <DEFINE STRONGER-SAVE? (KIND1 KIND2)
 332         #DECL ((KIND1 KIND2) ATOM)
 333         <OR <==? .KIND1 .KIND2>
 334             <==? .KIND1 TYPE-COUNT-VALUE>
 335             <AND <==? .KIND1 TYPE-COUNT>
 336                  <OR <==? .KIND2 TYPE> <==? .KIND2 COUNT>>>
 337             <AND <==? .KIND1 TYPE-VALUE>
 338                  <OR <==? .KIND2 TYPE> <==? .KIND2 VALUE>>>
 339             <AND <==? .KIND1 COUNT-VALUE>
 340                  <OR <==? .KIND2 COUNT> <==? .KIND2 VALUE>>>>>
 341
 342 <DEFINE CHECK-TYPE-STORED (JLV LLV XREF
 343                            "AUX" DADDR TAC DCL (VAR <LINKVAR-VAR .JLV>) SVEC
 344                                  (KIND TYPE))
 345         #DECL ((JLV LLV) LINKVAR (XREF) <OR FALSE XREF-INFO>)
 346         <COND (<AND <NOT <LINKVAR-TYPE-STORED .JLV>>
 347                     <NOT <LINKVAR-DECL .LLV>>
 348                     <NOT <LINKVAR-TYPE-AC .LLV>>
 349                     <NOT <LINKVAR-TYPE-WORD-AC .LLV>>>
 350                <START-CODE-INSERT>
 351                <SET DADDR <ADDR-VAR-TYPE .VAR>>
 352                <PUT .JLV ,LINKVAR-TYPE-STORED T>
 353                <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .JLV>>
 354                       <EMIT-STORE-AC .TAC .DADDR LONG>
 355                       <PUT .JLV ,LINKVAR-COUNT-STORED T>
 356                       <SET KIND TYPE-COUNT>)
 357                      (<SET DCL <LINKVAR-DECL .JLV>>
 358                       <STORE-TYPE .DCL .DADDR>
 359                       <COND (<NOT <COUNT-NEEDED? .DCL>>
 360                              <PUT .JLV ,LINKVAR-COUNT-STORED T>)>)
 361                      (<SET TAC <LINKVAR-TYPE-AC .JLV>>
 362                       <EMIT-STORE-AC .TAC .DADDR WORD>)
 363                      (<ERROR "VARIABLE NOT IN AC" ISTORE-ADDR>)>
 364                <SET SVEC <END-CODE-INSERT>>
 365                <EMIT-POTENTIAL-STORE .SVEC .KIND .JLV>
 366                <AND .XREF <KILL-STORES .XREF .KIND .VAR>>)>>
 367
 368 <DEFINE CHECK-COUNT-STORED (JLV LLV XREF
 369                             "AUX" DADDR TAC DCL SVEC (KIND COUNT)
 370                                   (VAR <LINKVAR-VAR .JLV>))
 371         #DECL ((JLV LLV) LINKVAR (XREF) <OR FALSE XREF-INFO>)
 372         <COND (<AND <NOT <LINKVAR-COUNT-AC .LLV>>
 373                     <NOT <LINKVAR-TYPE-WORD-AC .LLV>>
 374                     <NOT <LINKVAR-COUNT-STORED .JLV>>
 375                     <OR <NOT <SET DCL <LINKVAR-DECL .LLV>>>
 376                         <COUNT-NEEDED? .DCL>>
 377                     <OR <NOT <SET DCL <LINKVAR-DECL .JLV>>>
 378                         <COUNT-NEEDED? .DCL>>>
 379                <START-CODE-INSERT>
 380                <SET DADDR <ADDR-VAR-COUNT <LINKVAR-VAR .JLV>>>
 381                <PUT .JLV ,LINKVAR-COUNT-STORED T>
 382                <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .JLV>>
 383                       <SET DADDR <ADDR-VAR-TYPE <LINKVAR-VAR .JLV>>>
 384                       <EMIT-STORE-AC .TAC .DADDR LONG>
 385                       <PUT .JLV ,LINKVAR-TYPE-STORED T>
 386                       <SET KIND TYPE-COUNT>)
 387                      (<SET TAC <LINKVAR-COUNT-AC .JLV>>
 388                       <EMIT-STORE-AC .TAC .DADDR WORD>)>
 389                <SET SVEC <END-CODE-INSERT>>
 390                <EMIT-POTENTIAL-STORE .SVEC .KIND .JLV>
 391                <AND .XREF <KILL-STORES .XREF .KIND .VAR>>)>>
 392
 393 <DEFINE SETUP-PSAVES (XREF "AUX" (CACHE ,VARIABLE-CACHE))
 394         #DECL ((XREF) XREF-INFO)
 395         <MAPF <>
 396               <FCN (LVAR "AUX" (PSAVES <LINKVAR-POTENTIAL-SAVES .LVAR>))
 397                    <PUT .LVAR ,LINKVAR-POTENTIAL-SAVES (.XREF !.PSAVES)>>
 398               .CACHE>>
 399
 400 <DEFINE LOOP-GEN ("TUPLE" VARS)
 401         #DECL ((VARS) <TUPLE [REST <OR ATOM LIST>]>)
 402         <CLEAR-STATUS>
 403         <MAPR <>
 404               <FCN (MVARS "AUX" (VARLST <1 .MVARS>))
 405                    <COND (<TYPE? .VARLST ATOM>
 406                           <PUT .MVARS 1 <LIST <FIND-VAR .VARLST> VALUE>>)
 407                          (<PUT .MVARS
 408                                1
 409                                (<FIND-VAR <1 .VARLST>> !<REST .VARLST>)>)>>
 410               .VARS>
 411         <SETUP-LOOP-ACS .VARS>
 412         <SETG LOOP-VARS <SAVE-STATE>>
 413         <CLEAR-STATUS>
 414         LOOP-LABEL>
 415
 416 <DEFINE SETUP-LOOP-ACS (VARS "AUX" TAC)
 417    #DECL ((VARS) <TUPLE [REST LIST]>)
 418    <MAPF <>
 419          <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>))
 420               <COND (<NOT <FIND-INFO .VAR .VARS>>
 421                      <ISTORE-VAR .LVAR>
 422                      <DEAD-VAR .VAR>)>>
 423          ,VARIABLE-CACHE>
 424    <MAPF <>
 425          <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>) RVAR NLVAR
 426                           (CS <LINKVAR-COUNT-STORED .LVAR>)
 427                           (VS <LINKVAR-VALUE-STORED .LVAR>)
 428                           (TS <LINKVAR-TYPE-STORED .LVAR>))
 429               <SET RVAR <FIND-INFO .VAR .VARS>>
 430               <SET NLVAR <COPY-LINKVAR .LVAR>>
 431               <AND <MEMQ TYPE .RVAR> <SET TS T>>
 432               <AND <MEMQ VALUE .RVAR> <SET VS T>>
 433               <COND (<MEMQ LENGTH .RVAR>
 434                      <SET CS T>
 435                      <SET TS T>)>
 436               ; "Make sure that if we're storing the type we also store
 437                  the value, so  we don't get garbage pointers on the stack."
 438               <COND (<OR <NOT .VS><NOT .TS><NOT .CS>>
 439                      <ISTORE-VAR .NLVAR>)
 440                     (<LINKVAR-COUNT-STORED .NLVAR .CS>
 441                      <LINKVAR-TYPE-STORED .NLVAR .TS>
 442                      <LINKVAR-VALUE-STORED .NLVAR .VS>)>
 443               <COND (<AND <SET TAC <LINKVAR-TYPE-AC .NLVAR>>
 444                           <NOT <MEMQ TYPE .RVAR>>>
 445                      <AND <LINKVAR-TYPE-AC .LVAR> <BREAK-LINK .TAC .VAR>>
 446                      <PUT .LVAR ,LINKVAR-TYPE-STORED T>)>
 447               <COND (<AND <SET TAC <LINKVAR-COUNT-AC .NLVAR>>
 448                           <NOT <MEMQ LENGTH .RVAR>>>
 449                      <PUT .LVAR ,LINKVAR-COUNT-STORED T>
 450                      <AND <LINKVAR-COUNT-AC .LVAR> <BREAK-LINK .TAC .VAR>>)>
 451               <COND (<AND <SET TAC <LINKVAR-TYPE-WORD-AC .NLVAR>>
 452                           <NOT <MEMQ TYPE .RVAR>>
 453                           <NOT <MEMQ LENGTH .RVAR>>>
 454                      <AND <LINKVAR-TYPE-WORD-AC .LVAR> <BREAK-LINK .TAC .VAR>>
 455                      <PUT .LVAR ,LINKVAR-TYPE-STORED T>
 456                      <PUT .LVAR ,LINKVAR-COUNT-STORED T>)>>
 457          ,VARIABLE-CACHE>
 458    <MAPF <>
 459     <FCN (RVAR "AUX" VAC (VAR <1 .RVAR>) LVAR)
 460          <COND (<VARTBL-ASSIGNED? .VAR>
 461                 <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
 462                        <AND <SET VAC <LINKVAR-TYPE-AC .LVAR>> <PROTECT .VAC>>
 463                        <AND <SET VAC <LINKVAR-COUNT-AC .LVAR>> <PROTECT .VAC>>
 464                        <AND <SET VAC <LINKVAR-TYPE-WORD-AC .LVAR>>
 465                             <PROTECT .VAC>>)>
 466                 <AND <MEMQ VALUE .RVAR> <PROTECT <LOAD-VAR-APP .VAR <>>>>
 467                 <COND (<AND <MEMQ TYPE .RVAR> <MEMQ LENGTH .RVAR>>
 468                        <PROTECT <LOAD-VAR .VAR TYPE-WORD <> PREF-TYPE>>)
 469                       (<MEMQ TYPE .RVAR>
 470                        <PROTECT <LOAD-VAR .VAR TYPE <> PREF-TYPE>>)
 471                       (<MEMQ LENGTH .RVAR>
 472                        <PROTECT <LOAD-VAR .VAR TYPE-WORD <> PREF-TYPE>>)>
 473                 <SET LVAR <FIND-CACHE-VAR .VAR>>
 474                 <LINKVAR-POTENTIAL-SAVES .LVAR ()>
 475                 <AND <MEMQ TYPE .RVAR> <PUT .LVAR ,LINKVAR-TYPE-STORED <>>>
 476                 <AND <MEMQ VALUE .RVAR> <PUT .LVAR ,LINKVAR-VALUE-STORED <>>>
 477                 <AND <MEMQ LENGTH .RVAR>
 478                      <PUT .LVAR ,LINKVAR-COUNT-STORED <>>>)>>
 479     .VARS>
 480    T>
 481
 482 <DEFINE FIND-INFO (VAR VARS)
 483         #DECL ((VAR) VARTBL (VARS) <TUPLE [REST LIST]>)
 484         <MAPF <>
 485               <FCN (RVAR) <COND (<==? .VAR <1 .RVAR>> <MAPLEAVE .RVAR>)>>
 486               .VARS>>
 487
 488 <DEFINE RESTORE-LOOP-STATE (LSTATE)
 489         #DECL ((LSTATE) AC-STATE)
 490         <MAPF <>
 491               <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>) LVAR1)
 492                    <COND (<SET LVAR1 <FIND-CACHE-VAR .VAR .LSTATE>>
 493                           <PROTECT-MATCHES .LVAR .LVAR1>)
 494                          (ELSE <ISTORE-VAR .LVAR <> T> <DEAD-VAR .VAR>)>>
 495               <SAVE-STATE>>
 496         <MAPF <>
 497               <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>) VAC)
 498                    <AND <SET VAC <LINKVAR-VALUE-AC .LVAR>>
 499                         <PROTECT <LP-LOAD-VAR .VAR VALUE <> .VAC>>>
 500                    <AND <SET VAC <LINKVAR-TYPE-AC .LVAR>>
 501                         <PROTECT <LP-LOAD-VAR .VAR TYPE <> .VAC>>>
 502                    <AND <SET VAC <LINKVAR-TYPE-WORD-AC .LVAR>>
 503                         <PROTECT <LP-LOAD-VAR .VAR TYPE-WORD <> .VAC>>>
 504                    <AND <SET VAC <LINKVAR-COUNT-AC .LVAR>>
 505                         <PROTECT <LP-LOAD-VAR .VAR COUNT <> .VAC>>>>
 506               .LSTATE>
 507         <SET-AC-STATE .LSTATE>>
 508
 509 <DEFINE PROTECT-MATCHES (LVAR1 LVAR2 "AUX" VAC (VAR <LINKVAR-VAR .LVAR1>))
 510         #DECL ((LVAR1 LVAR2) LINKVAR)
 511         <AND <LINKVAR-VALUE-AC .LVAR2> <PUT .LVAR1 ,LINKVAR-VALUE-STORED T>>
 512         <AND <LINKVAR-TYPE-AC .LVAR2> <PUT .LVAR1 ,LINKVAR-TYPE-STORED T>>
 513         <AND <LINKVAR-COUNT-AC .LVAR2> <PUT .LVAR2 ,LINKVAR-COUNT-STORED T>>
 514         <AND <LINKVAR-TYPE-WORD-AC .LVAR2>
 515              <PUT .LVAR1 ,LINKVAR-TYPE-STORED T>
 516              <PUT .LVAR1 ,LINKVAR-COUNT-STORED T>>
 517         <COND (<SET VAC <LINKVAR-TYPE-AC .LVAR1>>
 518                <COND (<AND <NOT <LINKVAR-TYPE-AC .LVAR2>>
 519                            <NOT <LINKVAR-TYPE-WORD-AC .LVAR2>>>
 520                       <ISTORE-VAR .LVAR1 <> T>
 521                       <BREAK-LINK .VAC .VAR>)
 522                      (<==? .VAC <LINKVAR-TYPE-AC .LVAR2>> <PROTECT .VAC>)>)>
 523         <COND (<SET VAC <LINKVAR-VALUE-AC .LVAR1>>
 524                <COND (<NOT <LINKVAR-VALUE-AC .LVAR2>>
 525                       <ISTORE-VAR .LVAR1 <> T>
 526                       <BREAK-LINK .VAC .VAR>)
 527                      (<==? .VAC <LINKVAR-VALUE-AC .LVAR2>> <PROTECT .VAC>)>)>
 528         <COND (<SET VAC <LINKVAR-TYPE-WORD-AC .LVAR1>>
 529                <COND (<AND <NOT <LINKVAR-TYPE-WORD-AC .LVAR2>>
 530                            <NOT <LINKVAR-COUNT-AC .LVAR2>>
 531                            <NOT <LINKVAR-TYPE-AC .LVAR2>>>
 532                       <ISTORE-VAR .LVAR1 <> T>
 533                       <BREAK-LINK .VAC .VAR>)
 534                      (<==? .VAC <LINKVAR-TYPE-WORD-AC .LVAR2>>
 535                        <PROTECT .VAC>)>)>
 536         <COND (<SET VAC <LINKVAR-COUNT-AC .LVAR1>>
 537                <COND (<AND <NOT <LINKVAR-COUNT-AC .LVAR2>>
 538                            <NOT <LINKVAR-TYPE-WORD-AC .LVAR2>>>
 539                       <ISTORE-VAR .LVAR1 <> T>
 540                       <BREAK-LINK .VAC .VAR>)
 541                      (<==? .VAC <LINKVAR-COUNT-AC .LVAR2>>
 542                        <PROTECT .VAC>)>)>>
 543
 544 "THE STATUS INFORMATION THAT IS CURRENTLY-GENERATED IS AN ATOM
 545  EITHER NORMAL, UNCONDITIONAL-BRANCH, LOOP-LABEL"
 546
 547 <DEFINE GEN-LABEL (LABEL STATUS "AUX" LREF PATCH)
 548         #DECL ((LABEL STATUS) ATOM)
 549         <COND (<MEMQ .LABEL ,INT-LABELS>
 550                <EMIT-LABEL .LABEL <>>
 551                <MAPF <> ,CLEAR-VARS-FROM-AC ,ALL-ACS>)
 552               (ELSE
 553                 <COND (<MEMQ .LABEL ,ICALL-LABELS>
 554                        <POP-MODEL>
 555                        <SETG ICALL-LEVEL <- ,ICALL-LEVEL 1>>
 556                        <MAPF <> ,CLEAR-VARS-FROM-AC ,ALL-ACS>)>
 557                <AND <N==? .STATUS UNCONDITIONAL-JUMP>
 558                     <SET PATCH <ADD-PATCH LABEL-MERGE>>>
 559                <COND (<==? .STATUS LOOP-LABEL>
 560                       <SET LREF <EMIT-LABEL .LABEL ,LOOP-VARS>>)
 561                      (<SET LREF <EMIT-LABEL .LABEL <>>>)>
 562                <COND (<==? .STATUS UNCONDITIONAL-BRANCH>
 563                       <PROCESS-LABEL-MERGE .LREF T 0>)
 564                      (<PROCESS-LABEL-MERGE .LREF <> .PATCH>)>)>>
 565
 566 <DEFINE GEN-BRANCH (INST LABEL STATUS?
 567                     "OPTIONAL" (ACNUM <>) (FLONG? <>) (NO-KILL <>)
 568                     "AUX" XREF LREF INSRT (LLEN ,LAST-INST-LENGTH)
 569                           (CCOUNT ,CODE-COUNT) LSTATE)
 570         #DECL ((INST CC) FIX (LABEL) <OR ATOM SPEC-LABEL>
 571                (ACNUM) ANY (STATUS?) ANY (FLONG?) BOOLEAN)
 572         <SET XREF <EMIT-BRANCH .INST .LABEL .STATUS? .LLEN .ACNUM .FLONG?>>
 573         <COND (<TYPE? .LABEL SPEC-LABEL>)
 574               (<AND <SET LREF <XREF-INFO-LABEL .XREF>>
 575                     <SET LSTATE <LABEL-REF-LOOP-LABEL .LREF>>>
 576                <START-CODE-INSERT>
 577                <RESTORE-LOOP-STATE .LSTATE>
 578                <SET INSRT <END-CODE-INSERT>>
 579                <SET INSRT <PRE-INSERT .INSRT .STATUS? .LLEN .CCOUNT>>
 580                <PUT .XREF ,XREF-INFO-STACK-SAVE-CODE .INSRT>)
 581               (<NOT <MEMQ .LREF ,OUTST-LABEL-TABLE>>
 582                <ERROR "JUMPING BACK TO A NON-LOOP LABEL" .LREF>)
 583               (ELSE
 584                <COND (<NOT .NO-KILL> <SET-DEATH .CODPTR T>)>
 585                <SAVE-XREF-AC-INFO .XREF <SAVE-STATE> <SAVE-LOAD-STATE>>
 586                <USE-ALL-ACS>
 587                <SETUP-PSAVES .XREF>)>>
 588
 589 <DEFINE LP-LOAD-VAR (VAR TYP MUNG VAC "AUX" TAC LVAR)
 590         #DECL ((VAR) VARTBL (TYP) ATOM (MUNG) BOOLEAN (VAC) AC)
 591         <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
 592                     <OR <AND <==? .TYP TYPE>
 593                              <==? <LINKVAR-TYPE-AC .LVAR> .VAC>>
 594                         <AND <==? .TYP VALUE>
 595                              <==? <LINKVAR-VALUE-AC .LVAR> .VAC>>
 596                         <AND <==? .TYP COUNT>
 597                              <==? <LINKVAR-COUNT-AC .LVAR> .VAC>>
 598                         <AND <==? .TYP TYPE-WORD>
 599                              <==? <LINKVAR-TYPE-WORD-AC .LVAR> .VAC>>>>)
 600               (<NOT <ALL-DEAD? .VAC>>
 601                <COND (<SET TAC <FREE-AC?>>
 602                       <EMIT-EXCH .VAC .TAC>
 603                       <EXCH-AC .TAC .VAC>)>)>
 604         <LOAD-VAR .VAR .TYP .MUNG .VAC>>