mim/development/mim/vaxc/ac.mud

   1
   2 <DEFINE CREATE-AC (NAME NUM "AUX" RNUM LVS)
   3         #DECL ((NAME) ATOM (NUM) FIX)
   4         <SET LVS <IVECTOR ,NUMVARS-AC>>
   5         <SET LVS <REST .LVS ,NUMVARS-AC>>
   6         <CHTYPE [.NAME .NUM 0 <> .NUM <> <> .LVS <>] AC>>
   7
   8 <DEFINE INITIALIZE-ACS ("AUX" (NUM -1))
   9         <MAPF <>
  10               <FUNCTION (ATM1 ATM2 NUM-SYM)
  11                       <SETG .ATM1 <CREATE-AC .ATM2 <SET NUM <+ .NUM 1>>>>
  12                       <COND (<TYPE? .NUM-SYM ATOM> <SETG .NUM-SYM .NUM>)>>
  13               '[AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6 AC-7 AC-8 AC-9 AC-10 AC-M
  14                  AC-F AC-TP AC-P AC-PC]
  15               '[AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6 AC-7 AC-8 AC-9 AC-10 M F TP
  16                  P PC]
  17               '[0 0 0 0 0 0 0 0 0 0 0 NAC-M NAC-F NAC-TP NAC-P NAC-PC]>
  18         <SETG ALL-ACS
  19               [,AC-0
  20                ,AC-1
  21                ,AC-2
  22                ,AC-3
  23                ,AC-4
  24                ,AC-5
  25                ,AC-6
  26                ,AC-7
  27                ,AC-8
  28                ,AC-9
  29                ,AC-10]>
  30         <SETG VAL-ACS [,AC-1 ,AC-3 ,AC-5 ,AC-7 ,AC-9]>
  31         <SETG TYPE-ACS [,AC-0 ,AC-2 ,AC-4 ,AC-6 ,AC-8]>
  32         <SETG AC-TIME 0>
  33         <INIT-VARIABLE-CACHE>>
  34
  35 <DEFINE RESET-AC-STACK-MODEL ("AUX" (CACHE ,VARIABLE-CACHE))
  36         <MAPF <>
  37               <FCN (AC "AUX" (VARS <AC-VARS .AC>))
  38                    <PUT .AC ,AC-VARS <REST .VARS <LENGTH .VARS>>>>
  39               ,ALL-ACS>
  40         <SETG VARIABLE-CACHE <REST .CACHE <LENGTH .CACHE>>>
  41         <INIT-STACK-MODEL>
  42         <INIT-VAR-LIST>
  43         <SETG STATUS-AC <>>
  44         <SETG STATUS-VAR <>>>
  45
  46 <DEFINE CLEAR-DEATH ()
  47         <MAPF <> <FCN (VAR) <PUT .VAR ,VARTBL-DEAD? <>>> ,VAR-LIST>>
  48
  49 <DEFINE INDICATE-ALL-DEAD ()
  50         <MAPF <> <FCN (VAR) <PUT .VAR ,VARTBL-DEAD? T>> ,VAR-LIST>>
  51
  52 <DEFINE SAFE-DEAD-VAR ("TUPLE" VARS)
  53         #DECL ((VARS) <TUPLE [REST <OR VARTBL ATOM>]>)
  54         <MAPF <>
  55           <FUNCTION (VAR "AUX" LV VAC CAC TAC TWAC)
  56             <COND
  57              (<TYPE? .VAR VARTBL>
  58               <COND (<AND <SET LV <FIND-CACHE-VAR .VAR>>
  59                           <OR <NOT <VARTBL-RDECL .VAR>>
  60                               <NOT <LINKVAR-DECL .LV>>
  61                               <COUNT-NEEDED? <LINKVAR-DECL .LV>>>>
  62                      <COND (<OR <AND <LINKVAR-COUNT-STORED .LV>
  63                                      <NOT <LINKVAR-VALUE-STORED .LV>>>
  64                                 <AND <LINKVAR-TYPE-STORED .LV>
  65                                      <NOT <LINKVAR-VALUE-STORED .LV>>>
  66                                 <AND <LINKVAR-VALUE-STORED .LV>
  67                                      <OR <NOT <LINKVAR-COUNT-STORED .LV>>
  68                                          <NOT <LINKVAR-TYPE-STORED .LV>>>>>
  69                             <EMIT ,INST-CLRL <ADDR-VAR-TYPE .VAR>>)>)>
  70               <DEAD-VAR .VAR>)>>
  71           .VARS>
  72         NORMAL>
  73
  74 <DEFINE DEAD-VAR ("TUPLE" VARS)
  75         #DECL ((VARS) <TUPLE [REST <OR VARTBL ATOM>]>)
  76         <MAPF <>
  77               <FCN (VAR)
  78                    <COND (<TYPE? .VAR VARTBL>
  79                           <MAPF <>
  80                                 <FCN (AC) <BREAK-LINK .AC .VAR>>
  81                                 ,ALL-ACS>)>>
  82               .VARS>
  83         NORMAL>
  84
  85 <DEFINE USE-ALL-ACS () <MAPF <> ,USE-AC ,ALL-ACS>>
  86
  87 <GDECL (EMPTY-VAR) VARTBL (EMPTY-LINKVAR) LINKVAR>
  88
  89 <DEFINE CREATE-LINKVAR (VAR)
  90         #DECL ((VAR) VARTBL)
  91         <CHTYPE <VECTOR .VAR <> <> <> <> <> <> <> <> ()> LINKVAR>>
  92
  93 <DEFINE COPY-LINKVAR (LV)
  94         #DECL ((LV) LINKVAR)
  95         <CHTYPE <VECTOR <LINKVAR-VAR .LV>
  96                         <LINKVAR-VALUE-STORED .LV>
  97                         <LINKVAR-COUNT-STORED .LV>
  98                         <LINKVAR-TYPE-STORED .LV>
  99                         <LINKVAR-DECL .LV>
 100                         <LINKVAR-VALUE-AC .LV>
 101                         <LINKVAR-TYPE-AC .LV>
 102                         <LINKVAR-COUNT-AC .LV>
 103                         <LINKVAR-TYPE-WORD-AC .LV>
 104                         <LINKVAR-POTENTIAL-SAVES .LV>>
 105                 LINKVAR>>
 106
 107 "THIS OPERATION SAYS THAT THE TYPE-WORD, VALUE-WORD, COUNT, OR TYPE
 108  OF A VARIABLE IS IN AN AC"
 109
 110 <DEFINE LINK-VAR-TO-AC (VAR AC KIND
 111                         "OPTIONAL" (STORED? <>) (FLUSH-DECL T)
 112                         "AUX" PAC LV (TIN? <>) (CIN? <>) (VIN? <>))
 113         #DECL ((LV) LINKVAR (AC) AC (SV) <OR ATOM FALSE>)
 114         <SET LV <CACHE-VAR .VAR>>
 115         <COND (<OR <LINKVAR-TYPE-AC .LV> <LINKVAR-TYPE-WORD-AC .LV>>
 116                <SET TIN? T>)>
 117         <COND (<OR? <LINKVAR-COUNT-AC .LV> <LINKVAR-TYPE-WORD-AC .LV>>
 118                <SET CIN? T>)>
 119         <COND (<LINKVAR-VALUE-AC .LV> <SET VIN? T>)>
 120         <PLACE-LV-IN-AC .AC .LV>
 121         <COND (<==? .KIND TYPE-VALUE-PAIR> <PLACE-LV-IN-AC <NEXT-AC .AC> .LV>)>
 122         <AND .FLUSH-DECL <INDICATE-VAR-TEMP-DECL .VAR <>>>
 123         <COND (<==? .KIND TYPE-VALUE-PAIR>
 124                <AND <SET PAC <LINKVAR-TYPE-WORD-AC .LV>>
 125                     <REMOVE-LV-FROM-AC .PAC .LV>>
 126                <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC>
 127                <SET AC <NEXT-AC .AC>>
 128                <AND <SET PAC <LINKVAR-VALUE-AC .LV>>
 129                     <REMOVE-LV-FROM-AC .PAC .LV>>
 130                <PUT .LV ,LINKVAR-VALUE-AC .AC>)
 131               (<==? .KIND VALUE>
 132                <AND <SET PAC <LINKVAR-VALUE-AC .LV>>
 133                     <REMOVE-LV-FROM-AC .PAC .LV>>
 134                <PUT .LV ,LINKVAR-VALUE-AC .AC>)
 135               (<==? .KIND TYPE>
 136                <AND <SET PAC <LINKVAR-TYPE-AC .LV>>
 137                     <REMOVE-LV-FROM-AC .PAC .LV>>
 138                <PUT .LV ,LINKVAR-TYPE-AC .AC>)
 139               (<==? .KIND TYPE-WORD>
 140                <AND <SET PAC <LINKVAR-TYPE-WORD-AC .LV>>
 141                     <REMOVE-LV-FROM-AC .PAC .LV>>
 142                <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC>)
 143               (<==? .KIND COUNT>
 144                <AND <SET PAC <LINKVAR-COUNT-AC .LV>>
 145                     <REMOVE-LV-FROM-AC .PAC .LV>>
 146                <PUT .LV ,LINKVAR-COUNT-AC .AC>)
 147               (<ERROR BAD-MODE .KIND LINK-VAR-TO-AC>)>
 148         <COND (<N==? .STORED? NO-CHANGE>
 149                <OR .VIN? <PUT .LV ,LINKVAR-VALUE-STORED .STORED?>>
 150                <OR .TIN? <PUT .LV ,LINKVAR-TYPE-STORED .STORED?>>
 151                <OR .CIN? <PUT .LV ,LINKVAR-COUNT-STORED .STORED?>>)>>
 152
 153 <DEFINE PLACE-LV-IN-AC (AC LV "AUX" (VARS <AC-VARS .AC>))
 154         #DECL ((AC) AC (LV) LINKVAR)
 155         <COND (<NOT <MEMQ .LV .VARS>>
 156                <COND (<==? <TOP .VARS> .VARS> <SET VARS [.LV !.VARS]>)
 157                      (ELSE <SET VARS <BACK .VARS>> <PUT .VARS 1 .LV>)>
 158                <AND <G? <LENGTH .VARS> 1> <USE-AC .AC>>
 159                <PUT .AC ,AC-VARS .VARS>)>>
 160
 161 <DEFINE REMOVE-LV-FROM-AC (AC LV "AUX" (VARS <AC-VARS .AC>))
 162         #DECL ((LV) LINKVAR (AC) AC)
 163         <PUT .AC ,AC-VARS <REMOVE-LINKVAR .LV .VARS>>>
 164
 165 <DEFINE INDICATE-CACHED-VARIABLE-DECL (VAR DECL "AUX" LV)
 166         #DECL ((VAR) VARTBL (DECL) <OR FALSE ATOM>)
 167         <SET LV <FIND-CACHE-VAR .VAR>>
 168         <COND (.LV
 169                <PUT .LV ,LINKVAR-DECL .DECL>
 170                <INDICATE-VAR-TEMP-DECL .VAR .DECL>)>>
 171
 172 <DEFINE INDICATE-CACHED-VARIABLE-STORED (VAR STORED? TYP "AUX" LV)
 173         #DECL ((VAR) VARTBL (STORED?) <OR FALSE ATOM> (TYP) ATOM)
 174         <SET LV <FIND-CACHE-VAR .VAR>>
 175         <AND .LV
 176              <COND (<==? .TYP TYPE> <PUT .LV ,LINKVAR-TYPE-STORED .STORED?>)
 177                    (<==? .TYP VALUE> <PUT .LV ,LINKVAR-VALUE-STORED .STORED?>)
 178                    (<==? .TYP COUNT> <PUT .LV ,LINKVAR-COUNT-STORED .STORED?>)>
 179              <PUT .LV ,LINKVAR-DECL .TYP>>>
 180
 181 <DEFINE INIT-VARIABLE-CACHE ("AUX" RES)
 182         <INIT-VAR-LIST>
 183         <SETG EMPTY-VAR <CREATE-VAR \  T>>
 184         <SETG EMPTY-LINKVAR <CREATE-LINKVAR ,EMPTY-VAR>>
 185         <SET RES <IVECTOR ,CACHE-LENGTH ,EMPTY-LINKVAR>>
 186         <SETG VARIABLE-CACHE <REST .RES <LENGTH .RES>>>>
 187
 188 <DEFINE FIND-CACHE-VAR (VAR "OPTIONAL" (CACHE ,VARIABLE-CACHE))
 189         #DECL ((VAR) VARTBL (CACHE) AC-STATE)
 190         <MAPF <>
 191               <FCN (LV) <AND <==? <LINKVAR-VAR .LV> .VAR> <MAPLEAVE .LV>>>
 192               .CACHE>>
 193
 194 <DEFINE VAR-VALUE-IN-AC? (VAR "AUX" LVAR)
 195         #DECL ((VAR) VARTBL)
 196         <SET LVAR <FIND-CACHE-VAR .VAR>>
 197         <AND .LVAR <LINKVAR-VALUE-AC .LVAR>>>
 198
 199 <DEFINE VAR-TYPE-IN-AC? (VAR "AUX" LVAR)
 200         #DECL ((VAR) VARTBL)
 201         <SET LVAR <FIND-CACHE-VAR .VAR>>
 202         <AND .LVAR <OR <LINKVAR-TYPE-AC .LVAR> <LINKVAR-TYPE-WORD-AC .LVAR>>>>
 203
 204 <DEFINE VAR-COUNT-IN-AC? (VAR "AUX" LVAR)
 205         #DECL ((VAR) VARTBL)
 206         <SET LVAR <FIND-CACHE-VAR .VAR>>
 207         <AND .LVAR <LINKVAR-COUNT-AC .LVAR>>>
 208
 209 <DEFINE VAR-TYPE-WORD-IN-AC? (VAR "AUX" LVAR)
 210         #DECL ((VAR) VARTBL)
 211         <SET LVAR <FIND-CACHE-VAR .VAR>>
 212         <AND .LVAR <LINKVAR-TYPE-WORD-AC .LVAR>>>
 213
 214 <DEFINE VAR-COUNT-STORED? (VAR "AUX" LVAR)
 215         <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
 216                <AND <LINKVAR-COUNT-STORED .LVAR> <ADDR-VAR-COUNT .VAR>>)
 217               (<ADDR-VAR-COUNT .VAR>)>>
 218
 219 <DEFINE SAFE-TYPE-WORD? (VAR "AUX" LVAR)
 220         #DECL ((VAR) VARTBL)
 221         <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
 222                <OR <LINKVAR-TYPE-WORD-AC .LVAR>
 223                    <AND <LINKVAR-TYPE-STORED .LVAR>
 224                         <LINKVAR-COUNT-STORED .LVAR>>
 225                    <AND <VARTBL-RDECL .VAR>
 226                         <NOT <COUNT-NEEDED? <LINKVAR-DECL .LVAR>>>>>)
 227               (T)>>
 228
 229 <DEFINE CACHE-VAR (VAR "OPTIONAL" (LVC <>) "AUX" RES CACHE)
 230         #DECL ((VAR) VARTBL (LVC) <OR FALSE LINKVAR>)
 231         <COND (<SET RES <FIND-CACHE-VAR .VAR>>)
 232               (ELSE
 233                <SET CACHE ,VARIABLE-CACHE>
 234                <COND (.LVC <SET RES <COPY-LINKVAR .LVC>>)
 235                      (<SET RES <CREATE-LINKVAR .VAR>>)>
 236                <COND (<==? .CACHE <TOP .CACHE>> <SET CACHE [.RES !.CACHE]>)
 237                      (ELSE <SET CACHE <BACK .CACHE>> <PUT .CACHE 1 .RES>)>
 238                <SETG VARIABLE-CACHE .CACHE>)>
 239         .RES>
 240
 241 <DEFINE BREAK-LINK (AC VAR "AUX" (VARS <AC-VARS .AC>) LV)
 242         #DECL ((AC) AC (VAR) VARTBL)
 243         <COND (<SET LV <FIND-CACHE-VAR .VAR .VARS>>
 244                <REMOVE-LV-FROM-AC .AC .LV>
 245                <COND (<==? <LINKVAR-VALUE-AC .LV> .AC>
 246                       <PUT .LV ,LINKVAR-VALUE-AC <>>)
 247                      (<==? <LINKVAR-TYPE-AC .LV> .AC>
 248                       <PUT .LV ,LINKVAR-TYPE-AC <>>)
 249                      (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC>
 250                       <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)
 251                      (<==? <LINKVAR-COUNT-AC .LV> .AC>
 252                       <PUT .LV ,LINKVAR-COUNT-AC <>>)>
 253                <COND (<AND <NOT <LINKVAR-VALUE-AC .LV>>
 254                            <NOT <LINKVAR-TYPE-AC .LV>>
 255                            <NOT <LINKVAR-TYPE-WORD-AC .LV>>
 256                            <NOT <LINKVAR-COUNT-AC .LV>>>
 257                       <REMOVE-VAR-FROM-CACHE .LV>)>)>>
 258
 259 <DEFINE REMOVE-VAR-FROM-CACHE (LV)
 260         <SETG VARIABLE-CACHE <REMOVE-LINKVAR .LV ,VARIABLE-CACHE>>>
 261
 262 <DEFINE REMOVE-LINKVAR (LV "OPTIONAL" (CACHE ,VARIABLE-CACHE) "AUX" LVS DIST)
 263         #DECL ((LV) LINKVAR (CACHE) <VECTOR [REST LINKVAR]>)
 264         <SET LVS <MEMQ .LV .CACHE>>
 265         <COND (.LVS
 266                <SET DIST <- <LENGTH .CACHE> <LENGTH .LVS>>>
 267                <AND <G? .DIST 0> <SUBSTRUC .CACHE 0 .DIST <REST .CACHE>>>
 268                <REST .CACHE>)
 269               (.CACHE)>>
 270
 271 <DEFINE CLEAR-VARS-FROM-AC (AC "OPTIONAL" (SAVE? <>) (ALL? <>)
 272                             "AUX" (VARS <AC-VARS .AC>))
 273         <MAPF <> <FCN (LV "AUX" TAC)
 274                       #DECL ((LV) LINKVAR)
 275                       <COND (<N==? .LV .SAVE?>
 276                              <BREAK-LINK .AC <LINKVAR-VAR .LV>>
 277                              <COND (.ALL?
 278                                     ; "Only called by STORE-AC, which has
 279                                        already stored everything in the AC.
 280                                        This forces all parts of a variable
 281                                        out of the ACs if any part is being
 282                                        flushed."
 283                                     <COND (<AND <SET TAC <LINKVAR-VALUE-AC .LV>>
 284                                                 <N==? .TAC .AC>>
 285                                            <BREAK-LINK .TAC
 286                                                        <LINKVAR-VAR .LV>>)>
 287                                     <COND (<AND <SET TAC
 288                                                      <LINKVAR-TYPE-WORD-AC .LV>>
 289                                                 <N==? .TAC .AC>>
 290                                            <BREAK-LINK .TAC
 291                                                        <LINKVAR-VAR .LV>>)>
 292                                     <COND (<AND <SET TAC <LINKVAR-TYPE-AC .LV>>
 293                                                 <N==? .TAC .AC>>
 294                                            <BREAK-LINK .TAC
 295                                                        <LINKVAR-VAR .LV>>)>
 296                                     <COND (<AND <SET TAC <LINKVAR-COUNT-AC .LV>>
 297                                                 <N==? .TAC .AC>>
 298                                            <BREAK-LINK .TAC
 299                                                        <LINKVAR-VAR .LV>>)>)>)>>
 300               .VARS>>
 301
 302 <DEFINE MUNG-AC (VAC)
 303         #DECL ((VAC) AC)
 304         <STORE-AC .VAC T>
 305         <USE-AC .VAC>
 306         <CLEAR-VARS-FROM-AC .VAC>>
 307
 308 <DEFINE FLUSH-ACS () <MAPF <> ,MUNG-AC ,ALL-ACS>>
 309
 310 <DEFINE EXCH-AC (AC1 AC2 "AUX" (VARS <AC-VARS .AC2>))
 311         #DECL ((AC1 AC2) AC)
 312         <PUT .AC2 ,AC-VARS <AC-VARS .AC1>>
 313         <PUT .AC1 ,AC-VARS .VARS>
 314         <CLOAD-AC .AC1>
 315         <CLOAD-AC .AC2>
 316         <MAPF <>
 317               <FCN (LV)
 318                    <PUT .LV
 319                         ,LINKVAR-VALUE-AC
 320                         <EXCH-TEST .AC1 .AC2 <LINKVAR-VALUE-AC .LV>>>
 321                    <PUT .LV
 322                         ,LINKVAR-TYPE-AC
 323                         <EXCH-TEST .AC1 .AC2 <LINKVAR-TYPE-AC .LV>>>
 324                    <PUT .LV
 325                         ,LINKVAR-COUNT-AC
 326                         <EXCH-TEST .AC1 .AC2 <LINKVAR-COUNT-AC .LV>>>
 327                    <PUT .LV
 328                         ,LINKVAR-TYPE-WORD-AC
 329                         <EXCH-TEST .AC1 .AC2 <LINKVAR-TYPE-WORD-AC .LV>>>>
 330               ,VARIABLE-CACHE>>
 331
 332 <DEFINE EXCH-TEST (AC1 AC2 ACL)
 333         #DECL ((AC1 AC2) AC (ACL) <OR AC FALSE>)
 334         <COND (<==? .AC1 .ACL> .AC2) (<==? .AC2 .ACL> .AC1) (.ACL)>>
 335
 336 <DEFINE MOVE-AC (AC1 AC2 "AUX" (VARS1 <AC-VARS .AC1>) (VARS2 <AC-VARS .AC2>))
 337         #DECL ((AC1 AC2) AC)
 338         <USE-AC .AC1>
 339         <MAPF <>
 340               <FCN (LV)
 341                    <COND (<==? <LINKVAR-VALUE-AC .LV> .AC1>
 342                           <PUT .LV ,LINKVAR-VALUE-AC .AC2>)
 343                          (<==? <LINKVAR-TYPE-AC .LV> .AC1>
 344                           <PUT .LV ,LINKVAR-TYPE-AC .AC2>)
 345                          (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC1>
 346                           <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC2>)
 347                          (<==? <LINKVAR-COUNT-AC .LV> .AC1>
 348                           <PUT .LV ,LINKVAR-COUNT-AC .AC2>)>>
 349               ,VARIABLE-CACHE>
 350         <SET VARS2 <ADJUST-LENGTH .VARS2 <LENGTH .VARS1>>>
 351         <PUT .AC2 ,AC-VARS .VARS2>
 352         <MAPR <> <FCN (ACV2 ACV1) <PUT .ACV2 1 <1 .ACV1>>> .VARS2 .VARS1>
 353         <CLEAR-VARS-FROM-AC .AC1>>
 354
 355 <DEFINE ADJUST-LENGTH (VEC LEN "AUX" TVEC)
 356         #DECL ((VEC) VECTOR (LEN) FIX)
 357         <COND (<G? <LENGTH .VEC> .LEN>
 358                <SET VEC <REST .VEC <- <LENGTH .VEC> .LEN>>>)
 359               (<L? <LENGTH .VEC> .LEN>
 360                <SET TVEC <TOP .VEC>>
 361                <COND (<G? <LENGTH .TVEC> .LEN>
 362                       <SET VEC <REST .TVEC <- <LENGTH .TVEC> .LEN>>>)
 363                      (<SET VEC
 364                            [!<IVECTOR <- <LENGTH .TVEC> .LEN>> !.TVEC]>)>)>
 365         .VEC>
 366
 367 <DEFINE SET-AC-AGE (AC)
 368         #DECL ((AC) AC (VAL) FIX)
 369         <PUT .AC ,AC-AGE ,AC-TIME>
 370         <SETG AC-TIME <+ ,AC-TIME 1>>>
 371
 372 <DEFINE USE-AC (AC) #DECL ((AC) AC) <PUT .AC ,AC-USE T>>
 373
 374 <DEFINE PROTECT (AC) #DECL ((AC) AC) <PUT .AC ,AC-PROT T> .AC>
 375
 376 <DEFINE PROTECT-USE (AC) #DECL ((AC) AC) <PROTECT .AC> <USE-AC .AC>>
 377
 378 <DEFINE UNPROTECT (AC) #DECL ((AC) AC) <PUT .AC ,AC-PROT <>>>
 379
 380 <DEFINE UNPROTECT-ACS () <MAPF <> ,UNPROTECT ,ALL-ACS>>
 381
 382 <DEFINE LOAD-AC (AC EA)
 383         #DECL ((AC) AC)
 384         <PUT .AC ,AC-LLOAD ,CODE-COUNT>
 385         <PUT .AC ,AC-LLOAD-EA .EA>
 386         <PUT .AC ,AC-USE <>>
 387         <CLEAR-STATUS>>
 388
 389 <DEFINE CLOAD-AC (AC)
 390         #DECL ((AC) AC)
 391         <PUT .AC ,AC-LLOAD <>>
 392         <PUT .AC ,AC-LLOAD-EA <>>>
 393
 394 <DEFINE SET-STATUS-AC (AC)
 395         #DECL ((AC) AC)
 396         <COND (,AC-STORE-OPT <SETG STATUS-AC .AC>) (<CLEAR-STATUS>)>>
 397
 398 <DEFINE SET-STATUS-VAR (VAR STYP)
 399         #DECL ((VAR) VARTBL (STYP) ATOM)
 400         <COND (<AND ,STATUS-AC ,AC-STORE-OPT>
 401                <SETG STATUS-VAR .VAR>
 402                <SETG STATUS-TYPE .STYP>)>>
 403
 404 <DEFINE CLEAR-STATUS () <SETG STATUS-AC <>> <SETG STATUS-VAR <>>>
 405
 406 <DEFINE STATUS? (VAR STYPE "AUX" LVAR (SAC ,STATUS-AC))
 407         #DECL ((VAR) VARTBL (STYPE) ATOM)
 408         <COND (<AND ,STATUS-AC
 409                     <SET LVAR <FIND-CACHE-VAR .VAR <AC-VARS .SAC>>>
 410                     <OR <AND <==? .STYPE VALUE>
 411                              <==? <LINKVAR-VALUE-AC .LVAR> .SAC>>
 412                         <==? .STYPE COUNT>
 413                         <==? <LINKVAR-COUNT-AC .LVAR> .SAC>>>
 414                ,STATUS-AC)
 415               (<AND <==? .VAR ,STATUS-VAR> <==? .STYPE ,STATUS-TYPE>>
 416                <COND (,STATUS-AC ,STATUS-AC) (VAR)>)>>
 417
 418 <DEFINE PRINT-LINKVAR (LV "AUX" (OUTCHAN .OUTCHAN))
 419         #DECL ((LV) LINKVAR)
 420         <PRINC "#LINKVAR [">
 421         <PRINC <VARTBL-NAME <LINKVAR-VAR .LV>>>
 422         <PRINC " ">
 423         <PRINC <LINKVAR-DECL .LV>>
 424         <TESTPRINT <LINKVAR-VALUE-AC .LV> "VALUE" .OUTCHAN>
 425         <TESTPRINT <LINKVAR-TYPE-AC .LV> "TYPE" .OUTCHAN>
 426         <TESTPRINT <LINKVAR-TYPE-WORD-AC .LV> "TYPE-WORD" .OUTCHAN>
 427         <TESTPRINT <LINKVAR-COUNT-AC .LV> "COUNT" .OUTCHAN>
 428         <PRINC "]">>
 429
 430 <DEFINE TESTPRINT (AC TYP OUTCHAN)
 431         #DECL ((AC) <OR FALSE AC> (TYP) STRING (OUTCHAN) <SPECIAL CHANNEL>)
 432         <COND (.AC
 433                <PRINC " #">
 434                <PRINC .TYP>
 435                <PRINC " ">
 436                <PRIN1 <AC-NAME .AC>>)>>
 437
 438 <COND (<GASSIGNED? PRINT-LINKVAR> <PRINTTYPE LINKVAR ,PRINT-LINKVAR>)>
 439
 440 <DEFINE PRINT-AC (AC "AUX" (OUTCHAN .OUTCHAN))
 441         #DECL ((AC) AC)
 442         <PRINC "#AC [">
 443         <PRIN1 <AC-NAME .AC>>
 444         <PRINC " ">
 445         <MAPF <> <FCN (LV) <PRINT-SHORT-LINKVAR .LV .AC>> <AC-VARS .AC>>
 446         <PRINC "]">>
 447
 448 <COND (<GASSIGNED? PRINT-AC><PRINTTYPE AC ,PRINT-AC>)>
 449
 450 <DEFINE PRINT-SHORT-LINKVAR (LV AC "AUX" (OUTCHAN .OUTCHAN))
 451         #DECL ((LV) LINKVAR (AC) AC)
 452         <COND (<==? <LINKVAR-TYPE-AC .LV> .AC> <PRINC "#TYPE ">)
 453               (<==? <LINKVAR-VALUE-AC .LV> .AC> <PRINC "#VALUE ">)
 454               (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC> <PRINC "#TYPE-WORD ">)
 455               (<==? <LINKVAR-COUNT-AC .LV> .AC> <PRINC "#COUNT ">)>
 456         <PRINC <VARTBL-NAME <LINKVAR-VAR .LV>>>
 457         <PRINC " ">>
 458
 459 <DEFINE FREE-TYPE-AC? ("OPTIONAL" (HOWFREE? NOVARS) (REAL? <>))
 460         <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>>
 461
 462 <DEFINE FREE-VALUE-AC? ("OPTIONAL" (HOWFREE? NOVARS))
 463         <FIND-FREE-AC ,VAL-ACS .HOWFREE?>>
 464
 465 <DEFINE FREE-AC? ("OPTIONAL" (PREF NONE) (HOWFREE? NOVARS))
 466         <COND (<==? .PREF DOUBLE> <FIND-FREE-PAIR .HOWFREE?>)
 467               (<==? .PREF NONE> <FIND-FREE-AC ,ALL-ACS .HOWFREE?>)
 468               (<OR <==? .PREF TYPE> <==? .PREF PREF-TYPE>>
 469                <OR <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>
 470                    <FIND-FREE-AC ,VAL-ACS .HOWFREE?>>)
 471               (<OR <==? .PREF VALUE> <==? .PREF PREF-VAL>>
 472                <OR <FIND-FREE-AC ,VAL-ACS .HOWFREE?>
 473                    <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>>)
 474               (<ERROR BAD-PREFERENCE FREE-AC?>)>>
 475
 476 <DEFINE FIND-FREE-PAIR (HOWFREE?)
 477         <REPEAT ((ACS ,ALL-ACS) AC1 AC2)
 478                 <COND (<L? <LENGTH .ACS> 2> <RETURN <>>)>
 479                 <COND (<NOT <OR <AC-PROT <SET AC1 <1 .ACS>>>
 480                                 <AC-PROT <SET AC2 <2 .ACS>>>>>
 481                        <COND (<==? .HOWFREE? NOVARS>
 482                               <COND (<AND <ALL-DEAD? .AC1> <ALL-DEAD? .AC2>>
 483                                      <RETURN .AC1>)>)
 484                              (<==? .HOWFREE? STORED>
 485                               <COND (<AND <ALL-STORED? .AC1>
 486                                           <ALL-STORED? .AC2>>
 487                                      <RETURN .AC1>)>)
 488                              (ELSE <ERROR BAD-MODE FIND-FREE-PAIR>)>)>
 489                 <SET ACS <REST .ACS 2>>>>
 490
 491 <DEFINE FIND-FREE-AC (ACLIST HOWFREE?)
 492         #DECL ((ACLIST) <VECTOR [REST AC]> (HOWFREE?) ATOM)
 493         <MAPF <>
 494               <FCN (AC)
 495                    <AND <NOT <AC-PROT .AC>>
 496                         <COND (<==? .HOWFREE? NOVARS>
 497                                <AND <ALL-DEAD? .AC> <MAPLEAVE .AC>>)
 498                               (<==? .HOWFREE? STORED>
 499                                <AND <ALL-STORED? .AC> <MAPLEAVE .AC>>)
 500                               (<ERROR BAD-MODE FIND-FREE-AC>)>>>
 501               .ACLIST>>
 502
 503 <DEFINE AC-VAR-STORED? (VAR AC "AUX" LV)
 504   #DECL ((VAR) VARTBL (AC) AC (LV) LINKVAR)
 505   <COND (<SET LV <FIND-CACHE-VAR .VAR>>
 506          <COND (<==? .AC <LINKVAR-VALUE-AC .LV>>
 507                 <LINKVAR-VALUE-STORED .LV>)
 508                (<==? .AC <LINKVAR-COUNT-AC .LV>>
 509                 <LINKVAR-COUNT-STORED .LV>)
 510                (<==? .AC <LINKVAR-TYPE-AC .LV>>
 511                 <LINKVAR-TYPE-STORED .LV>)
 512                (<==? .AC <LINKVAR-TYPE-WORD-AC .LV>>
 513                 <LINKVAR-TYPE-STORED .LV>)
 514                (<ERROR "VAR NOT IN AC" .VAR .AC>)>)
 515         (<ERROR "VAR NOT IN AC" .VAR>)>>
 516
 517 <DEFINE ALL-STORED? (AC "AUX" (VAL T))
 518         #DECL ((AC) AC)
 519         <MAPF <>
 520               <FCN (LV)
 521                    <COND (<==? .AC <LINKVAR-VALUE-AC .LV>>
 522                           <AND <NOT <LINKVAR-VALUE-STORED .LV>>
 523                                <MAPLEAVE <SET VAL <>>>>)
 524                          (<==? .AC <LINKVAR-COUNT-AC .LV>>
 525                           <AND <NOT <LINKVAR-COUNT-STORED .LV>>
 526                                <MAPLEAVE <SET VAL <>>>>)
 527                          (<==? .AC <LINKVAR-TYPE-AC .LV>>
 528                           <AND <NOT <LINKVAR-TYPE-STORED .LV>>
 529                                <MAPLEAVE <SET VAL <>>>>)
 530                          (<==? .AC <LINKVAR-TYPE-WORD-AC .LV>>
 531                           <AND <NOT <LINKVAR-TYPE-STORED .LV>>
 532                                <MAPLEAVE <SET VAL <>>>>)
 533                          (<ERROR "VAR NOT IN AC" ALL-STORED?>)>>
 534               <AC-VARS .AC>>
 535         .VAL>
 536
 537 <DEFINE ALL-DEAD? (AC "AUX" (VAL T))
 538         #DECL ((AC) AC)
 539         <MAPF <>
 540               <FCN (LV)
 541                    <COND (<AND <NOT <VARTBL-DEAD? <LINKVAR-VAR .LV>>>
 542                                <NOT <WILL-DIE? <LINKVAR-VAR .LV>>>>
 543                           <MAPLEAVE <SET VAL <>>>)>>
 544               <AC-VARS .AC>>
 545         .VAL>
 546
 547 <DEFINE FLUSH-ALL-ACS () <MAPF <> ,MUNG-AC ,ALL-ACS>>
 548
 549 <DEFINE MOVE-TO-AC (AC ADDR LEN)
 550         #DECL ((AC) AC (LEN) ATOM)
 551         <COND (<==? .LEN LONG>
 552                <EMIT-MOVE .ADDR <MA-REG .AC> LONG>
 553                <LOAD-AC .AC .ADDR>)
 554               (<==? .LEN WORD>
 555                <EMIT ,INST-MOVZWL .ADDR <MA-REG .AC>>)
 556               (<==? .LEN BYTE>
 557                <EMIT ,INST-MOVZBL .ADDR <MA-REG .AC>>)>>
 558
 559 <DEFINE PREV-AC (AC "AUX" (ACN <AC-NUMBER .AC>))
 560         #DECL ((AC) AC)
 561         <COND (<==? .ACN 0> <>) (ELSE <NTH ,ALL-ACS .ACN>)>>
 562
 563 <DEFINE NEXT-AC (AC "AUX" (ACN <AC-NUMBER .AC>)) <NTH ,ALL-ACS <+ .ACN 2>>>