<mdl.comp>/cacs.mud.28

   1 <PACKAGE "CACS">
   2
   3 <ENTRY GETREG SGETREG RET-TMP-AC TOACT TOACV FLUSH-RESIDUE TOACT FLUSH-RESIDUE
   4         SAVE-STATE MUNG-AC TOACV AC+1OK? DATTYP-FLUSH SAVE:RES PREFER-DATUM
   5         MERGE-STATE GET2REG SMASH-INACS SAVE-NUM-SYM ANY2ACS  RESTORE-STATE KILL-LIST
   6         CHECK:VARS CALL-INTERRUPT  SINACS FREE-ACS  REGSTO FIX-NUM-SYM SPEC-OFFPTR
   7         KILL-LOOP-AC SMASH-NUM-SYM GET-NUM-SYM STORE-VAR STORE-TVAR STOREV VAR-STORE
   8         KILL-STORE UNPREFER>
   9
  10 <USE "COMPDEC" "CHKDCL" "COMCOD" "CODGEN" "CUP">
  11
  12 <DEFINE GETREG (DAT
  13                 "OPTIONAL" (TYPE-AC <>)
  14                 "AUX" AC (BEST <>) (OLDAGE <CHTYPE <MIN> FIX>)(WINNAGE -1))
  15    #DECL ((DAT) ANY (BEST) <OR FALSE AC> (VALUE) AC (WINNAGE OLDAGE) FIX)
  16    <MAPF <>
  17     <FUNCTION (AC "AUX" (SCORE 0) PAC NAC)
  18             #DECL ((AC PAC NAC) AC (SCORE) FIX)
  19             <PROG ()
  20                   <COND (<ACPROT .AC> <RETURN>)>
  21                   <COND (<ACLINK .AC>
  22                          <COND (<G? .WINNAGE ,LINKED> <RETURN>)>
  23                          <COND (<G? <ACAGE .AC> .OLDAGE> <RETURN>)>
  24                          <SET WINNAGE ,LINKED>
  25                          <SET OLDAGE <ACAGE <SET BEST .AC>>>
  26                          <RETURN>)>
  27                   <COND (<ACRESIDUE .AC>
  28                          <COND (<G? .WINNAGE ,NO-RESIDUE> <RETURN>)>
  29                          <COND (<ALL-STORED? <ACRESIDUE .AC>>
  30                                 <COND (<G? .WINNAGE ,STORED-RESIDUE> <RETURN>)>
  31                                 <SET SCORE ,STORED-RESIDUE>)
  32                                (<G? .WINNAGE ,NOT-STORED-RESIDUE> <RETURN>)
  33                                (ELSE <SET SCORE ,NOT-STORED-RESIDUE>)>)
  34                         (ELSE <SET SCORE ,NO-RESIDUE>)>
  35                   <COND (<NOT <ACPREF .AC>> <SET SCORE <+ .SCORE ,NOT-PREF>>)>
  36                   <COND (<NOT .TYPE-AC> <SET SCORE <+ .SCORE <RATE .AC PREV>>>)
  37                         (ELSE <SET SCORE <+ .SCORE ,P-N-CLEAN>>)>
  38                   <SET SCORE <+ .SCORE <RATE .AC NEXT>>>
  39                   <COND (<G? .SCORE .WINNAGE>
  40                          <SET WINNAGE .SCORE>
  41                          <SET BEST .AC>)>>>
  42     ,ALLACS>
  43    <SET BEST <CHTYPE .BEST AC>>
  44                          ;"Make sure the poor compiler knows this guy is an AC"
  45    <COND (<TYPE? .DAT DATUM> <PUT .BEST ,ACLINK (.DAT)>)
  46          (ELSE <PUT .BEST ,ACLINK .DAT>)>
  47    <COND (<ACRESIDUE .BEST>
  48           <MAPF <>
  49                 <FUNCTION (SYMT "AUX" (INAC <SINACS .SYMT>) IAC)
  50                         #DECL ((INAC) DATUM)
  51                         <COND (<AND <TYPE? <SET IAC <DATTYP .INAC>> AC>
  52                                     <N==? .IAC .BEST>>
  53                                <FLUSH-RESIDUE .IAC .SYMT>)>
  54                         <COND (<AND <TYPE? <SET IAC <DATVAL .INAC>> AC>
  55                                     <N==? .IAC .BEST>>
  56                                <FLUSH-RESIDUE .IAC .SYMT>)>
  57                         <STOREV .SYMT>>
  58                 <ACRESIDUE .BEST>>
  59           <PUT .BEST ,ACRESIDUE <>>)>
  60    <PUT .BEST ,ACAGE <SETG ATIME <+ ,ATIME 1>>>
  61    .BEST>
  62
  63 <DEFINE ALL-STORED? (L) #DECL ((L) LIST)
  64         <MAPF <> <FUNCTION (S) <COND (<AND <TYPE? .S SYMTAB>
  65                                            <NOT <STORED .S>>>
  66                                        <MAPLEAVE <>>)> T> .L>>
  67
  68 <DEFINE RATE (AC PREV-OR-NEXT
  69               "AUX" (PREV <==? .PREV-OR-NEXT PREV>) (SCORE 0) OTHAC)
  70         #DECL ((AC OTHAC) AC (PREV-OR-NEXT) ATOM)
  71         <PROG ()
  72               <COND (.PREV
  73                      <COND (<OR <==? .AC ,AC-A>
  74                                 <ACPROT <SET OTHAC
  75                                              <NTH ,ALLACS <- <ACNUM .AC> 1>>>>>
  76                             <RETURN 0>)>)
  77                     (<OR <==? .AC ,LAST-AC>
  78                          <ACPROT <SET OTHAC <NTH ,ALLACS <+ <ACNUM .AC> 1>>>>>
  79                      <RETURN 0>)>
  80               <COND (<ACLINK .OTHAC> <RETURN ,P-N-LINKED>)>
  81               <COND (<ACRESIDUE .OTHAC>
  82                      <COND (<ALL-STORED? <ACRESIDUE .OTHAC>>
  83                             <RETURN ,P-N-STO-RES>)
  84                            (ELSE <RETURN ,P-N-NO-STO-RES>)>)
  85                     (ELSE <RETURN ,P-N-CLEAN>)>>>
  86
  87 <DEFINE UNPREFER () <MAPF <> <FUNCTION (X) <PUT .X ,ACPREF <>>> ,ALLACS>>
  88
  89 <DEFINE PREFER-DATUM (WHERE)
  90         #DECL ((WHERE) <OR DATUM ATOM>)
  91         <COND (<NOT <TYPE? .WHERE ATOM>>
  92                <PREF-AC <1 .WHERE>>
  93                <PREF-AC <2 .WHERE>>)>>
  94
  95 <DEFINE PREF-AC (DAT) <COND (<TYPE? .DAT AC> <PUT .DAT ,ACPREF T>)>>
  96
  97 <DEFINE RELREG (AC D "AUX" (ACL <ACLINK .AC>))
  98         #DECL ((AC) AC (ACL) <OR FALSE <LIST [REST DATUM]>> (D) DATUM)
  99         <COND (.ACL
 100                <REPEAT ((ACP ()))
 101                        #DECL ((ACP) LIST)
 102                        <AND <EMPTY? .ACL> <RETURN>>
 103                        <COND (<==? <1 .ACL> .D>
 104                               <COND (<==? .ACL <ACLINK .AC>>
 105                                      <PUT .AC ,ACLINK <REST .ACL>>)
 106                                     (ELSE <PUTREST .ACP <REST .ACL>>)>)>
 107                        <SET ACL <REST <SET ACP .ACL>>>>
 108                <AND <EMPTY? <ACLINK .AC>> <PUT .AC ,ACLINK <>>>)>
 109         <PUT .AC ,ACPROT <>>
 110         .AC>
 111
 112 <DEFINE GETTMP (TYP) <CHTYPE <VECTOR <CREATE-TMP .TYP> <>> TEMP>>
 113
 114 <DEFINE SAVE:REG (AC FLS
 115                   "OPTIONAL" (HANDLE-VARS T)
 116                   "AUX" TMP (ACL <ACLINK .AC>) (TYPS <>) (VALS <>) TTMP HLAC)
 117    #DECL ((AC) AC (TMP) TEMP (ACL) <OR FALSE <LIST [REST DATUM]>> (TTMP) DATUM)
 118    <COND
 119     (<AND .HANDLE-VARS <ACRESIDUE .AC>>
 120      <MAPF <>
 121       <FUNCTION (SYM "AUX" SAC (INAC <SINACS .SYM>))
 122               #DECL ((SYM) SYMBOL (INAC) DATUM)
 123               <COND (<AND <TYPE? .SYM SYMTAB> <NOT <STORED .SYM>>>
 124                      <STOREV .SYM .FLS>)>
 125               <COND (.FLS
 126                      <COND (<AND <TYPE? <SET SAC <DATTYP .INAC>> AC>
 127                                  <N==? .SAC .AC>>
 128                             <FLUSH-RESIDUE .SAC .SYM>)
 129                            (<AND <TYPE? <SET SAC <DATVAL .INAC>> AC>
 130                                  <N==? .SAC .AC>>
 131                             <FLUSH-RESIDUE .SAC .SYM>)>
 132                      <SMASH-INACS .SYM <>>
 133                      <COND (<AND .FLS
 134                                  <TYPE? .SYM SYMTAB>
 135                                  <TYPE? <NUM-SYM .SYM> LIST>
 136                                  <1 <NUM-SYM .SYM>>>
 137                             <PUT <NUM-SYM .SYM> 1 <>>)>)>>
 138       <ACRESIDUE .AC>>)>
 139    <COND
 140     (.ACL
 141      <SET TMP
 142           <GETTMP <COND (<AND <TYPE? <DATTYP <1 .ACL>> ATOM>
 143                               <VALID-TYPE? <DATTYP <1 .ACL>>>>
 144                          <DATTYP <1 .ACL>>)
 145                         (ELSE <>)>>>
 146      <OR .FLS <PUT .TMP ,TMPAC <DATUM !<1 .ACL>>>>
 147      <COND (<TYPE? <DATTYP <SET TTMP <1 .ACL>>> TEMP>
 148             <PUT <CHTYPE <DATVAL .TTMP> AC> ,ACPROT T>
 149             <TOACT .TTMP>
 150             <PUT <CHTYPE <DATVAL .TTMP> AC> ,ACPROT <>>)
 151            (<TYPE? <DATVAL .TTMP> TEMP>
 152             <PUT <CHTYPE <DATTYP .TTMP> AC> ,ACPROT T>
 153             <TOACV .TTMP>
 154             <PUT <CHTYPE <DATTYP .TTMP> AC> ,ACPROT <>>)>
 155      <MAPF <>
 156            <FUNCTION (D)
 157                    #DECL ((D) DATUM)
 158                    <COND (<TYPE? <SET HLAC <DATTYP .D>> AC>
 159                           <OR .TYPS <SET TYPS .HLAC>>
 160                           <PUT <PUT .HLAC ,ACLINK <>> ,ACPROT <>>
 161                           <OR .FLS
 162                               <MEMQ .TMP <ACRESIDUE .HLAC>>
 163                               <PUT .HLAC
 164                                    ,ACRESIDUE
 165                                    (.TMP !<ACRESIDUE <DATTYP .D>>)>>
 166                           <PUT .D ,DATTYP .TMP>)
 167                          (<TYPE? .HLAC OFFPTR>
 168                           <SET VALS <HACK-OFFPTR .HLAC .TMP>>
 169                           <SET VALS <3 .HLAC>>)>
 170                    <COND (<TYPE? <SET HLAC <DATVAL .D>> AC>
 171                           <OR .VALS <SET VALS .HLAC>>
 172                           <PUT <PUT .HLAC ,ACLINK <>> ,ACPROT <>>
 173                           <OR .FLS
 174                               <MEMQ .TMP <ACRESIDUE .HLAC>>
 175                               <PUT .HLAC ,ACRESIDUE (.TMP !<ACRESIDUE
 176                                                             .HLAC>)>>
 177                           <PUT .D ,DATVAL .TMP>)
 178                          (<TYPE? .HLAC OFFPTR>
 179                           <SET VALS <HACK-OFFPTR .HLAC .TMP>>
 180                           <SET TYPS <3 .HLAC>>)>>
 181            .ACL>
 182      <OR .TYPS <SET TYPS <DATTYP <1 .ACL>>>>
 183      <SET VALS <CHTYPE <OR .VALS <DATVAL <1 .ACL>>> AC>>
 184      <COND (<TYPE? .TYPS AC>
 185             <STORE-TMP <ACSYM .TYPS> <ACSYM .VALS> <STEMP:ADDR .TMP>>)
 186            (ELSE <STORE-TMP .TYPS <ACSYM .VALS> <STEMP:ADDR .TMP>>)>)>
 187    <AND .FLS
 188         <NOT .HANDLE-VARS>
 189         <MESSAGE INCONSISTENCY "AC-LOSSAGE">>
 190    <AND .FLS <PUT .AC ,ACRESIDUE <>>>
 191    .AC>
 192
 193 <DEFINE RETTMP (TMP "AUX" INAC AC)
 194         #DECL ((TMP) TEMP (INAC) <OR FALSE DATUM>)
 195         <COND (<SET INAC <SINACS .TMP>>
 196                <COND (<TYPE? <SET AC <DATTYP .INAC>> AC>
 197                       <FLUSH-RESIDUE .AC .TMP>)>
 198                <COND (<TYPE? <SET AC <DATVAL .INAC>> AC>
 199                       <FLUSH-RESIDUE .AC .TMP>)>)>>
 200
 201 <DEFINE MUNG-AC (AC "OPTIONAL" (GD <>) (FLS T)  "AUX" ACL (ACPR <ACPROT .AC>))
 202    #DECL ((AC) AC (GD ACL) <PRIMTYPE LIST>)
 203    <COND
 204     (<ACRESIDUE .AC>
 205      <MAPF <>
 206       <FUNCTION (V "AUX" (INAC <SINACS .V>) TT)
 207               #DECL ((INAC) <OR DATUM FALSE>)
 208               <STOREV .V .FLS>
 209               <AND .INAC
 210                    .FLS
 211                    <OR <COND (<OR <AND <==? .AC <DATTYP .INAC>>
 212                                        <TYPE? <SET TT <DATVAL .INAC>> AC>>
 213                                   <AND <==? .AC <DATVAL .INAC>>
 214                                        <TYPE? <SET TT <DATTYP .INAC>> AC>>>
 215                               <MUNG-AC .TT .GD .FLS>)>
 216                        <PROG ()
 217                              <AND <TYPE? <SET TT <DATTYP .INAC>> AC>
 218                                   <NOT <==? .TT .AC>>
 219                                   <MUNG-AC .TT .INAC .FLS>>
 220                              <AND <TYPE? <SET TT <DATVAL .INAC>> AC>
 221                                   <NOT <==? .TT .AC>>
 222                                   <MUNG-AC .TT .INAC .FLS>>>>>>
 223       <ACRESIDUE .AC>>
 224      <COND (.FLS <PUT .AC ,ACRESIDUE <>>)>)>
 225    <COND (<AND .GD <SET ACL <ACLINK .AC>>>
 226           <REPEAT ((OA ()))
 227                   #DECL ((OA) LIST)
 228                   <AND <EMPTY? .ACL> <RETURN <SET GD <>>>>
 229                   <COND (<==? <1 .ACL> .GD>
 230                          <COND (<EMPTY? .OA>
 231                                 <COND (<EMPTY? <REST .ACL>>
 232                                        <PUT .AC ,ACLINK <>>)
 233                                       (ELSE <PUT .AC ,ACLINK <REST .ACL>>)>)
 234                                (ELSE <PUTREST .OA <REST .ACL>>)>
 235                          <RETURN>)>
 236                   <SET ACL <REST <SET OA .ACL>>>>)
 237          (ELSE <SET GD <>>)>
 238    <COND (.GD
 239           <PUT .AC ,ACPROT <>>
 240           <SGETREG .AC .GD>
 241           <PUT .AC ,ACPROT .ACPR>)>
 242    .AC>
 243
 244 <DEFINE VAR-STORE ("OPTIONAL" (FLS T))
 245         <UNPREFER>
 246         <MAPF <> <FUNCTION (AC) <MUNG-AC .AC <> .FLS>> ,ALLACS>>
 247
 248 <DEFINE GET:ACS () <MAPF ,LIST
 249                          <FUNCTION (X) <CHTYPE <VECTOR !.X> AC>>
 250                          ,ALLACS>>
 251
 252 <DEFINE REGSTO (FLUSH-RES "OPTIONAL" (HANDLE-VARS T))
 253         <MAPF <>
 254               <FUNCTION (AC) #DECL ((AC) AC) <SAVE:REG .AC .FLUSH-RES .HANDLE-VARS>>
 255               ,ALLACS>>
 256
 257 <DEFINE SGETREG (AC DAT "AUX" (ACL <ACLINK .AC>))
 258    #DECL ((AC) AC (ACL) <OR FALSE <LIST [REST DATUM]>>)
 259    <AND <ACPROT .AC>
 260         <MESSAGE INCONSISTENCY "NEEDED AC IS PROTECTED? ">>
 261    <COND
 262     (.ACL
 263      <COND
 264       (<MAPF <>
 265              <FUNCTION (AC1)
 266                #DECL ((AC1) AC)
 267                <COND
 268                 (<AND <NOT <ACLINK .AC1>> <NOT <ACPROT .AC1>>>
 269                  <MUNG-AC .AC1>
 270                  <PUT .AC1 ,ACLINK .ACL>
 271                  <PUT .AC1 ,ACRESIDUE <ACRESIDUE .AC>>
 272                  <MAPF <>
 273                        <FUNCTION (D "AUX" (L <MEMQ .AC .D>))
 274                                #DECL ((D) DATUM (L) <PRIMTYPE LIST>)
 275                                <COND (.L <PUT .L 1 .AC1>)
 276                                      (ELSE
 277                                       <MESSAGE INCONSISTENCY " AC LOSSAGE ">)>>
 278                        .ACL>
 279                  <MAPF <>
 280                        <FUNCTION (SYM "AUX" L)
 281                                #DECL ((SYM) SYMBOL)
 282                                <COND (<SET L <MEMQ .AC <CHTYPE <SINACS .SYM> DATUM>>>
 283                                       <PUT .L 1 .AC1>)>>
 284                        <ACRESIDUE .AC1>>
 285                  <PUT .AC ,ACRESIDUE <>>
 286                  <MOVE:VALUE .AC .AC1>
 287                  <MAPLEAVE T>)>> ,ALLACS>)
 288       (ELSE <SAVE:REG .AC T>)>)
 289     (ELSE <MUNG-AC .AC>)>
 290    <COND (<TYPE? .DAT DATUM> <PUT .AC ,ACLINK (.DAT)>)
 291          (ELSE <PUT .AC ,ACLINK .DAT>)>
 292    <PUT .AC ,ACAGE <SETG ATIME <+ ,ATIME 1>>>
 293    .AC>
 294
 295 <DEFINE DATUM (TY VA) #DECL ((VALUE) DATUM) <CHTYPE (.TY .VA) DATUM>>
 296
 297 <DEFINE OFFPTR (OFF DAT TYP) <CHTYPE (.OFF .DAT .TYP) OFFPTR>>
 298
 299 <DEFINE SPEC-OFFPTR (OFF DAT TYP AT) <CHTYPE (.OFF .DAT .TYP .AT) OFFPTR>>
 300
 301 <DEFINE DATTYP-FLUSH (DAT)
 302         #DECL ((DAT) DATUM)
 303         <COND (<N==? <DATVAL .DAT> <DATTYP .DAT>>
 304                <RET-TMP-AC <DATTYP .DAT> .DAT>)>>
 305
 306 <DEFINE RET-TMP-AC (ADR "OPTIONAL" D "AUX" (AD .ADR))
 307         #DECL ((D) DATUM)
 308         <COND (<TYPE? .ADR AC> <RELREG .ADR .D>)
 309               (<TYPE? .ADR TEMP> <RETTMP .ADR>)
 310               (<TYPE? .ADR DATUM>
 311                <REPEAT ()
 312                        <AND <EMPTY? .ADR> <RETURN>>
 313                        <RET-TMP-AC <DATTYP .ADR> .AD>
 314                        <RET-TMP-AC <DATVAL .ADR> .AD>
 315                        <SET ADR <REST .ADR 2>>>)
 316               (<TYPE? .ADR OFFPTR> <RET-TMP-AC <2 .ADR>>)>>
 317
 318
 319 <DEFINE TOACV (DAT "AUX" AC)
 320         #DECL ((DAT) DATUM (AC) AC)
 321         <TEMP-MOD .DAT>
 322         <COND (<NOT <TYPE? <DATVAL .DAT> AC>>
 323                <MOVE:VALUE <DATVAL .DAT> <SET AC <GETREG .DAT>>>
 324                <RET-TMP-AC <DATVAL .DAT>>
 325                <PUT .DAT ,DATVAL .AC>)>
 326         .DAT>
 327
 328 <DEFINE TOACT (DAT "AUX" AC)
 329         #DECL ((DAT) DATUM (AC) AC)
 330         <TEMP-MOD .DAT>
 331         <COND (<NOT <TYPE? <DATTYP .DAT> AC>>
 332                <MOVE:TYP <DATTYP .DAT> <SET AC <GETREG .DAT>>>
 333                <DATTYP-FLUSH .DAT>
 334                <PUT .DAT ,DATTYP .AC>)>
 335         .DAT>
 336
 337 <DEFINE AC+1OK? (AC)
 338         <COND (<TYPE? .AC AC>
 339                <REPEAT ((F ,ALLACS) (AC .AC))
 340                        #DECL ((F) <UVECTOR [REST AC]> (AC) AC)
 341                        <AND <==? .AC <1 .F>> <RETURN <NOT <ACLINK <2 .F>>>>>
 342                        <AND <EMPTY? <REST <SET F <REST .F>>>> <RETURN <>>>>)>>
 343
 344 <DEFINE GET2REG ()
 345         #DECL ((VALUE) <OR AC FALSE>)
 346         <REPEAT ((F ,ALLACS))
 347                 #DECL ((F) <UVECTOR [REST AC]>)
 348                 <AND <NOT <ACLINK <1 .F>>>
 349                      <NOT <ACLINK <2 .F>>>
 350                      <RETURN <1 .F>>>
 351                 <AND <EMPTY? <REST <SET F <REST .F>>>> <RETURN <>>>>>
 352
 353 <DEFINE ANY2ACS ("AUX" T)
 354         #DECL ((VALUE) DATUM)
 355         <RELREG <DATTYP <SET T <DATUM <GETREG ()> <GETREG <>>>>>
 356                 .T>
 357         .T>
 358
 359 <DEFINE GET1REG ()
 360         #DECL ((VALUE) <OR AC FALSE>)
 361         <REPEAT ((F ,ALLACS))
 362                 #DECL ((F) <UVECTOR [REST AC]>)
 363                 <OR <ACLINK <1 .F>> <RETURN <1 .F>>>
 364                 <AND <EMPTY? <SET F <REST .F>>> <RETURN <>>>>>
 365
 366 <DEFINE FREE-ACS ("OPTIONAL" (SUPER-FREE <>) "AUX" (N 0))
 367         #DECL ((N VALUE) FIX)
 368         <MAPF <>
 369               <FUNCTION (AC)
 370                       #DECL ((AC) AC)
 371                       <COND (<AND <NOT <ACPROT .AC>>
 372                                   <NOT <ACLINK .AC>>
 373                                   <OR <NOT .SUPER-FREE>
 374                                       <AND <NOT <ACRESIDUE .AC>>
 375                                            <NOT <ACPREF .AC>>>>>
 376                              <SET N <+ .N 1>>)>>
 377               ,ALLACS>
 378         .N>
 379
 380 <DEFINE SAVE-STATE ("AUX" (STATV #SAVED-STATE ()) ST)
 381    #DECL ((STATV) SAVED-STATE (ST) <OR FALSE <LIST NODE>>)
 382    <MAPF <>
 383     <FUNCTION (AC) #DECL ((AC) AC)
 384        <SET STATV
 385         <CHTYPE
 386          ((.AC
 387            <LIST !<ACRESIDUE .AC>>
 388            !<MAPF ,LIST
 389              <FUNCTION (X)
 390                      (.X
 391                       <DATUM !<SINACS .X>>
 392                       <AND <TYPE? .X SYMTAB> <STORED .X>>
 393                       <AND <TYPE? .X SYMTAB>
 394                            <AND <SET ST <PROG-AC .X>>
 395                                 <NOT <MEMQ .X <LOOP-VARS <1 .ST>>>>>>)>
 396              <CHTYPE <ACRESIDUE .AC> LIST>>)
 397           !.STATV)
 398          SAVED-STATE>>>
 399     ,ALLACS>
 400    .STATV>
 401
 402 <DEFINE RESTORE-STATE (STATV
 403                        "OPTIONAL" (NORET T)
 404                        "AUX" (MUNGED-SYMS ()) PA OACR)
 405    #DECL ((STATV) SAVED-STATE (PA) <OR FALSE <LIST NODE>> (OACR) <OR FALSE LIST>)
 406    <MAPF <>
 407     <FUNCTION (ACLST
 408                "AUX" (AC <1 .ACLST>) (SMT <2 .ACLST>) (SYMT <REST .ACLST 2>))
 409        #DECL ((ACLST)
 410               <LIST AC
 411                     <OR FALSE <LIST [REST SYMBOL]>>
 412                     [REST <LIST SYMBOL ANY>]>
 413               (SYMT)
 414               <LIST [REST <LIST SYMBOL ANY>]>
 415               (AC)
 416               AC
 417               (SMT)
 418               <OR FALSE <LIST [REST SYMBOL]>>)
 419        <AND .SMT <EMPTY? .SMT> <SET SMT <>>>
 420        <MAPF <>
 421              <FUNCTION (ST)
 422                      <OR <MEMQ .ST .MUNGED-SYMS> <SMASH-INACS .ST <> <>>>>
 423              <ACRESIDUE .AC>>
 424        <AND .SMT <SET SMT <LIST !.SMT>>>
 425        <SET OACR <ACRESIDUE .AC>>
 426        <PUT .AC ,ACRESIDUE .SMT>
 427        <MAPF <>
 428         <FUNCTION (SYMB "AUX" (SYMT <1 .SYMB>) (INAC <2 .SYMB>))
 429                 #DECL ((SYMB) <LIST SYMBOL ANY> (SYMT) SYMBOL)
 430                 <COND (<TYPE? .SYMT SYMTAB>
 431                        <PUT .SYMT
 432                             ,STORED
 433                             <GET-STORED .SYMT <3 .SYMB> <4 .SYMB>>>
 434                        <COND (<SET PA <PROG-AC .SYMT>>
 435                               <AND <STORED .SYMT>
 436                                    <NOT <MEMQ .SYMT <LOOP-VARS <1 .PA>>>>
 437                                    <NOT .NORET>
 438                                    <NOT <MEMQ .SYMT .OACR>>
 439                                    <KILL-LOOP-AC .SYMT>
 440                                    <FLUSH-RESIDUE .AC .SYMT>
 441                                    <SET INAC <>>>)
 442                              (<4 .SYMB>
 443                               <FLUSH-RESIDUE .AC .SYMT>
 444                               <SET INAC <>>)>)>
 445                 <OR <MEMQ .SYMT .MUNGED-SYMS>
 446                     <SET MUNGED-SYMS (.SYMT !.MUNGED-SYMS)>>
 447                 <SMASH-INACS .SYMT .INAC>>
 448         .SYMT>>
 449     .STATV>>
 450
 451 <DEFINE GET-STORED (SYMT PREV-STORED PROG-AC-POSS "AUX" PAC)
 452         #DECL ((PREV-STORED PROG-AC-POSS) <OR FALSE ATOM> (PAC) <OR FALSE <LIST NODE>>
 453                (SYMT) SYMTAB)
 454         <COND (.PROG-AC-POSS
 455                <AND .PREV-STORED
 456                     <OR <NOT <SET PAC <PROG-AC .SYMT>>>
 457                         <NOT <MEMQ .SYMT <LOOP-VARS <1 .PAC>>>>>>)
 458               (.PREV-STORED)>>
 459
 460 <DEFINE MERGE-STATE (STATV)
 461    #DECL ((STATV) SAVED-STATE)
 462    <MAPF <>
 463     <FUNCTION (STATV
 464                "AUX" (AC <1 .STATV>) (DATS <REST .STATV 2>)
 465                      (STATAC <ACRESIDUE .AC>) (NINACS ()) (NRES ()))
 466        #DECL ((STATV) <LIST AC ANY [REST <LIST SYMBOL ANY>]>
 467               (AC) AC (DATS) <LIST [REST <LIST SYMBOL ANY>]>
 468               (STATAC) <OR FALSE <LIST [REST SYMBOL]>>
 469               (NRES) <LIST [REST SYMBOL]>
 470               (NINACS) <LIST [REST <LIST SYMBOL ANY>]>)
 471        <MAPF <>
 472         <FUNCTION (ACX
 473                    "AUX" (SYMT <1 .ACX>) (INAC <2 .ACX>) (OINAC <SINACS .SYMT>)
 474                          (TEM <>) (PMERG T))
 475                 #DECL ((ACX) <LIST SYMBOL ANY>
 476                        (SYMT) SYMBOL
 477                        (INAC OINAC) <PRIMTYPE LIST>)
 478                 <COND (<TYPE? .SYMT SYMTAB>
 479                        <COND (<STORED .SYMT>
 480                               <PUT .SYMT
 481                                    ,STORED
 482                                    <GET-STORED .SYMT <3 .ACX> <4 .ACX>>>)>
 483                        <COND (<AND <SS-POTENT-SLOT .ACX> <NOT <PROG-AC .SYMT>>>
 484                               <SET PMERG <>>)>)>
 485                 <COND
 486                  (<AND <MEMQ .SYMT .STATAC>
 487                        .OINAC
 488                        .INAC
 489                        .PMERG
 490                        <==? <DATVAL .INAC> <DATVAL .OINAC>>
 491                        <OR <==? <DATTYP .INAC> <DATTYP .OINAC>>
 492                            <AND <TYPE? .SYMT SYMTAB>
 493                                 <SET TEM
 494                                      <ISTYPE? <1 <CHTYPE <DECL-SYM .SYMT>
 495                                                          LIST>>>>
 496                                 <OR <==? <DATTYP .INAC> .TEM>
 497                                     <==? <DATTYP .OINAC> .TEM>>>>>
 498                   <SET NRES (.SYMT !.NRES)>
 499                   <SET NINACS
 500                        ((.SYMT <DATUM <OR .TEM <DATTYP .INAC>> <DATVAL .INAC>>)
 501                         !.NINACS)>
 502                   <COND (<AND .TEM
 503                               <OR <TYPE? <SET TEM <DATTYP .INAC>> AC>
 504                                   <TYPE? <SET TEM <DATTYP .OINAC>> AC>>>
 505                          <FLUSH-RESIDUE .TEM .SYMT>)>)>
 506                 <COND (<AND .OINAC
 507                             <OR <==? .AC <DATTYP .OINAC>>
 508                                 <==? .AC <DATVAL .OINAC>>>>
 509                        <SMASH-INACS .SYMT <> <>>)>>
 510         .DATS>
 511        <MAPF <>
 512              <FUNCTION (SYMT)
 513                      #DECL ((SYMT) SYMBOL)
 514                      <SMASH-INACS .SYMT <> <>>>
 515              <ACRESIDUE .AC>>
 516        <PUT .AC ,ACRESIDUE <COND (<NOT <EMPTY? .NRES>> .NRES)>>
 517        <MAPF <>
 518              <FUNCTION (SYMB "AUX" (SYMT <1 .SYMB>) (ELEIN <2 .SYMB>))
 519                      #DECL ((SYMT) SYMBOL)
 520                      <SMASH-INACS .SYMT .ELEIN>>
 521              .NINACS>>
 522     .STATV>>
 523
 524 <DEFINE SINACS (SYM)
 525         #DECL ((SYM) SYMBOL (VALUE) <OR DATUM FALSE>)
 526         <COND (<TYPE? .SYM TEMP> <TMPAC .SYM>)
 527               (<TYPE? .SYM COMMON> <COMMON-DATUM .SYM>)
 528               (<INACS .SYM>)>>
 529
 530 <DEFINE SMASH-INACS (ITEM OBJ "OPTIONAL" (SMASH-NUM-SYM T))
 531         #DECL ((ITEM) SYMBOL)
 532         <COND (<TYPE? .ITEM COMMON> <PUT .ITEM ,COMMON-DATUM .OBJ>)
 533               (<TYPE? .ITEM TEMP> <PUT .ITEM ,TMPAC .OBJ>)
 534               (ELSE <PUT .ITEM ,INACS .OBJ>)>>
 535
 536 <DEFINE TEMP-MOD (DAT "AUX" TAC VAC TDAC VDAC)
 537         #DECL ((DAT) DATUM)
 538         <COND (<TYPE? <SET TDAC <DATTYP .DAT>> TEMP>
 539                <COND (<SET TAC <TMPAC .TDAC>>
 540                       <AND <TYPE? <SET TAC <DATTYP .TAC>> AC>
 541                            <PUT .TAC ,ACLINK (.DAT)>
 542                            <PUT .DAT ,DATTYP .TAC>
 543                            <OR <MEMQ .TDAC <CHTYPE <ACRESIDUE .TAC> LIST>>
 544                                <PUT .TAC
 545                                     ,ACRESIDUE
 546                                     (.TDAC !<ACRESIDUE .TAC>)>>>)>)>
 547         <COND (<TYPE? <SET VDAC <DATVAL .DAT>> TEMP>
 548                <COND (<SET VAC <TMPAC .VDAC>>
 549                       <AND <TYPE? <SET VAC <DATVAL .VAC>> AC>
 550                            <PUT .VAC ,ACLINK (.DAT)>
 551                            <PUT .DAT ,DATVAL .VAC>
 552                            <OR <MEMQ .VDAC <CHTYPE <ACRESIDUE .VAC> LIST>>
 553                                <PUT .VAC
 554                                     ,ACRESIDUE
 555                                     (.VDAC !<ACRESIDUE .VAC>)>>>)>)>>
 556
 557 <DEFINE POTENT-L-V? (SYM "AUX" PA) #DECL ((SYM) SYMTAB (PA) <OR FALSE <LIST NODE>>)
 558         <COND (<AND <STORED .SYM>
 559                     <SET PA <PROG-AC .SYM>>
 560                     <NOT <MEMQ .SYM <LOOP-VARS <1 .PA>>>>> T)>>
 561
 562
 563
 564 <DEFINE SAVE:RES ("AUX" (SYM-LIST ())) #DECL ((SYM-LIST) LIST)
 565    <MAPF <>
 566     <FUNCTION (AC)
 567             #DECL ((AC) AC)
 568             <MAPF <>
 569              <FUNCTION (SYMT "AUX" ONSYMT OP!-PACKAGE)
 570                      <COND (<AND <TYPE? .SYMT SYMTAB>
 571                                  <NOT <MEMQ .SYMT .SYM-LIST>>>
 572                             <SET OP!-PACKAGE <POTLV .SYMT>>
 573                             <SET ONSYMT <NUM-SYM .SYMT>>
 574                             <SMASH-NUM-SYM .SYMT>
 575                             <SET SYM-LIST
 576                                  (.SYMT
 577                                   <INACS .SYMT>
 578                                   .ONSYMT
 579                                   .OP!-PACKAGE
 580                                   <>
 581                                   !.SYM-LIST)>
 582                             <COND (<NOT <STORED .SYMT>> <STOREV .SYMT <>>)
 583                                   (<POTENT-L-V? .SYMT>
 584                                    <COND (<NOT .OP!-PACKAGE>
 585                                           <PUT .SYMT ,STORED <>>
 586                                           <STOREV .SYMT <>>
 587                                           <PUT .SYMT ,POTLV T>)>
 588                                    <PUT .SYM-LIST 5 <LIST !<NUM-SYM .SYMT>>>)>)>>
 589              <ACRESIDUE .AC>>>
 590     ,ALLACS>
 591    .SYM-LIST>
 592
 593 <DEFINE SAVE-NUM-SYM (SYM-LIST "AUX" (L (())) (LP .L) TMP)
 594    #DECL ((SYM-LIST) <LIST [REST SYMTAB ANY ANY <OR FALSE ATOM> ANY]>)
 595    <REPEAT ()
 596      <COND (<EMPTY? .SYM-LIST> <RETURN <REST .L>>)>
 597      <SET LP
 598       <REST
 599        <PUTREST
 600         .LP
 601         (<LIST !<COND (<AND <TYPE? <SET TMP <NUM-SYM <1 .SYM-LIST>>> LIST>
 602                             <NOT <EMPTY? .TMP>>>
 603                        <REST .TMP>)
 604                       (ELSE ())>>)>>>
 605      <SET SYM-LIST <REST .SYM-LIST 5>>>>
 606
 607 <DEFINE FIX-NUM-SYM (L1 L2 "AUX" LL TMP)
 608         #DECL ((L1) <LIST [REST LIST]>
 609                (L2) <LIST [REST SYMTAB ANY ANY <OR FALSE ATOM> ANY]>)
 610         <REPEAT ()
 611                 <COND (<OR <EMPTY? .L1> <EMPTY? .L2>> <RETURN>)
 612                       (<AND <TYPE? <SET TMP <NUM-SYM <1 .L2>>> LIST>
 613                             <NOT <EMPTY? .TMP>>>
 614                        <SET LL <1 .L1>>
 615                        <REPEAT ((L <REST .TMP>))
 616                                <COND (<EMPTY? .L> <RETURN>)>
 617                                <COND (<NOT <MEMQ <1 .L> .LL>>
 618                                       <PUTREST .TMP <REST .L>>
 619                                       <SET L <REST .TMP>>)
 620                                      (ELSE <SET L <REST <SET TMP .L>>>)>>)>
 621                 <SET L1 <REST .L1>>
 622                 <SET L2 <REST .L2 5>>>>
 623
 624 <DEFINE CHECK:VARS (RES UNK "AUX" SLOT TEM SYMT PRGAC)
 625         #DECL ((RES)
 626                <LIST [REST SYMTAB ANY ANY <OR FALSE ATOM> <OR FALSE LIST>]>
 627                (SYMT)
 628                SYMTAB
 629                (SLOT)
 630                LIST
 631                (PRGAC)
 632                <OR FALSE <LIST NODE>>
 633                (TEM)
 634                <OR FALSE LIST>)
 635         <REPEAT ((PTR .RES))
 636                 <COND (<EMPTY? .PTR> <RETURN>)>
 637                 <SET SYMT <1 .PTR>>
 638                 <COND (<AND <INACS .SYMT> .UNK>
 639                        <COND (<AND <1 <SET SLOT <NUM-SYM .SYMT>>>
 640                                    <NOT <EMPTY? <REST .SLOT>>>>
 641                               <PUT .SYMT ,STORED <POTENT-L-V? .SYMT>>
 642                               <MAPF <> ,KILL-STORE <REST .SLOT>>)>)>
 643                 <COND (<AND <POTLV .SYMT>
 644                             <NOT <AND <SET PRGAC <PROG-AC .SYMT>>
 645                                       <MEMQ .SYMT <LOOP-VARS <1 .PRGAC>>>>>
 646                             <SET TEM <5 .PTR>>
 647                             <G=? <LENGTH .TEM> 1>
 648                             <NUM-SYM .SYMT>
 649                             <1 .TEM>>
 650                        <MAPF <> ,KILL-STORE <REST .TEM>>)>
 651                 <COND (<=? <NUM-SYM .SYMT> '(#FALSE ())>
 652                        <PUT .SYMT ,NUM-SYM <3 .PTR>>
 653                        <COND (<AND <TYPE? <NUM-SYM .SYMT> LIST>
 654                                    <NOT <EMPTY? <NUM-SYM .SYMT>>>>
 655                               <PUT <NUM-SYM .SYMT> 1 <>>)>)
 656                       (ELSE <PUT .SYMT ,NUM-SYM <3 .PTR>>)>
 657                 <PUT .SYMT ,POTLV <4 .PTR>>
 658                 <SET PTR <REST .PTR 5>>>>
 659
 660
 661 <DEFINE STORE-TVAR (NAME DAT1 DAT2 ADDR)
 662         <EMIT <CHTYPE [,STORE:TVAR
 663                        .NAME
 664                        .ADDR
 665                        .DAT1
 666                        .DAT2
 667                        <NOT <TYPE? .DAT1 AC>>]
 668                       TOKEN>>>
 669
 670 <DEFINE KILL-STORE (SS)
 671         <SET SS <CHTYPE .SS ATOM>>
 672         <SET KILL-LIST (.SS !.KILL-LIST)>
 673         <EMIT <CHTYPE [,KILL:STORE .SS] TOKEN>>>
 674
 675 <DEFINE STORE-VAR (NAME DAT ADDR  BOOL)
 676         #DECL ((DAT) DATUM)
 677         <EMIT <CHTYPE [,STORE:VAR
 678                        .NAME
 679                        .ADDR
 680                        <COND (<TYPE? <DATTYP .DAT> AC> <ACSYM <DATTYP .DAT>>)
 681                              (<DATTYP .DAT>)>
 682                        <COND (<TYPE? <DATVAL .DAT> AC> <ACSYM <DATVAL .DAT>>)
 683                              (<DATVAL .DAT>)>
 684                        .BOOL]
 685                       TOKEN>>>
 686
 687 <DEFINE FLUSH-RESIDUE (AC SYMT) #DECL ((AC) AC (SYMT) SYMBOL)
 688         <AND <NOT <EMPTY? <ACRESIDUE .AC>>>
 689              <PUT .AC ,ACRESIDUE <RES-FLS <ACRESIDUE .AC> .SYMT>>>>
 690
 691
 692 <DEFINE CALL-INTERRUPT ("AUX" (ACDATA ![0 0!]) (ACLIST ()) (ACNUM 1))
 693    #DECL ((ACNUM) FIX (ACDATA) <UVECTOR FIX FIX> (ACLIST) <SPECIAL LIST>)
 694    <MAPF <>
 695     <FUNCTION (AC "AUX" TYP (ACL <ACLINK .AC>) (ACR <ACRESIDUE .AC>))
 696             #DECL ((AC) AC (ACR) <OR FALSE LIST> (ACL) <OR FALSE <LIST [REST DATUM]>>)
 697             <COND (.ACL
 698                    <COND (<L? .ACNUM 7>
 699                           <PUT .ACDATA
 700                                1
 701                                <DEPOSIT-DATA <1 .ACDATA>
 702                                              .ACNUM
 703                                              .AC
 704                                              <DATTYP <1 .ACL>>>>)
 705                          (ELSE
 706                           <PUT .ACDATA
 707                                2
 708                                <DEPOSIT-DATA <2 .ACDATA>
 709                                              <- .ACNUM 6>
 710                                              .AC
 711                                              <DATTYP <1 .ACL>>>>)>)
 712                   (.ACR
 713                    <COND (<L? .ACNUM 7>
 714                           <PUT .ACDATA
 715                                1
 716                                <DEPOSIT-DATA <1 .ACDATA>
 717                                              .ACNUM
 718                                              .AC
 719                                              <SINACS <1 .ACR>>>>)
 720                          (ELSE
 721                           <PUT .ACDATA
 722                                2
 723                                <DEPOSIT-DATA
 724                                 <2 .ACDATA>
 725                                 <- .ACNUM 6>
 726                                 .AC
 727                                 <SINACS <1 .ACR>>>>)>)>
 728             <SET ACNUM <+ .ACNUM 1>>>
 729     ,ALLACS>
 730    <COND (<AND <0? <1 .ACDATA>> <0? <2 .ACDATA>>> <EMIT '<INTGO!-OP!-PACKAGE>>)
 731          (ELSE
 732           <EMIT '<`SKIPGE  |INTFLG >>
 733           <MAPR <>
 734                 <FUNCTION (PTR "AUX" (TYP <1 .PTR>))
 735                         #DECL ((TYP) ATOM)
 736                         <PUT .PTR
 737                              1
 738                              <FORM 0 <FORM TYPE-WORD!-OP!-PACKAGE .TYP>>>>
 739                 .ACLIST>
 740           <EMIT <INSTRUCTION <COND (<0? <2 .ACDATA>> `SAVAC* ) (ELSE `LSAVA* )>
 741                              <COND (<0? <2 .ACDATA>>
 742                                     [<FORM (<GETBITS <1 .ACDATA> <BITS 18 18>>)
 743                                            <GETBITS <1 .ACDATA> <BITS 18>>>
 744                                      !.ACLIST])
 745                                    (ELSE
 746                                     [<FORM (<GETBITS <1 .ACDATA> <BITS 18 18>>)
 747                                            <GETBITS <1 .ACDATA> <BITS 18>>>
 748                                      <FORM (<GETBITS <2 .ACDATA> <BITS 18 18>>)
 749                                            <GETBITS <2 .ACDATA> <BITS 18>>>
 750                                      !.ACLIST])>>>)>>
 751
 752 <DEFINE DEPOSIT-DATA (DATA ACNUM AC DAT "AUX" TYP)
 753         #DECL ((DATA ACNUM) FIX (AC) AC (DAT) DATUM)
 754         <COND (<TYPE? <SET TYP <DATTYP .DAT>> ATOM>
 755                <DEPOSIT-TYPE .DATA .ACNUM .TYP>)
 756               (<TYPE? .TYP AC>
 757                <COND (<N=? .AC .TYP> <DEPOSIT-AC .DATA .ACNUM .TYP>)
 758                      (.DATA)>)
 759               (<TYPE? .TYP OFFPTR> <DEPOSIT-TYPE .DATA .ACNUM <3 .TYP>>)>>
 760
 761 <DEFINE DEPOSIT-TYPE (DATA ACNUM TYP "AUX" (ACL .ACLIST))
 762         #DECL ((DATA ACNUM) FIX (TYP) ATOM (ACLIST ACL) LIST)
 763         <COND (<==? <TYPEPRIM .TYP> TEMPLATE>
 764                <SET DATA
 765                     <CHTYPE <PUTBITS .DATA
 766                                      <NTH ,DATABITS .ACNUM>
 767                                      #WORD *000000000077*>
 768                             FIX>>
 769                <COND (<EMPTY? .ACL> <SET ACLIST (.TYP)>)
 770                      (<PUTREST <REST .ACL <- <LENGTH .ACL> 1>> (.TYP)>)>)
 771               (<==? <TYPEPRIM .TYP> WORD>)
 772               (<SET DATA
 773                     <CHTYPE <PUTBITS .DATA
 774                                      <NTH ,DATABITS .ACNUM>
 775                                      <+ <CHTYPE <PRIM-CODE <TYPE-C .TYP>> FIX> 8>>
 776                             FIX>>)>
 777         .DATA>
 778
 779 <DEFINE DEPOSIT-AC (DATA ACNUM TYP)
 780         #DECL ((DATA ACNUM) FIX (TYP) AC)
 781         <CHTYPE <PUTBITS .DATA <NTH ,DATABITS .ACNUM> <ACNUM .TYP>>
 782                 FIX>>
 783
 784 <SETG DATABITS
 785       ![<BITS 6 30>
 786         <BITS 6 24>
 787         <BITS 6 18>
 788         <BITS 6 12>
 789         <BITS 6 6>
 790         <BITS 6 0>!]>
 791
 792 <GDECL (DATABITS) <UVECTOR [6 BITS]>>
 793
 794 <DEFINE FIND-AC-TYPE (OBJ) <COND (<TYPE? .OBJ OFFPTR> <3 .OBJ>) (.OBJ)>>
 795
 796 <DEFINE FIND-AC-VAL (OBJ) <COND (<TYPE? .OBJ OFFPTR> <DATVAL <2 .OBJ>>)>>
 797
 798 <DEFINE FIND-TYPE-OF-ACL (DAT "AUX" D1)
 799         #DECL ((DAT) DATUM)
 800         <COND (<OR <TYPE? <SET D1 <DATTYP .DAT>> OFFPTR>
 801                    <TYPE? <SET D1 <DATVAL .DAT>> OFFPTR>>
 802                <3 <CHTYPE .D1 OFFPTR>>) ;"This CHTYPE to get around compiler bug."
 803               (<AND <TYPE? <SET D1 <DATTYP .DAT>> ATOM> <VALID-TYPE? .D1>>
 804                .D1)>>
 805
 806 <DEFINE HACK-OFFPTR (OFF TMP "AUX" DAT)
 807         #DECL ((OFF) OFFPTR (TMP) TEMP)
 808         <SET DAT <2 .OFF>>
 809         <PUT .DAT ,DATVAL .TMP>>
 810
 811
 812
 813 <DEFINE STOREV (SYM "OPTIONAL" (FLS T)  "AUX" (DAT <SINACS .SYM>))
 814    #DECL ((SYM) <OR TEMP SYMTAB COMMON> (DAT) <OR FALSE DATUM>)
 815    <SMASH-INACS .SYM <> <>>
 816    <COND
 817     (<TYPE? .SYM SYMTAB>
 818      <AND
 819       .DAT
 820       <NOT <STORED .SYM>>
 821       <PROG ((SLOT <NUM-SYM .SYM>) NT ADDR)
 822         <SET NT <GET-NUM-SYM .SYM>>
 823         <COND
 824          (<TYPE? <ADDR-SYM .SYM> TEMPV>
 825           <STORE-TVAR .NT
 826                       <COND (<TYPE? <DATTYP .DAT> AC> <ACSYM <DATTYP .DAT>>)
 827                             (ELSE <DATTYP .DAT>)>
 828                       <ACSYM <CHTYPE <DATVAL .DAT> AC>>
 829                       <DATVAL <SET ADDR
 830                                 <LADDR .SYM <> <ISTYPE-GOOD? <DATTYP .DAT>> <>>>>>)
 831          (<STORE-VAR
 832            .NT
 833            .DAT
 834            <DATVAL <SET ADDR <LADDR .SYM <> <ISTYPE-GOOD? <DATTYP .DAT>> <>>>>
 835            <ISTYPE-GOOD? <DATTYP .ADDR>>>)>
 836         <RET-TMP-AC .ADDR>
 837         <PUT .SYM ,STORED T>>>)>
 838    <COND (.FLS <SMASH-INACS .SYM <>>)
 839          (<SMASH-INACS .SYM .DAT>)>>
 840
 841
 842 <DEFINE GET-NUM-SYM (SYM "AUX" (SLOT <NUM-SYM .SYM>) NT)
 843         <COND (<AND <TYPE? .SLOT LIST> <1 .SLOT>>
 844                <PUTREST .SLOT (<SET NT <MAKE:TAG "VAR">> !<REST .SLOT>)>)
 845               (ELSE <SET NT T>)>
 846         .NT>
 847
 848
 849 <DEFINE KILL-LOOP-AC (SYMT "AUX" PNOD)
 850         <COND (<AND <TYPE? .SYMT SYMTAB>
 851                     <SET PNOD <PROG-AC .SYMT>>
 852                     <NOT <MEMQ .SYMT <LOOP-VARS <PROG-SLOT .PNOD>>>>>
 853                <PUT .SYMT ,PROG-AC <>>)>>
 854
 855
 856 <DEFINE SMASH-NUM-SYM (SYM) #DECL ((SYM) SYMTAB) <PUT .SYM ,NUM-SYM (T)>>
 857
 858
 859 <ENDPACKAGE>