--- /dev/null
+
+<DEFINE CREATE-AC (NAME NUM "AUX" RNUM LVS)
+ #DECL ((NAME) ATOM (NUM) FIX)
+ <SET LVS <IVECTOR ,NUMVARS-AC>>
+ <SET LVS <REST .LVS ,NUMVARS-AC>>
+ <CHTYPE [.NAME .NUM 0 <> .NUM <> <> .LVS <>] AC>>
+
+<DEFINE INITIALIZE-ACS ("AUX" (NUM -1))
+ <MAPF <>
+ <FUNCTION (ATM1 ATM2 NUM-SYM)
+ <SETG .ATM1 <CREATE-AC .ATM2 <SET NUM <+ .NUM 1>>>>
+ <COND (<TYPE? .NUM-SYM ATOM> <SETG .NUM-SYM .NUM>)>>
+ '[AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6 AC-7 AC-8 AC-9 AC-10 AC-M
+ AC-F AC-TP AC-P AC-PC]
+ '[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
+ P PC]
+ '[0 0 0 0 0 0 0 0 0 0 0 NAC-M NAC-F NAC-TP NAC-P NAC-PC]>
+ <SETG ALL-ACS
+ [,AC-0
+ ,AC-1
+ ,AC-2
+ ,AC-3
+ ,AC-4
+ ,AC-5
+ ,AC-6
+ ,AC-7
+ ,AC-8
+ ,AC-9
+ ,AC-10]>
+ <SETG VAL-ACS [,AC-1 ,AC-3 ,AC-5 ,AC-7 ,AC-9]>
+ <SETG TYPE-ACS [,AC-0 ,AC-2 ,AC-4 ,AC-6 ,AC-8]>
+ <SETG AC-TIME 0>
+ <INIT-VARIABLE-CACHE>>
+
+<DEFINE RESET-AC-STACK-MODEL ("AUX" (CACHE ,VARIABLE-CACHE))
+ <MAPF <>
+ <FCN (AC "AUX" (VARS <AC-VARS .AC>))
+ <PUT .AC ,AC-VARS <REST .VARS <LENGTH .VARS>>>>
+ ,ALL-ACS>
+ <SETG VARIABLE-CACHE <REST .CACHE <LENGTH .CACHE>>>
+ <INIT-STACK-MODEL>
+ <INIT-VAR-LIST>
+ <SETG STATUS-AC <>>
+ <SETG STATUS-VAR <>>>
+
+<DEFINE CLEAR-DEATH ()
+ <MAPF <> <FCN (VAR) <PUT .VAR ,VARTBL-DEAD? <>>> ,VAR-LIST>>
+
+<DEFINE INDICATE-ALL-DEAD ()
+ <MAPF <> <FCN (VAR) <PUT .VAR ,VARTBL-DEAD? T>> ,VAR-LIST>>
+
+<DEFINE SAFE-DEAD-VAR ("TUPLE" VARS)
+ #DECL ((VARS) <TUPLE [REST <OR VARTBL ATOM>]>)
+ <MAPF <>
+ <FUNCTION (VAR "AUX" LV VAC CAC TAC TWAC)
+ <COND
+ (<TYPE? .VAR VARTBL>
+ <COND (<AND <SET LV <FIND-CACHE-VAR .VAR>>
+ <OR <NOT <VARTBL-RDECL .VAR>>
+ <NOT <LINKVAR-DECL .LV>>
+ <COUNT-NEEDED? <LINKVAR-DECL .LV>>>>
+ <COND (<OR <AND <LINKVAR-COUNT-STORED .LV>
+ <NOT <LINKVAR-VALUE-STORED .LV>>>
+ <AND <LINKVAR-TYPE-STORED .LV>
+ <NOT <LINKVAR-VALUE-STORED .LV>>>
+ <AND <LINKVAR-VALUE-STORED .LV>
+ <OR <NOT <LINKVAR-COUNT-STORED .LV>>
+ <NOT <LINKVAR-TYPE-STORED .LV>>>>>
+ <EMIT ,INST-CLRL <ADDR-VAR-TYPE .VAR>>)>)>
+ <DEAD-VAR .VAR>)>>
+ .VARS>
+ NORMAL>
+
+<DEFINE DEAD-VAR ("TUPLE" VARS)
+ #DECL ((VARS) <TUPLE [REST <OR VARTBL ATOM>]>)
+ <MAPF <>
+ <FCN (VAR)
+ <COND (<TYPE? .VAR VARTBL>
+ <MAPF <>
+ <FCN (AC) <BREAK-LINK .AC .VAR>>
+ ,ALL-ACS>)>>
+ .VARS>
+ NORMAL>
+
+<DEFINE USE-ALL-ACS () <MAPF <> ,USE-AC ,ALL-ACS>>
+
+<GDECL (EMPTY-VAR) VARTBL (EMPTY-LINKVAR) LINKVAR>
+
+<DEFINE CREATE-LINKVAR (VAR)
+ #DECL ((VAR) VARTBL)
+ <CHTYPE <VECTOR .VAR <> <> <> <> <> <> <> <> ()> LINKVAR>>
+
+<DEFINE COPY-LINKVAR (LV)
+ #DECL ((LV) LINKVAR)
+ <CHTYPE <VECTOR <LINKVAR-VAR .LV>
+ <LINKVAR-VALUE-STORED .LV>
+ <LINKVAR-COUNT-STORED .LV>
+ <LINKVAR-TYPE-STORED .LV>
+ <LINKVAR-DECL .LV>
+ <LINKVAR-VALUE-AC .LV>
+ <LINKVAR-TYPE-AC .LV>
+ <LINKVAR-COUNT-AC .LV>
+ <LINKVAR-TYPE-WORD-AC .LV>
+ <LINKVAR-POTENTIAL-SAVES .LV>>
+ LINKVAR>>
+
+"THIS OPERATION SAYS THAT THE TYPE-WORD, VALUE-WORD, COUNT, OR TYPE
+ OF A VARIABLE IS IN AN AC"
+
+<DEFINE LINK-VAR-TO-AC (VAR AC KIND
+ "OPTIONAL" (STORED? <>) (FLUSH-DECL T)
+ "AUX" PAC LV (TIN? <>) (CIN? <>) (VIN? <>))
+ #DECL ((LV) LINKVAR (AC) AC (SV) <OR ATOM FALSE>)
+ <SET LV <CACHE-VAR .VAR>>
+ <COND (<OR <LINKVAR-TYPE-AC .LV> <LINKVAR-TYPE-WORD-AC .LV>>
+ <SET TIN? T>)>
+ <COND (<OR? <LINKVAR-COUNT-AC .LV> <LINKVAR-TYPE-WORD-AC .LV>>
+ <SET CIN? T>)>
+ <COND (<LINKVAR-VALUE-AC .LV> <SET VIN? T>)>
+ <PLACE-LV-IN-AC .AC .LV>
+ <COND (<==? .KIND TYPE-VALUE-PAIR> <PLACE-LV-IN-AC <NEXT-AC .AC> .LV>)>
+ <AND .FLUSH-DECL <INDICATE-VAR-TEMP-DECL .VAR <>>>
+ <COND (<==? .KIND TYPE-VALUE-PAIR>
+ <AND <SET PAC <LINKVAR-TYPE-WORD-AC .LV>>
+ <REMOVE-LV-FROM-AC .PAC .LV>>
+ <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC>
+ <SET AC <NEXT-AC .AC>>
+ <AND <SET PAC <LINKVAR-VALUE-AC .LV>>
+ <REMOVE-LV-FROM-AC .PAC .LV>>
+ <PUT .LV ,LINKVAR-VALUE-AC .AC>)
+ (<==? .KIND VALUE>
+ <AND <SET PAC <LINKVAR-VALUE-AC .LV>>
+ <REMOVE-LV-FROM-AC .PAC .LV>>
+ <PUT .LV ,LINKVAR-VALUE-AC .AC>)
+ (<==? .KIND TYPE>
+ <AND <SET PAC <LINKVAR-TYPE-AC .LV>>
+ <REMOVE-LV-FROM-AC .PAC .LV>>
+ <PUT .LV ,LINKVAR-TYPE-AC .AC>)
+ (<==? .KIND TYPE-WORD>
+ <AND <SET PAC <LINKVAR-TYPE-WORD-AC .LV>>
+ <REMOVE-LV-FROM-AC .PAC .LV>>
+ <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC>)
+ (<==? .KIND COUNT>
+ <AND <SET PAC <LINKVAR-COUNT-AC .LV>>
+ <REMOVE-LV-FROM-AC .PAC .LV>>
+ <PUT .LV ,LINKVAR-COUNT-AC .AC>)
+ (<ERROR BAD-MODE .KIND LINK-VAR-TO-AC>)>
+ <COND (<N==? .STORED? NO-CHANGE>
+ <OR .VIN? <PUT .LV ,LINKVAR-VALUE-STORED .STORED?>>
+ <OR .TIN? <PUT .LV ,LINKVAR-TYPE-STORED .STORED?>>
+ <OR .CIN? <PUT .LV ,LINKVAR-COUNT-STORED .STORED?>>)>>
+
+<DEFINE PLACE-LV-IN-AC (AC LV "AUX" (VARS <AC-VARS .AC>))
+ #DECL ((AC) AC (LV) LINKVAR)
+ <COND (<NOT <MEMQ .LV .VARS>>
+ <COND (<==? <TOP .VARS> .VARS> <SET VARS [.LV !.VARS]>)
+ (ELSE <SET VARS <BACK .VARS>> <PUT .VARS 1 .LV>)>
+ <AND <G? <LENGTH .VARS> 1> <USE-AC .AC>>
+ <PUT .AC ,AC-VARS .VARS>)>>
+
+<DEFINE REMOVE-LV-FROM-AC (AC LV "AUX" (VARS <AC-VARS .AC>))
+ #DECL ((LV) LINKVAR (AC) AC)
+ <PUT .AC ,AC-VARS <REMOVE-LINKVAR .LV .VARS>>>
+
+<DEFINE INDICATE-CACHED-VARIABLE-DECL (VAR DECL "AUX" LV)
+ #DECL ((VAR) VARTBL (DECL) <OR FALSE ATOM>)
+ <SET LV <FIND-CACHE-VAR .VAR>>
+ <COND (.LV
+ <PUT .LV ,LINKVAR-DECL .DECL>
+ <INDICATE-VAR-TEMP-DECL .VAR .DECL>)>>
+
+<DEFINE INDICATE-CACHED-VARIABLE-STORED (VAR STORED? TYP "AUX" LV)
+ #DECL ((VAR) VARTBL (STORED?) <OR FALSE ATOM> (TYP) ATOM)
+ <SET LV <FIND-CACHE-VAR .VAR>>
+ <AND .LV
+ <COND (<==? .TYP TYPE> <PUT .LV ,LINKVAR-TYPE-STORED .STORED?>)
+ (<==? .TYP VALUE> <PUT .LV ,LINKVAR-VALUE-STORED .STORED?>)
+ (<==? .TYP COUNT> <PUT .LV ,LINKVAR-COUNT-STORED .STORED?>)>
+ <PUT .LV ,LINKVAR-DECL .TYP>>>
+
+<DEFINE INIT-VARIABLE-CACHE ("AUX" RES)
+ <INIT-VAR-LIST>
+ <SETG EMPTY-VAR <CREATE-VAR \ T>>
+ <SETG EMPTY-LINKVAR <CREATE-LINKVAR ,EMPTY-VAR>>
+ <SET RES <IVECTOR ,CACHE-LENGTH ,EMPTY-LINKVAR>>
+ <SETG VARIABLE-CACHE <REST .RES <LENGTH .RES>>>>
+
+<DEFINE FIND-CACHE-VAR (VAR "OPTIONAL" (CACHE ,VARIABLE-CACHE))
+ #DECL ((VAR) VARTBL (CACHE) AC-STATE)
+ <MAPF <>
+ <FCN (LV) <AND <==? <LINKVAR-VAR .LV> .VAR> <MAPLEAVE .LV>>>
+ .CACHE>>
+
+<DEFINE VAR-VALUE-IN-AC? (VAR "AUX" LVAR)
+ #DECL ((VAR) VARTBL)
+ <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <AND .LVAR <LINKVAR-VALUE-AC .LVAR>>>
+
+<DEFINE VAR-TYPE-IN-AC? (VAR "AUX" LVAR)
+ #DECL ((VAR) VARTBL)
+ <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <AND .LVAR <OR <LINKVAR-TYPE-AC .LVAR> <LINKVAR-TYPE-WORD-AC .LVAR>>>>
+
+<DEFINE VAR-COUNT-IN-AC? (VAR "AUX" LVAR)
+ #DECL ((VAR) VARTBL)
+ <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <AND .LVAR <LINKVAR-COUNT-AC .LVAR>>>
+
+<DEFINE VAR-TYPE-WORD-IN-AC? (VAR "AUX" LVAR)
+ #DECL ((VAR) VARTBL)
+ <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <AND .LVAR <LINKVAR-TYPE-WORD-AC .LVAR>>>
+
+<DEFINE VAR-COUNT-STORED? (VAR "AUX" LVAR)
+ <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
+ <AND <LINKVAR-COUNT-STORED .LVAR> <ADDR-VAR-COUNT .VAR>>)
+ (<ADDR-VAR-COUNT .VAR>)>>
+
+<DEFINE SAFE-TYPE-WORD? (VAR "AUX" LVAR)
+ #DECL ((VAR) VARTBL)
+ <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
+ <OR <LINKVAR-TYPE-WORD-AC .LVAR>
+ <AND <LINKVAR-TYPE-STORED .LVAR>
+ <LINKVAR-COUNT-STORED .LVAR>>
+ <AND <VARTBL-RDECL .VAR>
+ <NOT <COUNT-NEEDED? <LINKVAR-DECL .LVAR>>>>>)
+ (T)>>
+
+<DEFINE CACHE-VAR (VAR "OPTIONAL" (LVC <>) "AUX" RES CACHE)
+ #DECL ((VAR) VARTBL (LVC) <OR FALSE LINKVAR>)
+ <COND (<SET RES <FIND-CACHE-VAR .VAR>>)
+ (ELSE
+ <SET CACHE ,VARIABLE-CACHE>
+ <COND (.LVC <SET RES <COPY-LINKVAR .LVC>>)
+ (<SET RES <CREATE-LINKVAR .VAR>>)>
+ <COND (<==? .CACHE <TOP .CACHE>> <SET CACHE [.RES !.CACHE]>)
+ (ELSE <SET CACHE <BACK .CACHE>> <PUT .CACHE 1 .RES>)>
+ <SETG VARIABLE-CACHE .CACHE>)>
+ .RES>
+
+<DEFINE BREAK-LINK (AC VAR "AUX" (VARS <AC-VARS .AC>) LV)
+ #DECL ((AC) AC (VAR) VARTBL)
+ <COND (<SET LV <FIND-CACHE-VAR .VAR .VARS>>
+ <REMOVE-LV-FROM-AC .AC .LV>
+ <COND (<==? <LINKVAR-VALUE-AC .LV> .AC>
+ <PUT .LV ,LINKVAR-VALUE-AC <>>)
+ (<==? <LINKVAR-TYPE-AC .LV> .AC>
+ <PUT .LV ,LINKVAR-TYPE-AC <>>)
+ (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC>
+ <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)
+ (<==? <LINKVAR-COUNT-AC .LV> .AC>
+ <PUT .LV ,LINKVAR-COUNT-AC <>>)>
+ <COND (<AND <NOT <LINKVAR-VALUE-AC .LV>>
+ <NOT <LINKVAR-TYPE-AC .LV>>
+ <NOT <LINKVAR-TYPE-WORD-AC .LV>>
+ <NOT <LINKVAR-COUNT-AC .LV>>>
+ <REMOVE-VAR-FROM-CACHE .LV>)>)>>
+
+<DEFINE REMOVE-VAR-FROM-CACHE (LV)
+ <SETG VARIABLE-CACHE <REMOVE-LINKVAR .LV ,VARIABLE-CACHE>>>
+
+<DEFINE REMOVE-LINKVAR (LV "OPTIONAL" (CACHE ,VARIABLE-CACHE) "AUX" LVS DIST)
+ #DECL ((LV) LINKVAR (CACHE) <VECTOR [REST LINKVAR]>)
+ <SET LVS <MEMQ .LV .CACHE>>
+ <COND (.LVS
+ <SET DIST <- <LENGTH .CACHE> <LENGTH .LVS>>>
+ <AND <G? .DIST 0> <SUBSTRUC .CACHE 0 .DIST <REST .CACHE>>>
+ <REST .CACHE>)
+ (.CACHE)>>
+
+<DEFINE CLEAR-VARS-FROM-AC (AC "OPTIONAL" (SAVE? <>) (ALL? <>)
+ "AUX" (VARS <AC-VARS .AC>))
+ <MAPF <> <FCN (LV "AUX" TAC)
+ #DECL ((LV) LINKVAR)
+ <COND (<N==? .LV .SAVE?>
+ <BREAK-LINK .AC <LINKVAR-VAR .LV>>
+ <COND (.ALL?
+ ; "Only called by STORE-AC, which has
+ already stored everything in the AC.
+ This forces all parts of a variable
+ out of the ACs if any part is being
+ flushed."
+ <COND (<AND <SET TAC <LINKVAR-VALUE-AC .LV>>
+ <N==? .TAC .AC>>
+ <BREAK-LINK .TAC
+ <LINKVAR-VAR .LV>>)>
+ <COND (<AND <SET TAC
+ <LINKVAR-TYPE-WORD-AC .LV>>
+ <N==? .TAC .AC>>
+ <BREAK-LINK .TAC
+ <LINKVAR-VAR .LV>>)>
+ <COND (<AND <SET TAC <LINKVAR-TYPE-AC .LV>>
+ <N==? .TAC .AC>>
+ <BREAK-LINK .TAC
+ <LINKVAR-VAR .LV>>)>
+ <COND (<AND <SET TAC <LINKVAR-COUNT-AC .LV>>
+ <N==? .TAC .AC>>
+ <BREAK-LINK .TAC
+ <LINKVAR-VAR .LV>>)>)>)>>
+ .VARS>>
+
+<DEFINE MUNG-AC (VAC)
+ #DECL ((VAC) AC)
+ <STORE-AC .VAC T>
+ <USE-AC .VAC>
+ <CLEAR-VARS-FROM-AC .VAC>>
+
+<DEFINE FLUSH-ACS () <MAPF <> ,MUNG-AC ,ALL-ACS>>
+
+<DEFINE EXCH-AC (AC1 AC2 "AUX" (VARS <AC-VARS .AC2>))
+ #DECL ((AC1 AC2) AC)
+ <PUT .AC2 ,AC-VARS <AC-VARS .AC1>>
+ <PUT .AC1 ,AC-VARS .VARS>
+ <CLOAD-AC .AC1>
+ <CLOAD-AC .AC2>
+ <MAPF <>
+ <FCN (LV)
+ <PUT .LV
+ ,LINKVAR-VALUE-AC
+ <EXCH-TEST .AC1 .AC2 <LINKVAR-VALUE-AC .LV>>>
+ <PUT .LV
+ ,LINKVAR-TYPE-AC
+ <EXCH-TEST .AC1 .AC2 <LINKVAR-TYPE-AC .LV>>>
+ <PUT .LV
+ ,LINKVAR-COUNT-AC
+ <EXCH-TEST .AC1 .AC2 <LINKVAR-COUNT-AC .LV>>>
+ <PUT .LV
+ ,LINKVAR-TYPE-WORD-AC
+ <EXCH-TEST .AC1 .AC2 <LINKVAR-TYPE-WORD-AC .LV>>>>
+ ,VARIABLE-CACHE>>
+
+<DEFINE EXCH-TEST (AC1 AC2 ACL)
+ #DECL ((AC1 AC2) AC (ACL) <OR AC FALSE>)
+ <COND (<==? .AC1 .ACL> .AC2) (<==? .AC2 .ACL> .AC1) (.ACL)>>
+
+<DEFINE MOVE-AC (AC1 AC2 "AUX" (VARS1 <AC-VARS .AC1>) (VARS2 <AC-VARS .AC2>))
+ #DECL ((AC1 AC2) AC)
+ <USE-AC .AC1>
+ <MAPF <>
+ <FCN (LV)
+ <COND (<==? <LINKVAR-VALUE-AC .LV> .AC1>
+ <PUT .LV ,LINKVAR-VALUE-AC .AC2>)
+ (<==? <LINKVAR-TYPE-AC .LV> .AC1>
+ <PUT .LV ,LINKVAR-TYPE-AC .AC2>)
+ (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC1>
+ <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC2>)
+ (<==? <LINKVAR-COUNT-AC .LV> .AC1>
+ <PUT .LV ,LINKVAR-COUNT-AC .AC2>)>>
+ ,VARIABLE-CACHE>
+ <SET VARS2 <ADJUST-LENGTH .VARS2 <LENGTH .VARS1>>>
+ <PUT .AC2 ,AC-VARS .VARS2>
+ <MAPR <> <FCN (ACV2 ACV1) <PUT .ACV2 1 <1 .ACV1>>> .VARS2 .VARS1>
+ <CLEAR-VARS-FROM-AC .AC1>>
+
+<DEFINE ADJUST-LENGTH (VEC LEN "AUX" TVEC)
+ #DECL ((VEC) VECTOR (LEN) FIX)
+ <COND (<G? <LENGTH .VEC> .LEN>
+ <SET VEC <REST .VEC <- <LENGTH .VEC> .LEN>>>)
+ (<L? <LENGTH .VEC> .LEN>
+ <SET TVEC <TOP .VEC>>
+ <COND (<G? <LENGTH .TVEC> .LEN>
+ <SET VEC <REST .TVEC <- <LENGTH .TVEC> .LEN>>>)
+ (<SET VEC
+ [!<IVECTOR <- <LENGTH .TVEC> .LEN>> !.TVEC]>)>)>
+ .VEC>
+
+<DEFINE SET-AC-AGE (AC)
+ #DECL ((AC) AC (VAL) FIX)
+ <PUT .AC ,AC-AGE ,AC-TIME>
+ <SETG AC-TIME <+ ,AC-TIME 1>>>
+
+<DEFINE USE-AC (AC) #DECL ((AC) AC) <PUT .AC ,AC-USE T>>
+
+<DEFINE PROTECT (AC) #DECL ((AC) AC) <PUT .AC ,AC-PROT T> .AC>
+
+<DEFINE PROTECT-USE (AC) #DECL ((AC) AC) <PROTECT .AC> <USE-AC .AC>>
+
+<DEFINE UNPROTECT (AC) #DECL ((AC) AC) <PUT .AC ,AC-PROT <>>>
+
+<DEFINE UNPROTECT-ACS () <MAPF <> ,UNPROTECT ,ALL-ACS>>
+
+<DEFINE LOAD-AC (AC EA)
+ #DECL ((AC) AC)
+ <PUT .AC ,AC-LLOAD ,CODE-COUNT>
+ <PUT .AC ,AC-LLOAD-EA .EA>
+ <PUT .AC ,AC-USE <>>
+ <CLEAR-STATUS>>
+
+<DEFINE CLOAD-AC (AC)
+ #DECL ((AC) AC)
+ <PUT .AC ,AC-LLOAD <>>
+ <PUT .AC ,AC-LLOAD-EA <>>>
+
+<DEFINE SET-STATUS-AC (AC)
+ #DECL ((AC) AC)
+ <COND (,AC-STORE-OPT <SETG STATUS-AC .AC>) (<CLEAR-STATUS>)>>
+
+<DEFINE SET-STATUS-VAR (VAR STYP)
+ #DECL ((VAR) VARTBL (STYP) ATOM)
+ <COND (<AND ,STATUS-AC ,AC-STORE-OPT>
+ <SETG STATUS-VAR .VAR>
+ <SETG STATUS-TYPE .STYP>)>>
+
+<DEFINE CLEAR-STATUS () <SETG STATUS-AC <>> <SETG STATUS-VAR <>>>
+
+<DEFINE STATUS? (VAR STYPE "AUX" LVAR (SAC ,STATUS-AC))
+ #DECL ((VAR) VARTBL (STYPE) ATOM)
+ <COND (<AND ,STATUS-AC
+ <SET LVAR <FIND-CACHE-VAR .VAR <AC-VARS .SAC>>>
+ <OR <AND <==? .STYPE VALUE>
+ <==? <LINKVAR-VALUE-AC .LVAR> .SAC>>
+ <==? .STYPE COUNT>
+ <==? <LINKVAR-COUNT-AC .LVAR> .SAC>>>
+ ,STATUS-AC)
+ (<AND <==? .VAR ,STATUS-VAR> <==? .STYPE ,STATUS-TYPE>>
+ <COND (,STATUS-AC ,STATUS-AC) (VAR)>)>>
+
+<DEFINE PRINT-LINKVAR (LV "AUX" (OUTCHAN .OUTCHAN))
+ #DECL ((LV) LINKVAR)
+ <PRINC "#LINKVAR [">
+ <PRINC <VARTBL-NAME <LINKVAR-VAR .LV>>>
+ <PRINC " ">
+ <PRINC <LINKVAR-DECL .LV>>
+ <TESTPRINT <LINKVAR-VALUE-AC .LV> "VALUE" .OUTCHAN>
+ <TESTPRINT <LINKVAR-TYPE-AC .LV> "TYPE" .OUTCHAN>
+ <TESTPRINT <LINKVAR-TYPE-WORD-AC .LV> "TYPE-WORD" .OUTCHAN>
+ <TESTPRINT <LINKVAR-COUNT-AC .LV> "COUNT" .OUTCHAN>
+ <PRINC "]">>
+
+<DEFINE TESTPRINT (AC TYP OUTCHAN)
+ #DECL ((AC) <OR FALSE AC> (TYP) STRING (OUTCHAN) <SPECIAL CHANNEL>)
+ <COND (.AC
+ <PRINC " #">
+ <PRINC .TYP>
+ <PRINC " ">
+ <PRIN1 <AC-NAME .AC>>)>>
+
+<COND (<GASSIGNED? PRINT-LINKVAR> <PRINTTYPE LINKVAR ,PRINT-LINKVAR>)>
+
+<DEFINE PRINT-AC (AC "AUX" (OUTCHAN .OUTCHAN))
+ #DECL ((AC) AC)
+ <PRINC "#AC [">
+ <PRIN1 <AC-NAME .AC>>
+ <PRINC " ">
+ <MAPF <> <FCN (LV) <PRINT-SHORT-LINKVAR .LV .AC>> <AC-VARS .AC>>
+ <PRINC "]">>
+
+<COND (<GASSIGNED? PRINT-AC><PRINTTYPE AC ,PRINT-AC>)>
+
+<DEFINE PRINT-SHORT-LINKVAR (LV AC "AUX" (OUTCHAN .OUTCHAN))
+ #DECL ((LV) LINKVAR (AC) AC)
+ <COND (<==? <LINKVAR-TYPE-AC .LV> .AC> <PRINC "#TYPE ">)
+ (<==? <LINKVAR-VALUE-AC .LV> .AC> <PRINC "#VALUE ">)
+ (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC> <PRINC "#TYPE-WORD ">)
+ (<==? <LINKVAR-COUNT-AC .LV> .AC> <PRINC "#COUNT ">)>
+ <PRINC <VARTBL-NAME <LINKVAR-VAR .LV>>>
+ <PRINC " ">>
+
+<DEFINE FREE-TYPE-AC? ("OPTIONAL" (HOWFREE? NOVARS) (REAL? <>))
+ <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>>
+
+<DEFINE FREE-VALUE-AC? ("OPTIONAL" (HOWFREE? NOVARS))
+ <FIND-FREE-AC ,VAL-ACS .HOWFREE?>>
+
+<DEFINE FREE-AC? ("OPTIONAL" (PREF NONE) (HOWFREE? NOVARS))
+ <COND (<==? .PREF DOUBLE> <FIND-FREE-PAIR .HOWFREE?>)
+ (<==? .PREF NONE> <FIND-FREE-AC ,ALL-ACS .HOWFREE?>)
+ (<OR <==? .PREF TYPE> <==? .PREF PREF-TYPE>>
+ <OR <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>
+ <FIND-FREE-AC ,VAL-ACS .HOWFREE?>>)
+ (<OR <==? .PREF VALUE> <==? .PREF PREF-VAL>>
+ <OR <FIND-FREE-AC ,VAL-ACS .HOWFREE?>
+ <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>>)
+ (<ERROR BAD-PREFERENCE FREE-AC?>)>>
+
+<DEFINE FIND-FREE-PAIR (HOWFREE?)
+ <REPEAT ((ACS ,ALL-ACS) AC1 AC2)
+ <COND (<L? <LENGTH .ACS> 2> <RETURN <>>)>
+ <COND (<NOT <OR <AC-PROT <SET AC1 <1 .ACS>>>
+ <AC-PROT <SET AC2 <2 .ACS>>>>>
+ <COND (<==? .HOWFREE? NOVARS>
+ <COND (<AND <ALL-DEAD? .AC1> <ALL-DEAD? .AC2>>
+ <RETURN .AC1>)>)
+ (<==? .HOWFREE? STORED>
+ <COND (<AND <ALL-STORED? .AC1>
+ <ALL-STORED? .AC2>>
+ <RETURN .AC1>)>)
+ (ELSE <ERROR BAD-MODE FIND-FREE-PAIR>)>)>
+ <SET ACS <REST .ACS 2>>>>
+
+<DEFINE FIND-FREE-AC (ACLIST HOWFREE?)
+ #DECL ((ACLIST) <VECTOR [REST AC]> (HOWFREE?) ATOM)
+ <MAPF <>
+ <FCN (AC)
+ <AND <NOT <AC-PROT .AC>>
+ <COND (<==? .HOWFREE? NOVARS>
+ <AND <ALL-DEAD? .AC> <MAPLEAVE .AC>>)
+ (<==? .HOWFREE? STORED>
+ <AND <ALL-STORED? .AC> <MAPLEAVE .AC>>)
+ (<ERROR BAD-MODE FIND-FREE-AC>)>>>
+ .ACLIST>>
+
+<DEFINE AC-VAR-STORED? (VAR AC "AUX" LV)
+ #DECL ((VAR) VARTBL (AC) AC (LV) LINKVAR)
+ <COND (<SET LV <FIND-CACHE-VAR .VAR>>
+ <COND (<==? .AC <LINKVAR-VALUE-AC .LV>>
+ <LINKVAR-VALUE-STORED .LV>)
+ (<==? .AC <LINKVAR-COUNT-AC .LV>>
+ <LINKVAR-COUNT-STORED .LV>)
+ (<==? .AC <LINKVAR-TYPE-AC .LV>>
+ <LINKVAR-TYPE-STORED .LV>)
+ (<==? .AC <LINKVAR-TYPE-WORD-AC .LV>>
+ <LINKVAR-TYPE-STORED .LV>)
+ (<ERROR "VAR NOT IN AC" .VAR .AC>)>)
+ (<ERROR "VAR NOT IN AC" .VAR>)>>
+
+<DEFINE ALL-STORED? (AC "AUX" (VAL T))
+ #DECL ((AC) AC)
+ <MAPF <>
+ <FCN (LV)
+ <COND (<==? .AC <LINKVAR-VALUE-AC .LV>>
+ <AND <NOT <LINKVAR-VALUE-STORED .LV>>
+ <MAPLEAVE <SET VAL <>>>>)
+ (<==? .AC <LINKVAR-COUNT-AC .LV>>
+ <AND <NOT <LINKVAR-COUNT-STORED .LV>>
+ <MAPLEAVE <SET VAL <>>>>)
+ (<==? .AC <LINKVAR-TYPE-AC .LV>>
+ <AND <NOT <LINKVAR-TYPE-STORED .LV>>
+ <MAPLEAVE <SET VAL <>>>>)
+ (<==? .AC <LINKVAR-TYPE-WORD-AC .LV>>
+ <AND <NOT <LINKVAR-TYPE-STORED .LV>>
+ <MAPLEAVE <SET VAL <>>>>)
+ (<ERROR "VAR NOT IN AC" ALL-STORED?>)>>
+ <AC-VARS .AC>>
+ .VAL>
+
+<DEFINE ALL-DEAD? (AC "AUX" (VAL T))
+ #DECL ((AC) AC)
+ <MAPF <>
+ <FCN (LV)
+ <COND (<AND <NOT <VARTBL-DEAD? <LINKVAR-VAR .LV>>>
+ <NOT <WILL-DIE? <LINKVAR-VAR .LV>>>>
+ <MAPLEAVE <SET VAL <>>>)>>
+ <AC-VARS .AC>>
+ .VAL>
+
+<DEFINE FLUSH-ALL-ACS () <MAPF <> ,MUNG-AC ,ALL-ACS>>
+
+<DEFINE MOVE-TO-AC (AC ADDR LEN)
+ #DECL ((AC) AC (LEN) ATOM)
+ <COND (<==? .LEN LONG>
+ <EMIT-MOVE .ADDR <MA-REG .AC> LONG>
+ <LOAD-AC .AC .ADDR>)
+ (<==? .LEN WORD>
+ <EMIT ,INST-MOVZWL .ADDR <MA-REG .AC>>)
+ (<==? .LEN BYTE>
+ <EMIT ,INST-MOVZBL .ADDR <MA-REG .AC>>)>>
+
+<DEFINE PREV-AC (AC "AUX" (ACN <AC-NUMBER .AC>))
+ #DECL ((AC) AC)
+ <COND (<==? .ACN 0> <>) (ELSE <NTH ,ALL-ACS .ACN>)>>
+
+<DEFINE NEXT-AC (AC "AUX" (ACN <AC-NUMBER .AC>)) <NTH ,ALL-ACS <+ .ACN 2>>>
projects / pdp10-muddle.git / blobdiff