--- /dev/null
+
+<DEFINE INIT-VAR-LIST () <SETG VAR-LIST ()>>
+
+<DEFINE CREATE-VAR (NAME TEMP "OPTIONAL" (HACK? <>) "AUX" VAR CMOD)
+ #DECL ((NAME) <OR ATOM VARTBL> (TEMP) BOOLEAN)
+ <COND (<TYPE? .NAME ATOM>
+ <SET VAR
+ <CHTYPE <VECTOR .NAME <> <> <> <> .TEMP <> <>> VARTBL>>)
+ (T <SET VAR .NAME>)>
+ <COND (<NOT .HACK?>
+ <AND <GASSIGNED? CURRENT-MODEL>
+ <SET CMOD ,CURRENT-MODEL>
+ <PUT .CMOD ,SM-VARS (.VAR !<SM-VARS .CMOD>)>>
+ <COND (<NOT .TEMP> <GEN-LOC .VAR 0>)>)>
+ <COND (<TYPE? .NAME ATOM> <SETG VAR-LIST (.VAR !,VAR-LIST)>)>
+ .VAR>
+
+<DEFINE FIND-VAR (NAME "AUX" (VAR? <>))
+ #DECL ((NAME) ATOM (VALUE) <OR VARTBL FALSE>)
+ <MAPF <>
+ <FUNCTION (VAR)
+ <COND (<==? <VARTBL-NAME .VAR> .NAME>
+ <SET VAR? .VAR>
+ <MAPLEAVE>)>>
+ ,VAR-LIST>
+ .VAR?>
+
+<DEFINE INDICATE-VAR-DECL (VAR DCL)
+ #DECL ((VAR) VARTBL (DCL) <OR ATOM FALSE>)
+ <PUT .VAR ,VARTBL-RDECL .DCL>>
+
+<DEFINE INDICATE-VAR-INIT (VAR VAL)
+ #DECL ((VAR) VARTBL (VAL) ANY)
+ <COND (<TYPE? .VAL FALSE> <SET VAL <CHTYPE .VAL SPEC-FALSE>>)>
+ <PUT .VAR ,VARTBL-INIT .VAL>
+ <GEN-LOC .VAR 0>>
+
+<DEFINE INDICATE-VAR-TEMP-DECL (VAR DCL)
+ #DECL ((VAR) VARTBL (DCL) <OR FALSE ATOM>)
+ <PUT .VAR ,VARTBL-TDECL .DCL>>
+
+<DEFINE FLUSH-VAR-TEMP-DECLS ()
+ <MAPF <> <FCN (VAR) <INDICATE-VAR-TEMP-DECL .VAR <>>> ,VAR-LIST>>
+
+<DEFINE VARTBL-DECL (VAR "AUX" (LVAR <FIND-CACHE-VAR .VAR>))
+ #DECL ((VAR) VARTBL)
+ <OR <VARTBL-RDECL .VAR>
+ <VARTBL-TDECL .VAR>
+ <AND .LVAR <LINKVAR-DECL .LVAR>>>>
+
+<DEFINE ADDR-VAR-VALUE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 4>>
+
+<DEFINE ADDR-VAR-CHAR-VALUE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 4>>
+
+<DEFINE ADDR-VAR-COUNT (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 2>>
+
+<DEFINE ADDR-VAR-TYPE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 0>>
+
+<DEFINE ADDR-VAR-TYPE-VALUE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 0>>
+
+<DEFINE CREATE-MODEL () <CHTYPE <VECTOR 0 () () <> 0 ()> STK-MODEL>>
+
+<DEFINE INIT-STACK-MODEL ("AUX" MOD)
+ <SET MOD <CREATE-MODEL>>
+ <SETG CURRENT-MODEL .MOD>
+ <SETG TOP-MODEL .MOD>
+ <SETG STACK-LEVELS (.MOD)>>
+
+<DEFINE INDICATE-TEMP-PATCH (NUM)
+ #DECL ((NUM) FIX)
+ <PUT ,CURRENT-MODEL ,SM-PATCHLOC .NUM>>
+
+<DEFINE NEW-MODEL (MODEL)
+ #DECL ((MODEL) STK-MODEL)
+ <PUT ,CURRENT-MODEL ,SM-KIDS (.MODEL !<SM-KIDS ,CURRENT-MODEL>)>
+ <PUT .MODEL ,SM-PARENT ,CURRENT-MODEL>
+ <SETG CURRENT-MODEL .MODEL>>
+
+<DEFINE POP-MODEL ()
+ <COND (<NOT <SM-PARENT ,CURRENT-MODEL>>
+ <ERROR "TOPLEVEL MODEL" POP-MODEL>)>
+ <SETG CURRENT-MODEL <SM-PARENT ,CURRENT-MODEL>>>
+
+<DEFINE GEN-LOC (VAR IOFF "OPT" (DEF? <>)
+ "AUX" (OFF <VARTBL-LOC .VAR>) (CMOD ,CURRENT-MODEL) VARS)
+ #DECL ((VAR) VARTBL (IOFF) FIX)
+ <REPEAT ()
+ <COND (<MEMQ .VAR <SM-VARS .CMOD>> <RETURN>)
+ (<SET CMOD <SM-PARENT .CMOD>>)
+ (<ERROR "VARIABLE NOT FOUND" GEN-LOC>)>>
+ <COND (<NOT .OFF>
+ <SET OFF <SM-SAVED-VAR-POINTER .CMOD>>
+ <PUT .CMOD ,SM-SAVED-VAR-POINTER <+ .OFF 8>>
+ <PUT .VAR ,VARTBL-LOC .OFF>
+ <COND (<EMPTY? <SET VARS <SM-VARLIST .CMOD>>>
+ <PUT .CMOD ,SM-VARLIST (.VAR)>)
+ (<PUTREST <REST .VARS <- <LENGTH .VARS> 1>> (.VAR)>)>)>
+ <SET OFF <+ .OFF .IOFF>>
+ <COND (.DEF? <MA-DEF-DISP ,AC-F .OFF>)
+ (<0? .OFF> <MA-REGD ,AC-F>)
+ (T <MA-DISP ,AC-F .OFF>)>>
+
+<DEFINE EMIT-STORE-AC (AC DEST "OPTIONAL" (MODE LONG))
+ #DECL ((AC) AC (DEST) EFF-ADDR (MODE) ATOM)
+ <COND (<AND <NOT <AC-USE .AC>>
+ <AC-LLOAD .AC>
+ <NOT <==? .MODE BYTE>>
+ ,AC-STORE-OPT
+ <NOT <G=? <LENGTH <AC-VARS .AC>> 2>>>
+ <RE-EMIT-MOVE <AC-LLOAD .AC> <AC-LLOAD-EA .AC> .DEST .MODE>
+ <CLEAR-VARS-FROM-AC .AC>)
+ (ELSE <USE-AC .AC> <EMIT-MOVE <MA-REG .AC> .DEST .MODE>)>>
+
+<DEFINE EMIT-STORE-PAIR-AC (AC AC2 DEST "OPT" (MODE LONG))
+ #DECL ((AC AC2) AC (DEST) EFF-ADDR (MODE) ATOM)
+ <COND (<AND <NOT <AC-USE .AC>>
+ <AC-LLOAD .AC>
+ <NOT <==? .MODE BYTE>>
+ ,AC-STORE-OPT
+ <NOT <G=? <LENGTH <AC-VARS .AC>> 2>>>
+ <RE-EMIT-MOVE <AC-LLOAD .AC> <AC-LLOAD-EA .AC> .DEST DOUBLE>
+ <CLEAR-VARS-FROM-AC .AC>)
+ (ELSE
+ <USE-AC .AC>
+ <USE-AC .AC2>
+ <EMIT-MOVE <MA-REG .AC> .DEST DOUBLE>)>>
+
+<DEFINE ISTORE-VAR (LVAR
+ "OPTIONAL" (XREF <>) (WILL-DIE-LIES? <>)
+ "AUX" DADDR (VAR <LINKVAR-VAR .LVAR>) VAC TAC (STOREV <>)
+ (STORET <>) (STOREC <>) SVEC KIND)
+ #DECL ((LVAR) LINKVAR (XREF) <OR FALSE XREF-INFO> (SVEC) CODEVEC)
+ <COND (<OR <VARTBL-DEAD? .VAR>
+ <AND <LINKVAR-VALUE-STORED .LVAR>
+ <LINKVAR-TYPE-STORED .LVAR>
+ <LINKVAR-COUNT-STORED .LVAR>>
+ <AND <NOT .WILL-DIE-LIES?> <WILL-DIE? .VAR>>>)
+ (ELSE
+ <START-CODE-INSERT>
+ <COND (<AND <NOT <LINKVAR-VALUE-STORED .LVAR>>
+ <OR <NOT <LINKVAR-COUNT-STORED .LVAR>>
+ <NOT <LINKVAR-TYPE-STORED .LVAR>>>
+ <==? <LINKVAR-TYPE-WORD-AC .LVAR>
+ <SET VAC <PREV-AC <LINKVAR-VALUE-AC .LVAR>>>>
+ .VAC>
+ <SET DADDR <ADDR-VAR-TYPE-VALUE .VAR>>
+ <EMIT-STORE-PAIR-AC .VAC <LINKVAR-VALUE-AC .LVAR> .DADDR>
+ <SET STOREV <SET STORET <SET STOREC T>>>
+ <PUT .LVAR ,LINKVAR-VALUE-STORED T>
+ <PUT .LVAR ,LINKVAR-TYPE-STORED T>
+ <PUT .LVAR ,LINKVAR-COUNT-STORED T>)
+ (<NOT <LINKVAR-VALUE-STORED .LVAR>>
+ <COND (<NOT <SET VAC <LINKVAR-VALUE-AC .LVAR>>>
+ <ERROR "VARIABLE NOT IN AC" ISTORE-VAR>)>
+ <SET DADDR <ADDR-VAR-VALUE .VAR>>
+ <EMIT-STORE-AC .VAC .DADDR LONG>
+ <SET STOREV T>
+ <PUT .LVAR ,LINKVAR-VALUE-STORED T>)>
+ <SET STORET <SCHECK-TYPE-STORED .LVAR>>
+ <COND (<NOT <LINKVAR-COUNT-STORED .LVAR>>
+ <PUT .LVAR ,LINKVAR-COUNT-STORED T>
+ <SET STOREC T>
+ <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <SET DADDR <ADDR-VAR-TYPE .VAR>>
+ <EMIT-STORE-AC .TAC .DADDR LONG>)
+ (<SET TAC <LINKVAR-COUNT-AC .LVAR>>
+ <SET DADDR <ADDR-VAR-COUNT .VAR>>
+ <EMIT-STORE-AC .TAC .DADDR WORD>)>)>
+ <COND (<NOT <EMPTY? <SET SVEC <END-CODE-INSERT>>>>
+ <SET KIND <COMPUTE-KIND .STOREV .STORET .STOREC>>
+ <EMIT-POTENTIAL-STORE .SVEC .KIND .LVAR>
+ <AND .XREF <KILL-STORES .XREF .KIND .VAR>>)>)>>
+
+<DEFINE COMPUTE-KIND (STOREV STORET STOREC)
+ #DECL ((STOREV STOREC) BOOLEAN (STORET) <OR FALSE ATOM>)
+ <COND (<==? .STORET TYPE>
+ <COND (<AND .STOREV .STOREC> COUNT-VALUE)
+ (.STOREC TYPE-COUNT)
+ (.STOREV TYPE-VALUE)
+ (TYPE)>)
+ (<==? .STORET TYPE-COUNT>
+ <COND (.STOREV TYPE-COUNT-VALUE) (TYPE-COUNT)>)
+ (ELSE
+ <COND (<AND .STOREV .STOREC> COUNT-VALUE)
+ (.STOREV VALUE)
+ (.STOREC COUNT)>)>>
+
+<DEFINE SCHECK-TYPE-STORED (LVAR
+ "AUX" DADDR TAC (KIND TYPE) DCL
+ (VAR <LINKVAR-VAR .LVAR>))
+ #DECL ((LVAR) LINKVAR)
+ <COND (<NOT <LINKVAR-TYPE-STORED .LVAR>>
+ <COND
+ (<AND <SET DCL <VARTBL-RDECL <LINKVAR-VAR .LVAR>>>
+ <OR <MEMQ .DCL ,TYPE-LENGTHS>
+ <NOT <COUNT-NEEDED? .DCL>>>>
+ <LINKVAR-COUNT-STORED .LVAR T>)
+ (T
+ <SET DADDR <ADDR-VAR-TYPE .VAR>>
+ <PUT .LVAR ,LINKVAR-TYPE-STORED T>
+ <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <EMIT-STORE-AC .TAC .DADDR LONG>
+ <PUT .LVAR ,LINKVAR-COUNT-STORED T>
+ <SET KIND TYPE-COUNT>)
+ (<SET TAC <LINKVAR-TYPE-AC .LVAR>>
+ <EMIT-STORE-AC .TAC .DADDR WORD>)
+ (<SET DCL <LINKVAR-DECL .LVAR>> <STORE-TYPE .DCL .DADDR>)
+ (<ERROR "VARIABLE NOT IN AC" ISTORE-ADDR>)>)>)>
+ .KIND>
+
+<DEFINE STORE-TYPE (DCL ADDR "OPT" (EXTRA <>))
+ #DECL ((DCL) ATOM (ADDR) EFF-ADDR)
+ <COND (<MEMQ .DCL ,TYPE-LENGTHS>
+ <EMIT-MOVE <TYPE-WORD .DCL> .ADDR LONG .EXTRA>)
+ (<AND <NOT <COUNT-NEEDED? .DCL>>
+ <NOT <MEMQ <TYPEPRIM .DCL> ,TYPE-LENGTHS>>>
+ <EMIT-MOVE <TYPE-CODE .DCL WORD> .ADDR LONG .EXTRA>)
+ (ELSE <EMIT-MOVE <TYPE-CODE .DCL WORD> .ADDR WORD>)>>
+
+<DEFINE LOAD-AC-PAIR (VAR RES "OPTIONAL" (AC <GET-AC DOUBLE <>>)
+ "AUX" TAC VAC LVAR)
+ <COND (<NOT <TYPE? .VAR VARTBL>>
+ <STORE-AC .AC T>
+ <STORE-AC <NEXT-AC .AC> T>
+ <COND (<NOT <MEMQ <PRIMTYPE .VAR> '[WORD FIX]>>
+ <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC .VAR>>
+ <MA-REG .AC>>)
+ (T
+ <MOVE-VALUE .VAR <NEXT-AC .AC>>
+ <EMIT-MOVE <TYPE-WORD <TYPE .VAR>> <MA-REG .AC> LONG>
+ <LOAD-AC .AC <TYPE-WORD <TYPE .VAR>>>)>)
+ (<NOT <SET LVAR <FIND-CACHE-VAR .VAR>>>
+ <STORE-AC .AC T>
+ <STORE-AC <NEXT-AC .AC> T>
+ <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .AC T>)
+ (<AND <SET VAC <LINKVAR-VALUE-AC .LVAR>>
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <==? <NEXT-AC .TAC> .VAC>>
+ <COND (<==? .TAC .AC>
+ <MUNG-AC .AC>
+ <MUNG-AC <NEXT-AC .AC>>)
+ (T
+ <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .AC T <> .TAC>)>)
+ (T
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <COND (<OR <AND <NOT .VAC> <NOT .TAC>>
+ <AND <LINKVAR-VALUE-STORED .LVAR>
+ <LINKVAR-TYPE-STORED .LVAR>
+ <LINKVAR-COUNT-STORED .LVAR>>>
+ <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .AC T <> <>>)
+ (T
+ <LOAD-VAR .VAR JUST-VALUE T <NEXT-AC .AC>>
+ <LOAD-VAR .VAR TYPE-WORD T .AC>)>)>
+ <COND (.RES
+ <DEST-PAIR <NEXT-AC .AC> .AC .RES>)>
+ .AC>
+
+<DEFINE LOAD-VAR (VAR IMODE MODIFY? AC-TYPE
+ "OPTIONAL" (DCL? <>) (USE? T)
+ "AUX" LVAR NOAC? TAC VAC TAC1 TAC2 (MODE .IMODE))
+ #DECL ((VAR) VARTBL (MODE) ATOM (MODIFY?) BOOLEAN (AC-TYPE) AC-CHOICES
+ (DCL?) <OR ATOM FALSE> (USE?) BOOLEAN)
+ <COND (<==? .IMODE JUST-VALUE> <SET MODE VALUE>)>
+ <OR .DCL? <SET DCL? <VARTBL-DECL .VAR>>>
+ <COND
+ (<NOT <SET LVAR <FIND-CACHE-VAR .VAR>>> <SET NOAC? <>>)
+ (<==? .MODE VALUE>
+ <COND (<AND <N==? .IMODE JUST-VALUE>
+ <SET VAC <LINKVAR-VALUE-AC .LVAR>>
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <==? <NEXT-AC .TAC> .VAC>
+ <N==? .AC-TYPE ,AC-0>>
+ <COND (<AND <TYPE? .AC-TYPE AC> <N==? .AC-TYPE .VAC>>
+ <COND (<TYPE? .AC-TYPE AC>
+ <SET TAC1 <PREV-AC .AC-TYPE>>)
+ (<SET TAC1 <GET-AC DOUBLE T>>)>
+ <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .TAC1 .MODIFY?
+ <> .TAC>
+ <SET NOAC? .AC-TYPE>)
+ (T
+ <SET NOAC? .VAC>
+ <COND (.MODIFY? <MUNG-AC .VAC> <MUNG-AC .TAC>)>)>)
+ (<SET VAC <LINKVAR-VALUE-AC .LVAR>>
+ <SET NOAC?
+ <MOVE-VAR-BETWEEN-ACS .VAC .VAR .AC-TYPE .MODIFY?>>)
+ (ELSE <SET NOAC? <>>)>)
+ (<==? .MODE TYPE>
+ <COND (<SET TAC <LINKVAR-TYPE-AC .LVAR>>
+ <SET NOAC?
+ <MOVE-VAR-BETWEEN-ACS .TAC .VAR .AC-TYPE .MODIFY?>>)
+ (<AND <NOT <LINKVAR-TYPE-STORED .LVAR>>
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <NOT <VARTBL-DECL .VAR>>>
+ <SET NOAC?
+ <MOVE-TYPE-FROM-TYPEWORD .VAR .TAC .AC-TYPE .MODIFY?>>)
+ (ELSE <SET NOAC? <>>)>)
+ (<==? .MODE COUNT>
+ <COND (<LINKVAR-COUNT-STORED .LVAR> <SET NOAC? <>>)
+ (<SET TAC <LINKVAR-COUNT-AC .LVAR>>
+ <SET NOAC?
+ <MOVE-VAR-BETWEEN-ACS .TAC .VAR .AC-TYPE .MODIFY?>>)
+ (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <SET NOAC?
+ <MOVE-COUNT-FROM-TYPEWORD .VAR .TAC .AC-TYPE .MODIFY?>>)
+ (ELSE <SET NOAC? <>>)>)
+ (<==? .MODE TYPE-WORD>
+ <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <SET NOAC?
+ <MOVE-VAR-BETWEEN-ACS .TAC .VAR .AC-TYPE .MODIFY?>>)
+ (<NOT <SAFE-TYPE-WORD? .VAR>>
+ <COND (<AND <SET TAC1 <LINKVAR-COUNT-AC .LVAR>>
+ <NOT <LINKVAR-COUNT-STORED .LVAR>>>
+ <EMIT-MOVE <MA-REG .TAC1> <ADDR-VAR-COUNT .VAR> WORD>
+ <PUT .LVAR ,LINKVAR-COUNT-STORED T>
+ <BREAK-LINK .TAC1 .VAR>)>
+ <COND (<AND <SET TAC2 <LINKVAR-TYPE-AC .LVAR>>
+ <NOT <LINKVAR-TYPE-STORED .LVAR>>>
+ <EMIT-MOVE <MA-REG .TAC2> <ADDR-VAR-TYPE .VAR> WORD>
+ <PUT .LVAR ,LINKVAR-TYPE-STORED T>
+ <BREAK-LINK .TAC2 .VAR>)>
+ <COND (<AND <NOT <SAFE-TYPE-WORD? .VAR>>
+ <SET DCL? <LINKVAR-DECL .LVAR>>>
+ <EMIT-MOVE <TYPE-CODE .DCL? WORD>
+ <ADDR-VAR-TYPE .VAR>
+ WORD>
+ <PUT .LVAR ,LINKVAR-TYPE-STORED T>)>
+ <SET NOAC? <>>)
+ (ELSE <SET NOAC? <>>)>)
+ (<ERROR "BAD-MODE" LOAD-VAR>)>
+ <COND (<AND <NOT .NOAC?>
+ <==? .IMODE VALUE>
+ <OR <NOT .LVAR>
+ <AND <NOT <LINKVAR-TYPE-AC .LVAR>>
+ <NOT <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <NOT <LINKVAR-COUNT-AC .LVAR>>>>
+ <N==? .AC-TYPE ,AC-0>
+ <COND (<TYPE? .AC-TYPE AC>
+ <SET TAC <GET-AC <PREV-AC .AC-TYPE>>>
+ <GET-AC .AC-TYPE>)
+ (ELSE <SET TAC <GET-AC DOUBLE>>)>>
+ <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .TAC .MODIFY? <>>
+ <AND .DCL? <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL?>>
+ <SET TAC <NEXT-AC .TAC>>
+ <AND .USE? <USE-AC .TAC>>
+ .TAC)
+ (<NOT .NOAC?>
+ <SET TAC <GET-AC .AC-TYPE>>
+ <LOAD-VAR-INTO-AC .VAR .MODE .TAC .MODIFY?>
+ <SET-STATUS-AC .TAC>
+ <AND .DCL? <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL?>>
+ <AND .USE? <USE-AC .TAC>>
+ .TAC)
+ (ELSE
+ <AND .DCL? <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL?>>
+ <AND .USE? <USE-AC .NOAC?>>
+ .NOAC?)>>
+
+<DEFINE MOVE-VAR-BETWEEN-ACS (VAC VAR AC-MODE MODIFY? "AUX" FAC)
+ #DECL ((VAC) AC (AC-MODE) AC-CHOICES (MODIFY?) BOOLEAN)
+ <PROTECT-USE .VAC>
+ <COND (<MATCH-AC? .VAC .AC-MODE>
+ <COND (.MODIFY?
+ <COND (<AVAILABLE? .VAC> <CLEAR-VARS-FROM-AC .VAC> .VAC)
+ (<SET FAC <CHECK-FREE-AC? .AC-MODE>>
+ <IMOVE-AC .VAC .FAC <>>
+ .VAC)
+ (ELSE <STORE-AC .VAC T> .VAC)>)
+ (.VAC)>)
+ (ELSE
+ <COND (.MODIFY?
+ <SET FAC <GET-AC .AC-MODE>>
+ <IMOVE-AC .VAC .FAC T>
+ .FAC)
+ (ELSE <PLACE-ALTERNATE-AC .VAC .AC-MODE>)>)>>
+
+<DEFINE CHECK-FREE-AC? (MODE)
+ #DECL ((MODE) AC-CHOICES)
+ <COND (<TYPE? .MODE AC> <AND <AVAILABLE? .MODE> .MODE>)
+ (<==? .MODE DOUBLE>
+ <OR <FIND-FREE-PAIR NOVARS> <FIND-FREE-PAIR STORED>>)
+ (ELSE <OR <FREE-AC? .MODE NOVARS> <FREE-AC? .MODE STORED>>)>>
+
+<DEFINE AVAILABLE? (AC)
+ #DECL ((AC) AC)
+ <MAPF <>
+ <FCN (LVAR)
+ <COND (<NOT <VARTBL-DEAD? <LINKVAR-VAR .LVAR>>>
+ <COND (<AND <==? .AC <LINKVAR-VALUE-AC .LVAR>>
+ <NOT <LINKVAR-VALUE-STORED .LVAR>>>
+ <MAPLEAVE <>>)
+ (<AND <==? .AC <LINKVAR-TYPE-AC .LVAR>>
+ <NOT <LINKVAR-TYPE-STORED .LVAR>>>
+ <MAPLEAVE <>>)
+ (<AND <==? .AC <LINKVAR-COUNT-AC .LVAR>>
+ <NOT <LINKVAR-COUNT-STORED .LVAR>>>
+ <MAPLEAVE <>>)
+ (<AND <==? .AC <LINKVAR-TYPE-WORD-AC .LVAR>>
+ <NOT <LINKVAR-TYPE-STORED .LVAR>>>
+ <MAPLEAVE <>>)>)>
+ .AC>
+ <AC-VARS .AC>>>
+
+<DEFINE GET-AC ("OPT" (AC-MODE ANY-AC) (MUNG? <>) "AUX" PAC)
+ #DECL ((AC-MODE) AC-CHOICES)
+ <COND (<==? .AC-MODE ANY-AC> <SET AC-MODE NONE>)>
+ <COND (<TYPE? .AC-MODE AC> <STORE-AC .AC-MODE> <SET PAC .AC-MODE>)
+ (<SET PAC <CHECK-FREE-AC? .AC-MODE>>)
+ (<SET PAC <PICK-BEST-AC .AC-MODE>>
+ <STORE-AC .PAC>
+ <COND (<==? .AC-MODE DOUBLE> <STORE-AC <NEXT-AC .PAC>>)>
+ .PAC)
+ (<ERROR "CANT GET AC" GET-AC>)>
+ <COND (.MUNG?
+ <MUNG-AC .PAC>
+ <COND (<==? .AC-MODE DOUBLE> <MUNG-AC <NEXT-AC .PAC>>)>)>
+ .PAC>
+
+<DEFINE PICK-BEST-AC (MODE)
+ #DECL ((MODE) ATOM (VALUE) AC)
+ <PICK-FROM ,ALL-ACS .MODE>>
+
+<DEFINE PICK-FROM (ACS MODE "AUX" (BEST-AC <>) BEST-AC2)
+ #DECL ((ACS) <VECTOR [REST AC]>)
+ <REPEAT (AC AC2)
+ <COND (<OR <EMPTY? .ACS>
+ <AND <EMPTY? <REST .ACS>>
+ <==? .MODE DOUBLE>>>
+ <RETURN>)>
+ <SET AC <1 .ACS>>
+ <COND (<==? .MODE DOUBLE> <SET AC2 <2 .ACS>>)>
+ <SET ACS <REST .ACS <COND (<==? .MODE DOUBLE> 2) (ELSE 1)>>>
+ <PROG ()
+ <COND (<OR <AC-PROT .AC>
+ <AND <==? .MODE DOUBLE>
+ <AC-PROT .AC2>>>
+ <RETURN>)>
+ <COND (<NOT .BEST-AC>
+ <SET BEST-AC .AC>
+ <COND (<==? .MODE DOUBLE> <SET BEST-AC2 .AC2>)>
+ <RETURN>)>
+ <COND (<AND <L? <LENGTH <AC-VARS .AC>>
+ <LENGTH <AC-VARS .BEST-AC>>>
+ <OR <N==? .MODE DOUBLE>
+ <L? <LENGTH <AC-VARS .AC2>>
+ <LENGTH <AC-VARS .BEST-AC2>>>>>
+ <SET BEST-AC .AC>
+ <COND (<==? .MODE DOUBLE> <SET BEST-AC2 .AC2>)>
+ <RETURN>)>
+ <COND (<AND <G? <AC-AGE .AC> <AC-AGE .BEST-AC>>
+ <OR <N==? .MODE DOUBLE>
+ <G? <AC-AGE .AC2> <AC-AGE .BEST-AC2>>>>
+ <SET BEST-AC .AC>
+ <SET BEST-AC2 .AC2>)>>>
+ <COND (<NOT .BEST-AC> <ERROR "AC NOT FOUND" PICK-FROM>)>
+ .BEST-AC>
+
+<DEFINE IMOVE-AC (SOURCE-AC DEST-AC MODIFY?)
+ #DECL ((SOURCE-AC DEST-AC) AC)
+ <USE-AC .SOURCE-AC>
+ <STORE-AC .DEST-AC T>
+ <EMIT-MOVE <MA-REG .SOURCE-AC> <MA-REG .DEST-AC> LONG>
+ <LOAD-AC .DEST-AC <MA-REG .SOURCE-AC>>
+ <OR .MODIFY? <MOVE-AC .SOURCE-AC .DEST-AC>>
+ <SET-STATUS-AC .DEST-AC>
+ <SET-AC-AGE .DEST-AC>>
+
+<DEFINE STORE-AC (AC "OPTIONAL" (FLUSH <>) (SAVE? <>))
+ #DECL ((AC) AC (FLUSH) BOOLEAN (SAVE?) <OR LINKVAR FALSE>)
+ <MAPF <>
+ <FUNCTION (X)
+ <COND (<N==? .X .SAVE?>
+ <ISTORE-VAR .X>)>>
+ <AC-VARS .AC>>
+ <COND (.FLUSH
+ <CLEAR-VARS-FROM-AC .AC .SAVE? T>)>>
+
+<DEFINE PLACE-ALTERNATE-AC (AC MODE "AUX" FAC)
+ #DECL ((MODE) AC-CHOICES (AC) AC)
+ <SET FAC <GET-AC .MODE>>
+ <COND (<ALL-DEAD? .FAC>
+ <EMIT-MOVE <MA-REG .AC> <MA-REG .FAC> LONG>
+ <MOVE-AC .AC .FAC>)
+ (ELSE <EMIT-EXCH .AC .FAC> <EXCH-AC .AC .FAC>)>
+ .FAC>
+
+<DEFINE EMIT-EXCH (AC1 AC2 "AUX" TAC)
+ #DECL ((AC1 AC2) AC)
+ <COND (<SET TAC <FREE-AC? NONE NOVARS>>
+ <EMIT ,INST-MOVL <MA-REG .AC1> <MA-REG .TAC>>
+ <EMIT ,INST-MOVL <MA-REG .AC2> <MA-REG .AC1>>
+ <EMIT ,INST-MOVL <MA-REG .TAC> <MA-REG .AC2>>)
+ (ELSE
+ <EMIT ,INST-PUSHL <MA-REG .AC1>>
+ <EMIT ,INST-MOVL <MA-REG .AC2> <MA-REG .AC1>>
+ <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG .AC2>>)>>
+
+<DEFINE LOAD-VAR-INTO-AC (VAR MODE AC MODIFY?
+ "OPT" (VTMOD <>) (ALREADY? <>)
+ "AUX" (LVAR <FIND-CACHE-VAR .VAR>) TAC FAC DCL CAC
+ (SAFE? <SAFE-TYPE-WORD? .VAR>) (RLVAR <>)
+ (TSTORED?
+ <AND .LVAR <LINKVAR-TYPE-STORED .LVAR>>)
+ (CLEAR-TYPE? <>) (CLEAR-COUNT? <>))
+ #DECL ((VAR) VARTBL (AC) AC (MODE) ATOM (MODIFY?) BOOLEAN)
+ <COND (<==? .MODE TYPE-VALUE-PAIR>
+ <COND (<AND <OR <ALL-DEAD? .AC> <ALL-STORED? .AC>>
+ <OR <ALL-DEAD? <NEXT-AC .AC>>
+ <ALL-STORED? <NEXT-AC .AC>>>>
+ <MUNG-AC .AC>
+ <MUNG-AC <NEXT-AC .AC>>)
+ (ELSE <STORE-AC .AC T> <STORE-AC <NEXT-AC .AC> T>)>)
+ (<OR <ALL-DEAD? .AC> <ALL-STORED? .AC>> <MUNG-AC .AC>)
+ (<SET FAC <FREE-AC? .MODE NOVARS>>
+ <IMOVE-AC .AC .FAC <>>
+ <CLEAR-VARS-FROM-AC .AC>)
+ (<STORE-AC .AC T>)>
+ <CLOAD-AC .AC>
+ <COND
+ (<==? .MODE TYPE-VALUE-PAIR>
+ <EMIT ,INST-MOVQ <COND (.ALREADY? <MA-REG .ALREADY?>)
+ (<ADDR-VAR-TYPE-VALUE .VAR>)> <MA-REG .AC>>
+ <COND (,GC-MODE
+ <EMIT ,INST-BICW2 <MA-WORD-IMM ,SHORT-TYPE-MASK> <MA-REG .AC>>)>)
+ (<==? .MODE TYPE>
+ <COND (<OR .SAFE? .TSTORED?>
+ <MOVE-TO-AC .AC <ADDR-VAR-TYPE .VAR> WORD>
+ <COND (,GC-MODE
+ <EMIT ,INST-BICW2
+ <MA-WORD-IMM ,SHORT-TYPE-MASK>
+ <MA-REG .AC>>)>)
+ (<SET DCL <VARTBL-DECL .VAR>>
+ <MOVE-TO-AC .AC <TYPE-CODE .DCL> LONG>
+ <SET CLEAR-TYPE? T>)
+ (<ERROR "NO TYPE CODE" LOAD-VAR-INTO-AC>)>)
+ (<==? .MODE COUNT> <MOVE-TO-AC .AC <ADDR-VAR-COUNT .VAR> WORD>)
+ (<==? .MODE TYPE-WORD>
+ <COND (.SAFE? <MOVE-TO-AC .AC <ADDR-VAR-TYPE .VAR> LONG>)
+ (ELSE
+ <COND (<SET DCL <VARTBL-DECL .VAR>>
+ <COND (<COUNT-NEEDED? .DCL>
+ <MOVE-TO-AC .AC <VAR-COUNT-ADDRESS .VAR> LONG>
+ <MOVE-TO-AC .AC <TYPE-CODE .DCL> WORD>)
+ (ELSE <MOVE-TO-AC .AC <TYPE-WORD .DCL> LONG>)>)
+ (<SET LVAR <FIND-CACHE-VAR .VAR>>
+ <COND (<SET TAC <LINKVAR-TYPE-AC .LVAR>>
+ <COND (<SET CAC <LINKVAR-COUNT-AC .LVAR>>
+ <MOVE-TO-AC .AC <MA-REG .CAC> WORD>
+ <EMIT ,INST-ROTL
+ <MA-BYTE-IMM 16>
+ <MA-REG .AC>>)>
+ <MOVE-TO-AC .AC <MA-REG .TAC> WORD>)
+ (<ERROR "NO TYPE WORD" LOAD-VAR-INTO-AC>)>)
+ (<ERROR "NO TYPE WORD" LOAD-VAR-INTO-AC>)>
+ <SET CLEAR-TYPE? T>
+ <SET CLEAR-COUNT? T>
+ <USE-AC .AC>)>)
+ (<==? .MODE VALUE> <MOVE-TO-AC .AC <ADDR-VAR-VALUE .VAR> LONG>)>
+ <COND (<NOT .MODIFY?> <SET RLVAR <LINK-VAR-TO-AC .VAR .AC .MODE T <>>>)
+ ;(<AND <==? .MODE TYPE-VALUE-PAIR> <NOT .TMOD>>
+ <SET RLVAR <LINK-VAR-TO-AC .VAR .AC TYPE-WORD T <>>>)>
+ <COND (.RLVAR
+ <COND (.CLEAR-TYPE? <LINKVAR-TYPE-STORED .RLVAR <>>)>
+ <COND (.CLEAR-COUNT? <LINKVAR-COUNT-STORED .RLVAR <>>)>)>>
+
+<DEFINE MATCH-AC? (AC MODE)
+ #DECL ((AC) AC (MODE) AC-CHOICES)
+ <COND (<TYPE? .MODE AC> <==? .AC .MODE>) (ELSE T)>>
+
+<DEFINE VAR-VALUE-ADDRESS (VAR "OPTIONAL" (WRITE? <>) "AUX" LVAR TAC)
+ #DECL ((VAR) VARTBL (KIND) ATOM)
+ <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <SET TAC <LINKVAR-VALUE-AC .LVAR>>>
+ <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
+ <STORE-AC .TAC T .LVAR>)>
+ <USE-AC .TAC>
+ <MA-REG .TAC>)
+ (<ADDR-VAR-VALUE .VAR>)>>
+
+<DEFINE VAR-TYPE-ADDRESS (VAR "OPTIONAL" (MODE TYPE) (WRITE? <>)
+ "AUX" LVAR TAC)
+ #DECL ((VAR) VARTBL (KIND) ATOM (MODE) ATOM)
+ <COND (<AND <==? .MODE TYPE>
+ <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <OR <SET TAC <LINKVAR-TYPE-AC .LVAR>>
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>>>
+ <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
+ <STORE-AC .TAC T .LVAR>)>
+ <USE-AC .TAC>
+ <MA-REG .TAC>)
+ (<AND <OR <==? .MODE TYPE-WORD>
+ <==? .MODE TYPEMODE>
+ <==? .MODE TYPEWORD>>
+ <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>>
+ <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
+ <STORE-AC .TAC T .LVAR>)>
+ <USE-AC .TAC>
+ <MA-REG .TAC>)
+ (<ADDR-VAR-TYPE .VAR>)>>
+
+<DEFINE VAR-COUNT-ADDRESS (VAR "OPTIONAL" (WRITE? <>) "AUX" LVAR TAC)
+ #DECL ((VAR) VARTBL (KIND) ATOM)
+ <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <SET TAC <LINKVAR-COUNT-AC .LVAR>>>
+ <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
+ <STORE-AC .TAC T .LVAR>)>
+ <USE-AC .TAC>
+ <MA-REG .TAC>)
+ (<ADDR-VAR-COUNT .VAR>)>>
+
+<DEFINE STORE-ALL-ACS () <MAPF <> <FUNCTION (AC) <STORE-AC .AC <>>> ,ALL-ACS>>
+
+<DEFINE PUSH-TEMPS ("OPTIONAL" (MODEL ,TOP-MODEL))
+ <COND (<NOT <0? <SM-PATCHLOC .MODEL>>>
+ <START-CODE-INSERT>
+ <PUSH-MODEL .MODEL>
+ <INSERT-PATCH <SM-PATCHLOC .MODEL> <END-CODE-INSERT>>
+ <MAPF <> ,PUSH-TEMPS <SM-KIDS .MODEL>>)>>
+
+<DEFINE PUSH-TEMP (VAR "AUX" IVAL DCL)
+ #DECL ((VAR) VARTBL)
+ <COND (<SET IVAL <VARTBL-INIT .VAR>> <PUSH-CONSTANT .IVAL>)
+ (<SET DCL <VARTBL-RDECL .VAR>>
+ <EMIT-PUSH <TYPE-WORD .DCL> LONG>
+ <CLEAR-PUSH>)
+ (ELSE <CLEAR-PUSH DOUBLE>)>>
+
+<DEFINE PUSH-CONSTANT (IVAL "AUX" RVAL)
+ #DECL ((IVAL) ANY (RVAL) <OR FALSE FIX>)
+ <COND (<TYPE? .IVAL SPEC-FALSE> <SET IVAL <CHTYPE .IVAL FALSE>>)>
+ <COND (<SET RVAL <FIX-CONSTANT? .IVAL>>
+ <EMIT-PUSH <TYPE-WORD <TYPE .IVAL>> LONG>
+ <COND (<0? .RVAL> <CLEAR-PUSH LONG>)
+ (<EMIT-PUSH <MA-LONG-IMM .RVAL> LONG>)>)
+ (ELSE
+ <EMIT-PUSH <ADDR-TYPE-MQUOTE .IVAL> DOUBLE>)>>
+
+<DEFINE PUSH-VAR (VAR "AUX" VAC LVAR TAC DCL (DONE <>))
+ #DECL ((VAR) VARTBL)
+ <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
+ <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>>
+ <COND (<AND <SET VAC <LINKVAR-VALUE-AC .LVAR>>
+ <==? <+ <AC-NUMBER .TAC> 1> <AC-NUMBER .VAC>>>
+ <EMIT-PUSH <MA-REG .TAC> DOUBLE>
+ <SET DONE T>
+ <USE-AC .VAC>)
+ (ELSE
+ <EMIT-PUSH <MA-REG .TAC> LONG>)>
+ <USE-AC .TAC>)
+ (<SAFE-TYPE-WORD? .VAR>
+ <COND (<OR <NOT .LVAR>
+ <LINKVAR-VALUE-STORED .LVAR>>
+ <EMIT-PUSH <ADDR-VAR-TYPE .VAR> DOUBLE>
+ <SET DONE T>)
+ (ELSE
+ <EMIT-PUSH <ADDR-VAR-TYPE .VAR> LONG>)>)
+ (<SET DCL <VARTBL-DECL .VAR>>
+ <COND (<COUNT-NEEDED? .DCL>
+ <EMIT-PUSH <TYPE-CODE .DCL FIX> WORD>
+ <EMIT-PUSH <VAR-COUNT-ADDRESS .VAR> WORD>)
+ (<EMIT-PUSH <TYPE-WORD .DCL> LONG>)>)
+ (<AND .LVAR <SET TAC <LINKVAR-TYPE-AC .LVAR>>>
+ <EMIT-PUSH <MA-REG .TAC> WORD>
+ <USE-AC .TAC>
+ <COND (<SET TAC <LINKVAR-COUNT-AC .LVAR>>
+ <EMIT-PUSH <MA-REG .TAC> WORD>
+ <USE-AC .TAC>)>)
+ (<ERROR "NO TYPE WORD" PUSH-VAR>)>
+ <COND (<NOT .DONE>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)>>
+
+<DEFINE MOVE-COUNT-FROM-TYPEWORD (VAR TAC ACTYPE MODIFY? "AUX" NAC)
+ #DECL ((TAC) AC (ACTYPE) AC-CHOICES (MODIFY?) BOOLEAN)
+ <COND (<ALL-STORED? .TAC>
+ <MUNG-AC .TAC>
+ <SET NAC .TAC>
+ <EMIT ,INST-BICL2 <MA-LONG-IMM 65535> <MA-REG .TAC>>
+ <EMIT ,INST-ROTL <MA-BYTE-IMM 16> <MA-REG .TAC> <MA-REG .TAC>>)
+ (ELSE
+ <PROTECT-USE .TAC>
+ <SET NAC <GET-AC .ACTYPE T>>
+ <EMIT ,INST-BICL3 <MA-LONG-IMM 65535>
+ <MA-REG .TAC> <MA-REG .NAC>>
+ <EMIT ,INST-ROTL <MA-BYTE-IMM 16> <MA-REG .NAC> <MA-REG .NAC>>)>
+ <OR .MODIFY? <LINK-VAR-TO-AC .VAR .NAC COUNT NO-CHANGE>>
+ .NAC>
+
+<DEFINE MOVE-TYPE-FROM-TYPEWORD (VAR TAC ACTYPE MODIFY? "AUX" NAC)
+ #DECL ((NAC TAC) AC (ACTYPE) AC-CHOICES (MODIFY?) BOOLEAN)
+ <COND (<ALL-STORED? .TAC>
+ <MUNG-AC .TAC>
+ <EMIT ,INST-MOVZWL <MA-REG .TAC> <MA-REG .TAC>>
+ <SET NAC .TAC>)
+ (ELSE
+ <PROTECT-USE .TAC>
+ <SET NAC <GET-AC .ACTYPE T>>
+ <EMIT ,INST-MOVZWL <MA-REG .TAC> <MA-REG .NAC>>)>
+ <COND (,GC-MODE
+ <EMIT ,INST-BICW2
+ <MA-WORD-IMM ,SHORT-TYPE-MASK>
+ <MA-REG .NAC>>)>
+ <OR .MODIFY? <LINK-VAR-TO-AC .VAR .NAC TYPE NO-CHANGE>>
+ <CLEAR-STATUS>
+ .NAC>
+
+<DEFINE VARTBL-ASSIGNED? (VAR)
+ #DECL ((VAR) VARTBL)
+ <OR <VARTBL-LOC .VAR> <FIND-CACHE-VAR .VAR>>>
+
+<DEFINE PUSH-MODEL (MODEL)
+ #DECL ((MODEL) STK-MODEL)
+ <MAPF <>
+ <FCN (VAR) <COND (<VARTBL-TEMP? .VAR> <PUSH-TEMP .VAR>)>>
+ <SM-VARLIST .MODEL>>>
+
+<DEFINE ADDR-VAR-OFFSET (VAR)
+ #DECL ((VAR) VARTBL)
+ <GEN-LOC .VAR 0>
+ <VARTBL-LOC .VAR>>
+
projects / pdp10-muddle.git / blobdiff