X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=mim%2Fdevelopment%2Fmim%2Fvaxc%2Fac.mud;fp=mim%2Fdevelopment%2Fmim%2Fvaxc%2Fac.mud;h=ba554219f1e26adb549c3a74d42f4d30f69d7f05;hp=0000000000000000000000000000000000000000;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07

diff --git a/mim/development/mim/vaxc/ac.mud b/mim/development/mim/vaxc/ac.mud
new file mode 100644
index 0000000..ba55421
--- /dev/null
+++ b/mim/development/mim/vaxc/ac.mud
@@ -0,0 +1,563 @@
+
+<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>>>