--- /dev/null
+<SETG LB-DOPE <+ <CHTYPE <LSH 18 16> FIX> *40* 770>>
+<SETG LB-OBJ 0>
+<SETG LB-ATOM 8>
+<SETG LB-DECL 12>
+<SETG LB-PREV 20>
+<SETG LB-LAST 24>
+<SETG LB-BID 28>
+<MANIFEST LB-DOPE LB-OBJ LB-ATOM LB-DECL LB-PREV LB-LAST LB-BID>
+
+<DEFINE GEN-BBIND (ATM DECL FIXUP? "OPT" INIT "AUX" AC ATMADDR)
+ #DECL ((ATM) ATOM (FIXUP?) <OR ATOM FALSE>)
+ <EMIT-PUSH <MA-IMM ,LB-DOPE> LONG> ;"Push the dope word"
+ <COND (<ASSIGNED? INIT>
+ <PUSH-GEN .INIT>)
+ (T
+ <EMIT-PUSH <MA-IMM 0> DOUBLE>)> ; "Push the value"
+ <SET AC <GET-AC PREF-VAL T>>
+ <EMIT-MOVE <ADDR-VALUE-MQUOTE .ATM>
+ <SET ATMADDR <MA-REG .AC>> LONG> ; "load the atom"
+ <EMIT-MOVE .ATMADDR <MA-AINC ,AC-TP> LONG> ; "stuff it in the binding"
+ <PUSH-GEN .DECL> ;"PUSH THE DECL"
+ <EMIT-PUSH <MA-ABS ,SPSTO-LOC> LONG> ;"PUSH THE PREVIOUS BINDING"
+ <EMIT-PUSH <MA-DISP .AC 4> LONG> ;"PUSH THE ATOM'S OLD BINDING"
+ <EMIT-PUSH <MA-ABS ,BINDID-LOC> LONG> ;"PUSH BINDID"
+ <EMIT ,INST-MOVAL <MA-DISP ,AC-TP -32> <MA-ABS ,SPSTO-LOC>>
+ <COND (.FIXUP? ;"IF FIXUP, STUFF BINDING INTO ATOM"
+ <EMIT ,INST-MOVAL <MA-DISP ,AC-TP -32>
+ <MA-LD .AC 4>>)>
+ NORMAL>
+
+<DEFINE GEN-ASSIGNED? (FROB DIR LABEL)
+ <CALL-RTE ,IASSQ!-MIMOP CALL <> <> .FROB>
+ <EMIT ,INST-TSTL <MA-REG ,AC-1>>
+ <COND (<==? .DIR ->
+ <GEN-BRANCH ,INST-BEQL .LABEL CONDITIONAL-BRANCH>)
+ (T
+ <GEN-BRANCH ,INST-BNEQ .LABEL CONDITIONAL-BRANCH>)>
+ CONDITIONAL-BRANCH>
+
+<DEFINE GEN-LVAL (ATM RES)
+ #DECL ((ATM) <OR ATOM VARTBL>)
+ <CALL-RTE ,ILVAL!-MIMOP CALL .RES <> .ATM>
+ NORMAL>
+
+<DEFINE GEN-SET (ATM VAL)
+ <CALL-RTE ,ISET!-MIMOP CALL <> <> .ATM .VAL>
+ NORMAL>
+
+<DEFINE MOVSTK-GEN (AMT "OPTIONAL" (RES <>) HINT TYP)
+ <CALL-RTE ,IMOVSTK!-MIMOP CALL .RES <> .AMT>
+ NORMAL>
+
+<DEFINE GETSTK-GEN (UV "OPTIONAL" (RES <>) HINT TYP)
+ <CALL-RTE ,IGETSTK!-MIMOP CALL .RES <> .UV>
+ NORMAL>
+
+<DEFINE GETTTY-GEN (FROB "OPTIONAL" (RES <>) HINT TYP)
+ <CALL-RTE ,IGETTTY!-MIMOP CALL .RES <> .FROB>
+ NORMAL>
+
+<DEFINE SAVTTY-GEN (OLD NEW "OPTIONAL" (RES <>) HINT TYP)
+ <CALL-RTE ,ISAVTTY!-MIMOP CALL .RES <> .OLD .NEW>
+ NORMAL>
+
+<DEFINE SETZONE-GEN (ZONE "OPT" (RES <>) HINT TYP)
+ <CALL-RTE ,ISETZONE!-MIMOP CALL .RES <> .ZONE>
+ NORMAL>
+
+<DEFINE LEGAL-GEN (OBJ "OPT" (RES <>) HINT TYP)
+ <CALL-RTE ,ILEGAL?!-MIMOP CALL .RES <> .OBJ>
+ NORMAL>
+
+<DEFINE TEMPLATE-TABLE-GEN (OFFS TBL "OPTIONAL" HINT)
+ <CALL-RTE ,ITTABLE!-MIMOP CALL <> <> .OFFS .TBL>
+ NORMAL>
+
+<DEFINE FATAL-GEN ("OPTIONAL" (STR <>) HINT)
+ <CALL-RTE ,IFATAL!-MIMOP CALL <> <> .STR>
+ NORMAL>
+
+<DEFINE QUIT-GEN ("OPTIONAL" (ARG -1) HINT)
+ <CALL-RTE ,IQUIT!-MIMOP CALL <> <> .ARG>
+ NORMAL>
+
+<DEFINE CONS-GEN (NEARG LARG RES "OPTIONAL" HINT)
+ #DECL ((LARG) <OR VARTBL LIST> (NEARG) ANY (RES) <OR VARTBL ATOM>)
+ <CALL-RTE ,ICONS!-MIMOP CALL .RES LIST .LARG .NEARG>
+ NORMAL>
+
+<DEFINE UBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
+ #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
+ <GET-AC ,AC-0 T>
+ <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
+ <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
+ (ELSE <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
+ <CALL-RTE ,IBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
+ NORMAL>
+
+<DEFINE UUBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
+ #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
+ <GET-AC ,AC-0 T>
+ <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
+ <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
+ (T
+ <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
+ <CALL-RTE ,UIBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
+ NORMAL>
+
+<DEFINE CHTYPE-GEN (VAR TYP RES "OPTIONAL" HINT "AUX" VAC CAC TYVAR LV)
+ #DECL ((VAR) ANY (TYVAR) VARTBL (TYP) <OR ATOM FORM VARTBL>
+ (RES) <OR ATOM VARTBL>)
+ <COND
+ (<TYPE? .VAR VARTBL>
+ <COND
+ (<AND <==? .RES .VAR> <VAR-COUNT-STORED? .VAR>>
+ <EMIT ,INST-MOVW <COND (<TYPE? .TYP ATOM> <TYPE-CODE .TYP>)
+ (<TYPE? .TYP VARTBL> <VAR-VALUE-ADDRESS .TYP>)
+ (ELSE <VAR-TYPE-ADDRESS <2 .TYP>>)>
+ <VAR-TYPE-ADDRESS .VAR TYPE-WORD>>
+ <COND (<SET LV <FIND-CACHE-VAR .VAR>>
+ ;<PUT .LV ,LINKVAR-TYPE-AC <>>
+ ;<PUT .LV ,LINKVAR-TYPE-WORD-AC <>>
+ <COND (<LINKVAR-TYPE-WORD-AC .LV>
+ <PUT .LV ,LINKVAR-TYPE-STORED <>>)>)>)
+ (<OR <NOT <TYPE? .TYP ATOM>> <COUNT-NEEDED? .TYP>>
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <VAR-TYPE-ADDRESS .VAR TYPE-WORD> LONG>
+ <COND (<TYPE? .TYP VARTBL>
+ <EMIT ,INST-MOVW <VAR-VALUE-ADDRESS .TYP>
+ <MA-DISP ,AC-TP -4>>)
+ (<TYPE? .TYP FORM>
+ <EMIT ,INST-MOVW <VAR-TYPE-ADDRESS <2 .TYP>>
+ <MA-DISP ,AC-TP -4>>)
+ (ELSE <EMIT ,INST-MOVW <TYPE-CODE .TYP>
+ <MA-DISP ,AC-TP -4>>)>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)
+ (ELSE
+ <SET VAC <LOAD-VAR .VAR VALUE <> PREF-VAL>>
+ <PROTECT .VAC>
+ <COND (<AND <TYPE? .TYP ATOM>
+ <VAR-TYPE-WORD-IN-AC? .VAR>>
+ <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
+ <EMIT ,INST-MOVW <TYPE-CODE .TYP> <MA-REG .CAC>>
+ <DEST-PAIR .VAC .CAC .RES>)
+ (<TYPE? .TYP ATOM>
+ <SET CAC <LOAD-VAR .VAR COUNT <> PREF-TYPE>>
+ <DEST-COUNT-DECL .VAC .CAC .RES .TYP>)
+ (<TYPE? .TYP FORM>
+ <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
+ <EMIT ,INST-MOVW
+ <VAR-TYPE-ADDRESS <2 .TYP> TYPE>
+ <MA-REG .CAC>>
+ <DEST-PAIR .VAC .CAC .RES>)
+ (ELSE
+ <SET CAC <LOAD-VAR .VAR TYPE-WORD T PREF-TYPE>>
+ <EMIT ,INST-MOVW
+ <VAR-VALUE-ADDRESS .TYP>
+ <MA-REG .CAC>>
+ <DEST-PAIR .VAC .CAC .RES>)>)>)
+ (ELSE
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <TYPE-WORD .TYP> LONG>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)
+ (ELSE
+ <SET VAC <LOAD-VAR-APP .VAR <>>>
+ <DEST-DECL .VAC .RES .TYP>)>)>)
+ (<COUNT-NEEDED? <TYPE .VAR>>
+ ; "Some structured thing"
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <ADDR-TYPE-M <ADD-MVEC .VAR>>>
+ <COND (<TYPE? .TYP VARTBL>
+ <EMIT ,INST-MOVW <VAR-VALUE-ADDRESS .TYP>
+ <MA-DISP ,AC-TP -4>>)
+ (<TYPE? .TYP FORM>
+ <EMIT ,INST-MOVW <VAR-TYPE-ADDRESS <2 .TYP>>
+ <MA-DISP ,AC-TP -4>>)
+ (T
+ <EMIT ,INST-MOVW <TYPE-CODE .TYP>
+ <MA-DISP ,AC-TP -4>>)>
+ <EMIT-PUSH <ADDR-VAL-M .VAR> LONG>)
+ (T
+ <SET-GEN .RES .VAR>
+ <CHTYPE-GEN .RES .TYP .RES>)>)
+ (T
+ <COND (<==? .RES STACK>
+ <COND (<TYPE? .TYP VARTBL>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .TYP> LONG>)
+ (<TYPE? .TYP FORM>
+ <EMIT-PUSH <VAR-TYPE-ADDRESS <2 .TYP> LONG>>)
+ (T
+ <EMIT-PUSH <TYPE-CODE .TYP> LONG>)>
+ <EMIT-PUSH <MA-IMM <FIX-CONSTANT? .VAR>> LONG>)
+ (T
+ <SET-GEN .RES .VAR>
+ <CHTYPE-GEN .RES .TYP .RES>)>)>
+ NORMAL>
+
+<SETG GVAL-CAREFUL <>>
+<DEFINE GVAL-GEN (ATM RES "OPTIONAL" (HINT <>) "AUX" VAC ATMADDR TYP TAC
+ ELABEL NLABEL ATMOFF)
+ #DECL ((ATM) <OR ATOM VARTBL> (RES) <OR ATOM VARTBL>
+ (HINT) <OR FALSE HINT>)
+ <COND (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>) (ELSE <SET TYP <>>)>
+ <COND (,BOOT-MODE <SET ATMADDR <ADDR-VALUE-MQUOTE .ATM>>)
+ (<TYPE? .ATM VARTBL>)
+ (T
+ <SET ATMADDR
+ <MA-DEF-DISP ,AC-M <SET ATMOFF
+ <+ <ADD-MVEC <CHTYPE .ATM XGLOC>> 4>>>>
+ ;<SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)>
+ <COND (,BOOT-MODE
+ <SET VAC <GET-AC PREF-VAL T>>
+ <PROTECT .VAC>
+ <EMIT-MOVE .ATMADDR <MA-REG .VAC> LONG>
+ <EMIT-MOVE <MA-REGD .VAC> <MA-REG .VAC> LONG>
+ <COND (<==? .RES STACK> <EMIT-PUSH <MA-REGD .VAC> DOUBLE>)
+ (ELSE
+ <COND (<OR <NOT .TYP> <COUNT-NEEDED? .TYP>>
+ <SET TYP <>>
+ <SET TAC <GET-AC DOUBLE T>>
+ <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .TAC>>
+ <SET VAC <NEXT-AC .TAC>>)
+ (ELSE
+ <EMIT ,INST-MOVL <MA-DISP .VAC 4> <MA-REG .VAC>>)>
+ <COND (<NOT .TYP> <DEST-PAIR .VAC .TAC .RES T>)
+ (<DEST-DECL .VAC .RES .TYP T>)>)>)
+ (<AND <TYPE? .ATM VARTBL>
+ <NOT ,GVAL-CAREFUL>>
+ <COND (<SET TAC <VAR-VALUE-IN-AC? .ATM>>
+ <PROTECT .TAC>
+ ; "If atom is in AC, can win immediate"
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <MA-BDD .TAC 0> DOUBLE>)
+ (T
+ <SET VAC <GET-AC DOUBLE T>>
+ <EMIT ,INST-MOVQ <MA-BDD .TAC 0> <MA-REG .VAC>>)>)
+ (T
+ <SET VAC <GET-AC DOUBLE T>>
+ ; "Otherwise, pick up gbind through pointer on stack"
+ <EMIT ,INST-MOVL <GEN-LOC .ATM 4 T> <MA-REG .VAC>>
+ ; "Then get value out of that"
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <MA-REGD .VAC> DOUBLE>)
+ (T
+ <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .VAC>>)>)>
+ <COND (<N==? .RES STACK>
+ <DEST-PAIR <NEXT-AC .VAC> .VAC .RES T>)>)
+ (<AND ,GVAL-CAREFUL <N==? .ATM M$$BINDID>>
+ <FLUSH-ALL-ACS>
+ <SET TAC <GET-AC ,AC-0 T>>
+ <SET VAC <GET-AC ,AC-1 T>>
+ <SET ELABEL <MAKE-LABEL>>
+ <SET NLABEL <MAKE-LABEL>>
+ <COND (<TYPE? .ATM VARTBL>
+ ; "Pick up gbind"
+ <EMIT ,INST-MOVL <GEN-LOC .ATM 4 T> <MA-REG .VAC>>
+ ; "Barf if not there"
+ <GEN-BRANCH ,INST-BEQL .NLABEL <>>
+ ; "Pick up gval"
+ <EMIT ,INST-MOVQ <MA-REGD .VAC> <MA-REG .TAC>>)
+ (T
+ <EMIT ,INST-MOVQ .ATMADDR <MA-REG .TAC>>)>
+ ; "Win if have gval"
+ <GEN-BRANCH ,INST-BNEQ .ELABEL <>>
+ <EMIT-LABEL .NLABEL <>>
+ <COND (<TYPE? .ATM VARTBL>
+ <EMIT ,INST-PUSHAL <VAR-VALUE-ADDRESS .ATM>>)
+ (T <EMIT ,INST-PUSHAL <MA-DISP ,AC-M .ATMOFF>>)>
+ <CALL-RTE ,IGVERR!-MIMOP CALL <COND (<N==? .RES STACK> .RES)>
+ <>>
+ <EMIT-LABEL .ELABEL <>>
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <MA-REG .TAC> DOUBLE>)
+ (T
+ <DEST-PAIR <NEXT-AC .TAC> .TAC .RES T>)>)
+ (T
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH .ATMADDR DOUBLE>)
+ (T
+ <SET TAC <GET-AC DOUBLE T>>
+ <EMIT ,INST-MOVQ .ATMADDR <MA-REG .TAC>>
+ <DEST-PAIR <NEXT-AC .TAC> .TAC .RES T>)>)>
+ NORMAL>
+
+
+<DEFINE SETG-GEN (ATM VAL
+ "OPTIONAL" HINT
+ "AUX" VAC ATMADDR (A1 <>) (A2 <>) (TWOM <>) LV)
+ #DECL ((ATM) ATOM (RES) ANY)
+ <COND (<AND <TYPE? .VAL VARTBL> <SET LV <FIND-CACHE-VAR .VAL>>>
+ <SET A1 <LINKVAR-TYPE-WORD-AC .LV>>
+ <SET A2 <LINKVAR-VALUE-AC .LV>>)
+ (T <SET LV <>>)>
+ <COND (,BOOT-MODE <SET ATMADDR <ADDR-VALUE-MQUOTE .ATM>>)
+ (<OR <FIX-CONSTANT? .VAL>
+ <AND .LV
+ <NOT <AND <LINKVAR-VALUE-STORED .LV>
+ <LINKVAR-TYPE-STORED .LV>
+ <LINKVAR-COUNT-STORED .LV>>>
+ <NOT <AND .A1 <==? .A2 <NEXT-AC .A1>>>>>>
+ <SET TWOM T>
+ <SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)
+ (T
+ <SET ATMADDR
+ <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ATM XGLOC>> 4>>>
+ ;<SET ATMADDR <ADDR-VALUE-MQUOTE <CHTYPE .ATM XGLOC>>>)>
+ <COND (<OR ,BOOT-MODE .TWOM>
+ <COND (.A1 <PROTECT .A1>)>
+ <COND (.A2 <PROTECT .A2>)>
+ <SET VAC <GET-AC PREF-VAL T>>
+ <EMIT ,INST-MOVL .ATMADDR <MA-REG .VAC>>
+ <PROTECT .VAC>
+ <COND (<NOT .TWOM>
+ <EMIT ,INST-MOVL <MA-REGD .VAC> <MA-REG .VAC>>)>
+ <COND (<OR <TYPE? .VAL VARTBL> <FIX-CONSTANT? .VAL>>
+ <MOVE-TYPE .VAL <MA-REGD .VAC> <MA-DISP .VAC 2>>
+ <MOVE-VALUE .VAL <MA-DISP .VAC 4>>)
+ (ELSE
+ <EMIT-MOVE <ADDR-TYPE-MQUOTE .VAL>
+ <MA-REGD .VAC>
+ DOUBLE>)>)
+ (<TYPE? .VAL VARTBL>
+ <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAL TYPE-WORD> .ATMADDR>)
+ (T <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .VAL> .ATMADDR>)>
+ NORMAL>
+
+<SETG BE-COMPATIBLE T>
+
+<DEFINE SET-GEN (VAR VAL "OPTIONAL" (HINT <>) "AUX" VAC TAC CAC DCL LV)
+ #DECL ((VAR) VARTBL (VAL) ANY (HINT) <OR FALSE HINT>)
+ <DEAD-VAR .VAR>
+ <COND (<TYPE? .VAL VARTBL>
+ <SET VAC <LOAD-VAR-APP .VAL <> <VARTBL-DECL .VAL> <>>>
+ <LINK-VAR-TO-AC .VAR .VAC VALUE <>>
+ <COND (<OR <SET DCL <VARTBL-DECL .VAR>>
+ <SET DCL <VARTBL-DECL .VAL>>>
+ <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL>
+ <COND (<COUNT-NEEDED? .DCL>
+ <SET CAC <LOAD-VAR .VAL TYPE-WORD <> PREF-TYPE
+ <> <>>>
+ <LINK-VAR-TO-AC .VAR .CAC TYPE-WORD <>>)>)
+ (ELSE
+ <SET TAC <LOAD-VAR .VAL TYPE-WORD <> PREF-TYPE <> <>>>
+ <LINK-VAR-TO-AC .VAR .TAC TYPE-WORD <>>)>)
+ (<N==? <PRIMTYPE .VAL> FIX>
+ <SET TAC <GET-AC DOUBLE T>>
+ <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC .VAL>> <MA-REG .TAC>>
+ <DEST-PAIR <NEXT-AC .TAC> .TAC .VAR>
+ <INDICATE-CACHED-VARIABLE-DECL .VAR <TYPE .VAL>>)
+ (ELSE
+ <SET VAC
+ <GEN-CONSTANT .VAL PREF-VAL PREF-TYPE COUNT-IF-NECESSARY>>
+ <LINK-VAR-TO-AC .VAR .VAC VALUE <>>
+ <AND ,CONSTANT-COUNT-AC
+ <LINK-VAR-TO-AC .VAR ,CONSTANT-COUNT-AC COUNT <>>>
+ <INDICATE-CACHED-VARIABLE-DECL .VAR <TYPE .VAL>>)>
+ <PROCESS-DESTINATION-HINT .HINT .VAR>
+ NORMAL>
+
+<DEFINE MRETURN-GEN (TVAR FVAR "OPTIONAL" RES)
+ <INDICATE-ALL-DEAD>
+ <COND (<TYPE? .TVAR VARTBL> <PUT .TVAR ,VARTBL-DEAD? <>>)>
+ <COND (<TYPE? .FVAR VARTBL> <PUT .FVAR ,VARTBL-DEAD? <>>)>
+ <EMIT ,INST-MOVL
+ <COND (<TYPE? .TVAR VARTBL> <VAR-VALUE-ADDRESS .TVAR>)
+ (<MA-IMM .TVAR>)>
+ <MA-REG ,AC-1>>
+ <PROTECT ,AC-1>
+ <COND (<==? .FVAR 0>
+ <COND (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG ,AC-2>>)
+ (ELSE
+ <EMIT ,INST-MOVL <MA-REG ,AC-F> <MA-REG ,AC-2>>)>)
+ (ELSE
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .FVAR> <MA-REG ,AC-2>>)>
+ <PROTECT ,AC-2>
+ <CALL-RTE ,IMRETURN!-MIMOP JUMP <> <>>
+ UNCONDITIONAL-BRANCH>
+
+<DEFINE RETURN-GEN (VAL "OPTIONAL" (FRM <>) RES)
+ #DECL ((VAL) ANY (FRM) <OR FALSE VARTBL>)
+ <INDICATE-ALL-DEAD>
+ <COND (<TYPE? .FRM VARTBL> <PUT .FRM ,VARTBL-DEAD? <>>)>
+ <COND (<TYPE? .VAL VARTBL>
+ <PUT .VAL ,VARTBL-DEAD? <>>
+ <LOAD-VAR .VAL VALUE <> ,AC-1>
+ <LOAD-VAR .VAL TYPE-WORD <> ,AC-0>)
+ (ELSE <GEN-CONSTANT .VAL ,AC-1 ,AC-0 TYPE-WORD>)>
+ <PROTECT ,AC-1>
+ <PROTECT ,AC-0>
+ <COND (.FRM <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .FRM> <MA-REG ,AC-F>>)
+ (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG ,AC-F>>)>
+ <CALL-RTE ,FINIS!-MIMOP JUMP <> <>>
+ UNCONDITIONAL-BRANCH>
+
+<DEFINE DISPATCH-GEN (VAR BASE "TUPLE" LABELS "AUX" (CT <LENGTH .LABELS>))
+ #DECL ((CT) FIX (LABELS) <TUPLE [REST ATOM]> (BASE) <PRIMTYPE WORD>)
+ <STORE-ALL-ACS>
+ <EMIT ,INST-CASEL
+ <VAR-VALUE-ADDRESS .VAR>
+ <MA-IMM .BASE>
+ <MA-IMM <- .CT 1>>>
+ <MAPF <>
+ <FUNCTION (AC)
+ <STORE-AC .AC T>>
+ ,ALL-ACS>
+ <MAPF <>
+ <FUNCTION (LABEL "AUX" XREF)
+ <SET XREF <EMIT-LABEL-WORD .LABEL>>
+ <SAVE-XREF-AC-INFO .XREF <SAVE-STATE> <SAVE-LOAD-STATE>>>
+ .LABELS>
+ CONDITIONAL-BRANCH>
+
+<DEFINE OPDISP-GEN (RNUM TRONUM "TUPLE" LABELS "AUX" (NARGS .RNUM))
+ #DECL ((RNUM) FIX (TRONUM) <OR FALSE FIX> (LABELS) <TUPLE [REST
+ ATOM]>)
+ <PROTECT ,AC-0>
+ <EMIT ,INST-CASEW
+ <MA-REG ,AC-0>
+ <MA-LIT .RNUM>
+ <MA-LIT <COND (.TRONUM <- .TRONUM .RNUM>)
+ (ELSE <- <LENGTH .LABELS> 1>)>>>
+ <MAPF <>
+ <FCN (LABEL)
+ <EMIT-LABEL-WORD .LABEL>
+ <ADD-INTERNAL-ENTRY .NARGS .LABEL>
+ <SET NARGS <+ .NARGS 1>>>
+ .LABELS>
+ NORMAL>
+
+<DEFINE MAKTUP-GEN ("TUPLE" TEMPS
+ "AUX" RES (TLEN <LENGTH .TEMPS>) (ARGS ,ARGLIST-VARS)
+ LNOARG TVAR)
+ <SET RES <NTH .TEMPS .TLEN>>
+ <TEMP-PROCESS .RES>
+ <GEN-LOC <SET TVAR <FIND-VAR .RES>> 0>
+ <PUT .TVAR ,VARTBL-TEMP? <>>
+ <MAPR ,TEMP-PROCESS
+ <FCN (TEMPS "AUX" (TEMP <1 .TEMPS>))
+ <COND (<==? .TEMP => <MAPSTOP>)
+ (<OR <==? .RES .TEMP>
+ <=? .RES .TEMP>
+ <COND (<AND <TYPE? .RES ADECL>
+ <TYPE? .TEMP ADECL>>
+ <==? <1 .RES> <1 .TEMP>>)
+ (<AND <TYPE? .RES ADECL>
+ <TYPE? .TEMP ATOM>>
+ <==? <1 .RES> .TEMP>)
+ (<AND <TYPE? .RES ATOM>
+ <TYPE? .TEMP ADECL>>
+ <==? .RES <1 .TEMP>>)>>
+ <MAPRET>)
+ (<MAPRET .TEMP>)>>
+ .TEMPS>
+ <EMIT ,INST-MOVL <MA-REG ,AC-0> <MA-REG ,AC-1>>
+ <COND (<NOT <EMPTY? .ARGS>>
+ <ADD-CONSTANT-TO-AC <- <LENGTH .ARGS>> ,AC-1>
+ <SET LNOARG <MAKE-LABEL>>
+ <GEN-BRANCH ,INST-BGEQ .LNOARG <>>
+ <EMIT ,INST-CLRL <MA-REG ,AC-1>>
+ <EMIT-LABEL .LNOARG <>>)>
+ <SETG MAKTUP-FLAG T>
+ <EMIT-PUSH <TYPE-CODE TUPLE> WORD>
+ <EMIT-PUSH <MA-REG ,AC-1> WORD>
+ <CLEAR-PUSH>
+ <EMIT-PUSH <TYPE-WORD T$FRAME> LONG>
+ <EMIT-PUSH <MA-REG ,AC-F> LONG>
+ <EMIT ,INST-MOVL <MA-REG ,AC-TP> <MA-REG ,AC-2>>
+ <MAPF <> <FCN (VAR) <EMIT-PUSH <ADDR-VAR-TYPE .VAR> DOUBLE>> .ARGS>
+ <EMIT-PUSH <TYPE-CODE TUPLE> WORD>
+ <EMIT-PUSH <MA-REG ,AC-1> WORD>
+ <EMIT-PUSH <MA-REG ,AC-F> LONG>
+ <OR <0? <LENGTH .ARGS>>
+ <EMIT ,INST-ADDL2
+ <MA-IMM <* <LENGTH .ARGS> 8>>
+ <MA-DISP ,AC-TP -4>>>
+ <EMIT ,INST-MOVL <MA-REG ,AC-2> <MA-REG ,AC-F>>
+ <INDICATE-TEMP-PATCH <ADD-PATCH TEMPORARIES>>
+ NORMAL>
+
+<COND (<NOT <GASSIGNED? ICALL-LEVEL>> <SETG ICALL-LEVEL 0>)>
+
+<DEFINE ICALL-GEN (LABEL "OPTIONAL" (RES <>) "AUX" VADDR TADDR TLAB)
+ #DECL ((LABEL) ATOM (RES) <OR FALSE ATOM VARTBL>)
+ <FLUSH-ALL-ACS>
+ <SETG ICALL-LEVEL <+ ,ICALL-LEVEL 1>>
+ <COND (<TYPE? .RES VARTBL>
+ <SET TADDR <ADDR-VAR-TYPE .RES>>
+ <SET VADDR <ADDR-VAR-VALUE .RES>>)>
+ <SETG ICALL-LABELS (.LABEL !,ICALL-LABELS)>
+ <NEW-MODEL <CREATE-MODEL>>
+ <CALL-RTE ,INCALL!-MIMOP CALL <> <>>
+ <SET TLAB <MAKE-LABEL>>
+ <EMIT-BRANCH ,INST-BRB .TLAB <> 0 <> T>
+ <COND (<==? .RES STACK> <EMIT-PUSH <MA-REG ,AC-0> DOUBLE>)
+ (<TYPE? .RES VARTBL> <EMIT ,INST-MOVQ <MA-REG ,AC-0> .TADDR>)>
+ <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH>
+ <EMIT-LABEL .TLAB <>>
+ NORMAL>
+
+"Args are: LOCAL variable being set; FRAME where new val is coming from;
+ variable in that frame for new value."
+<DEFINE SETLR-GEN (LVAR FVAR NLVAR
+ "OPTIONAL" (HINT <>)
+ "AUX" TAC FAC (SADDR <ADDR-VAR-OFFSET .NLVAR>) (TYP <>) REFNUM)
+ #DECL ((NLVAR) VARTBL (LVAR) <OR VARTBL ATOM>)
+ ; "If we don't call GEN-LOC, this frob may never get a stack slot"
+ <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
+ <PROTECT-VAL .NLVAR>
+ <COND (<AND <TYPE? .LVAR VARTBL>
+ <N==? .LVAR .FVAR>>
+ <DEAD-VAR .LVAR>)>
+ ; "Don't leave the old guy around in ACs"
+ <PROTECT <SET FAC <LOAD-VAR .FVAR VALUE <> PREF-VAL>>>
+ <COND (<==? .LVAR STACK>
+ ; "Handle case of pushing non-local value (code hacked
+ in ILDB-LOOKAHEAD pass)"
+ <EMIT-PUSH <MA-DISP .FAC .SADDR> DOUBLE>)
+ (<AND .TYP <NOT <COUNT-NEEDED? .TYP>>>
+ <SET TAC <GET-AC PREF-VAL T>>
+ ; "Don't clobber frame AC; these guys run in sets"
+ <EMIT ,INST-MOVL <MA-DISP .FAC <+ .SADDR 4>> <MA-REG .TAC>>
+ <DEST-DECL .TAC .LVAR .TYP>)
+ (ELSE
+ <SET TAC <GET-AC DOUBLE T>>
+ <EMIT ,INST-MOVQ <MA-DISP .FAC .SADDR> <MA-REG .TAC>>
+ <DEST-PAIR <NEXT-AC .TAC> .TAC .LVAR>)>
+ NORMAL>
+
+"Args are: FRAME where new value is going; variable in that frame; value
+ for variable (often local var, often not)"
+<DEFINE SETRL-GEN (FVAR NLVAR LVAR
+ "OPTIONAL" (HINT <>)
+ "AUX" FAC (SADDR <ADDR-VAR-OFFSET .NLVAR>) REFNUM TAC CADDR
+ (TYP <>) LV T1 T2)
+ #DECL ((NLVAR FVAR) VARTBL (SADDR) FIX)
+ <PROTECT-VAL .LVAR>
+ <PROTECT <SET FAC <LOAD-VAR .FVAR VALUE <> PREF-VAL>>>
+ <AND .HINT <SET TYP <PARSE-HINT .HINT TYPE>>>
+ <COND (.TYP)
+ (<TYPE? .LVAR VARTBL> <SET TYP <VARTBL-DECL .LVAR>>)
+ (<SET TYP <TYPE .LVAR>>)>
+ <COND (<TYPE? .LVAR VARTBL>
+ <COND (<OR <NOT <SET LV <FIND-CACHE-VAR .LVAR>>>
+ <AND <SET T1 <LINKVAR-VALUE-AC .LV>>
+ <SET T2 <LINKVAR-TYPE-WORD-AC .LV>>
+ <==? .T1 <NEXT-AC .T2>>>
+ <AND <LINKVAR-VALUE-STORED .LV>
+ <LINKVAR-TYPE-STORED .LV>
+ <LINKVAR-COUNT-STORED .LV>>>
+ <EMIT ,INST-MOVQ
+ <COND (<AND .LV .T1> <MA-REG .T2>)
+ (ELSE
+ <ADDR-VAR-TYPE-VALUE .LVAR>)>
+ <MA-DISP .FAC .SADDR>>)
+ (.TYP
+ <EMIT ,INST-MOVL
+ <VAR-VALUE-ADDRESS .LVAR>
+ <MA-DISP .FAC <+ .SADDR 4>>>
+ <EMIT ,INST-MOVW
+ <TYPE-CODE .TYP WORD>
+ <MA-DISP .FAC .SADDR>>
+ <COND (<COUNT-NEEDED? .TYP>
+ <COND (<SET TAC <VAR-COUNT-IN-AC? .LVAR>>
+ <EMIT ,INST-MOVW
+ <MA-REG .TAC>
+ <MA-DISP .FAC <+ .SADDR 2>>>)
+ (<SET CADDR <VAR-COUNT-STORED? .LVAR>>
+ <EMIT ,INST-MOVW
+ .CADDR
+ <MA-DISP .FAC <+ .SADDR 2>>>)
+ (<ERROR "COUNT NOT FOUND" SETRL-GEN>)>)>)
+ (ELSE
+ <EMIT ,INST-MOVL
+ <VAR-TYPE-ADDRESS .LVAR TYPE-WORD>
+ <MA-DISP .FAC .SADDR>>
+ <EMIT ,INST-MOVL
+ <VAR-VALUE-ADDRESS .LVAR>
+ <MA-DISP .FAC <+ .SADDR 4>>>)>)
+ (ELSE
+ <EMIT ,INST-MOVQ <ADDR-TYPE-MQUOTE .LVAR> <MA-DISP .FAC .SADDR>>)>
+ NORMAL>
+
+<DEFINE FIXBIND-GEN () <CALL-RTE ,IFIXBND!-MIMOP CALL <> <>> NORMAL>
+
+<DEFINE BIND-GEN (RES "OPTIONAL" HINT)
+ #DECL ((RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,IBIND!-MIMOP CALL .RES <>>>
+
+<DEFINE CFRAME-GEN (RES "OPTIONAL" HINT "AUX" VAC TLAB)
+ #DECL ((RES) <OR ATOM VARTBL>)
+ <SET VAC <GET-AC PREF-VAL T>>
+ <COND (<AND ,MAKTUP-FLAG <0? ,ICALL-LEVEL>>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-F -4> <MA-REG .VAC>>)
+ (<EMIT ,INST-MOVL <MA-REG ,AC-F> <MA-REG .VAC>>)>
+ <EMIT ,INST-TSTL <MA-DISP .VAC -4>>
+ <SET TLAB <MAKE-LABEL>>
+ <GEN-BRANCH ,INST-BLSS .TLAB <>>
+ <EMIT-MOVE <MA-DISP .VAC -4> <MA-REG .VAC> LONG>
+ <EMIT-LABEL .TLAB <>>
+ <DEST-DECL .VAC .RES T$FRAME>
+ NORMAL>
+
+<DEFINE UNBIND-GEN (VAR)
+ #DECL ((VAR) VARTBL)
+ <CALL-RTE ,IUNBIND!-MIMOP CALL <> <> .VAR>
+ NORMAL>
+
+<DEFINE GETS-GEN (CASE RES "OPTIONAL" HINT "AUX" CE AC)
+ #DECL ((CASE) ATOM)
+ <COND (<MEMBER <SPNAME .CASE> '["PURVEC" "DBVEC"]>
+ <COND (<==? .RES STACK>
+ <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC <>>>
+ <MA-AINC ,AC-TP>>)
+ (T
+ <SET-GEN .RES <>>)>)
+ (<MEMBER <SPNAME .CASE> '["BIND" "BINDID"]>
+ <COND (<==? .RES STACK>
+ <COND (<=? <SPNAME .CASE> "BIND">
+ <EMIT-PUSH <TYPE-WORD LBIND> LONG>
+ <EMIT-PUSH <MA-ABS ,SPSTO-LOC> LONG>)
+ (T
+ <EMIT-PUSH <TYPE-CODE FIX> LONG>
+ <EMIT-PUSH <MA-ABS ,BINDID-LOC> LONG>)>)
+ (T
+ <COND (<SET AC <VAR-VALUE-IN-AC? .RES>>
+ <STORE-AC .AC <> <FIND-CACHE-VAR .RES>>)
+ (T
+ <SET AC <GET-AC PREF-VAL T>>)>
+ <COND (<=? <SPNAME .CASE> "BIND">
+ <EMIT-MOVE <MA-ABS ,SPSTO-LOC> <MA-REG .AC> LONG>
+ <DEST-DECL .AC .RES LBIND>)
+ (T
+ <EMIT-MOVE <MA-ABS ,BINDID-LOC> <MA-REG .AC> LONG>
+ <DEST-DECL .AC .RES FIX>)>)>)
+ (T
+ <SET CE <FIND-CASE-ENTRY .CASE>>
+ <CALL-RTE ,IGETS!-MIMOP CALL .RES
+ <CSENT-VTYP .CE> <CSENT-OFF .CE>>)>
+ NORMAL>
+
+<DEFINE SETS-GEN (CASE VAL "AUX" CE)
+ <COND (<MEMBER <SPNAME .CASE> '["BIND" "BINDID"]>
+ <EMIT-MOVE <COND (<TYPE? .VAL VARTBL>
+ <VAR-VALUE-ADDRESS .VAL>)
+ (T
+ <MA-IMM .VAL>)>
+ <COND (<=? <SPNAME .CASE> "BIND">
+ <MA-ABS ,SPSTO-LOC>)
+ (<MA-ABS ,BINDID-LOC>)> LONG>)
+ (<NOT <MEMBER <SPNAME .CASE> ["PURVEC" "DBVEC"]>>
+ <SET CE <FIND-CASE-ENTRY .CASE>>
+ <CALL-RTE ,ISETS!-MIMOP CALL <> <> .VAL <CSENT-OFF .CE>>)>
+ NORMAL>
+
+<NEWSTRUC CASE-ENTRY VECTOR
+ CSENT-KIND ATOM
+ CSENT-OFF FIX
+ CSENT-VTYP ATOM>
+
+<DEFINE CREATE-CASE-ENTRY (KIND OFF VTYP)
+ #DECL ((KIND VTYP) ATOM (OFF) FIX)
+ <CHTYPE <VECTOR .KIND .OFF .VTYP> CASE-ENTRY>>
+
+<GDECL (CASE-ENTRY-TABLE) <VECTOR [REST CASE-ENTRY]>>
+
+<DEFINE FIND-CASE-ENTRY (KIND)
+ <MAPF <>
+ <FCN (CE)
+ <COND (<=? <SPNAME .KIND> <SPNAME <CSENT-KIND .CE>>>
+ <MAPLEAVE .CE>)>>
+ ,CASE-ENTRY-TABLE>>
+
+<DEFINE RECORD-GEN (TYPARG "TUPLE" ARGS)
+ #DECL ((TYPARG) <OR ATOM FIX>)
+ <COND (<TYPE? .TYPARG ATOM>
+ <SET TYPARG <2 <MEMQ .TYPARG ,TYPE-WORDS>>>)>
+ <CALL-STACK-FUNCTION .ARGS ,BRECORD!-MIMOP <> .TYPARG>
+ NORMAL>
+
+<DEFINE LIST-GEN (LEN RES "OPTIONAL" HINT)
+ #DECL ((LEN) <OR FIX VARTBL> (RES) <OR VARTBL ATOM>)
+ <CALL-RTE ,BLIST!-MIMOP CALL .RES LIST .LEN>
+ NORMAL>
+
+<DEFINE RTUPLE-GEN (TVAR FVAR "OPTIONAL" RES)
+ <CALL-RTE ,IRTUPLE!-MIMOP JUMP <> <> .TVAR .FVAR>
+ UNCONDITIONAL-BRANCH>
+
+<DEFINE AGAIN-GEN (TVAR "OPTIONAL" RES)
+ #DECL ((TVAR) VARTBL)
+ <CALL-RTE ,IAGAIN!-MIMOP JUMP <> <> .TVAR>
+ UNCONDITIONAL-BRANCH>
+
+<DEFINE RETRY-GEN (TVAR "OPTIONAL" RES)
+ #DECL ((TVAR) VARTBL)
+ <CALL-RTE ,IRETRY!-MIMOP JUMP <> <> .TVAR>
+ UNCONDITIONAL-BRANCH>
+
+<DEFINE ACTIVATION-GEN ("OPTIONAL" VAR)
+ <CALL-RTE ,IACTIVATION!-MIMOP CALL <> <>>
+ NORMAL>
+
+<DEFINE TUPLE-GEN (NUM DEST "OPTIONAL" HINT)
+ #DECL ((NUM) <OR FIX VARTBL> (DEST) VARTBL)
+ <CALL-RTE ,ITUPLE!-MIMOP CALL .DEST TUPLE .NUM>>
+
+<DEFINE SBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
+ #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
+ <GET-AC ,AC-0 T>
+ <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
+ <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
+ (T
+ <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
+ <CALL-RTE ,ISBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
+ NORMAL>
+
+<DEFINE USBLOCK-GEN (TYPARG NUMARG RES "OPTIONAL" HINT "AUX" VEC)
+ #DECL ((TYPARG) ATOM (NUMARG) <OR FIX VARTBL>)
+ <GET-AC ,AC-0 T>
+ <COND (<SET VEC <MEMQ .TYPARG ,TYPE-WORDS>>
+ <LOAD-CONSTANT ,AC-0 <2 .VEC>>)
+ (T
+ <EMIT-MOVE <TYPE-CODE .TYPARG> <MA-REG ,AC-0> LONG>)>
+ <CALL-RTE ,UISBLOCK!-MIMOP CALL .RES .TYPARG .NUMARG>
+ NORMAL>
+
+<DEFINE INTGO-GEN ("AUX" (LAB <MAKE-LABEL>))
+ <COND (<AND <NOT ,BOOT-MODE>
+ <NOT ,GC-MODE>
+ <NOT ,DONT-INTERRUPT?>>
+ <EMIT ,INST-TSTL <MA-ABS ,INTFLG-LOC>>
+ <GEN-BRANCH ,INST-BEQL .LAB <>>
+ <CALL-RTE ,LCKINT!-MIMOP CALL <> <>>
+ <EMIT-LABEL .LAB <>>)>
+ NORMAL>
+
+<DEFINE TYPE-GEN (VAL RES "OPTIONAL" HINT "AUX" DAC)
+ #DECL ((VAL) VARTBL (RES) <OR ATOM VARTBL>)
+ <SET DAC <LOAD-VAR .VAL TYPE <> PREF-TYPE>>
+ <DEST-DECL .DAC .RES FIX>>
+
+<DEFINE NEWTYPE-GEN (VAL1 RES "OPTIONAL" HINT)
+ #DECL ((VAL1) VARTBL (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,INEWTYPE!-MIMOP CALL .RES FIX .VAL1>>
+
+<DEFINE TYPEW-GEN (ARG1 ARG2 RES "OPTIONAL" HINT)
+ #DECL ((ARG1 ARG2) VARTBL (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,ITYPEW!-MIMOP CALL .RES TYPE-W .ARG1 .ARG2>>
+
+<DEFINE TYPEWC-GEN (ARG1 RES "OPTIONAL" HINT "AUX" VAC)
+ #DECL ((ARG1) VARTBL (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,ITYPEWC!-MIMOP CALL .RES TYPE-C .ARG1>>
+
+<DEFINE OPEN-GEN (MODE BYTESZ NAME RES "OPTIONAL" (HINT <>))
+ #DECL ((MODE BYTESZ) <OR VARTBL FIX> (NAME) <OR STRING VARTBL>
+ (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,IOPEN!-MIMOP CALL .RES .HINT .MODE .BYTESZ .NAME>
+ NORMAL>
+
+<DEFINE CLOSE-GEN (CH "OPTIONAL" RES)
+ #DECL ((CH) <OR FIX VARTBL>)
+ <CALL-RTE ,ICLOSE!-MIMOP CALL <> <> .CH>
+ NORMAL>
+
+<DEFINE RESET-GEN (CH "OPTIONAL" RES)
+ #DECL ((CH) <OR FIX VARTBL>)
+ <CALL-RTE ,IRESET!-MIMOP CALL <> <> .CH>
+ NORMAL>
+
+<DEFINE READ-GEN (CHN STR NUMARGS GARB "OPTIONAL" (RES <>))
+ #DECL ((CHN NUMARGS) <OR VARTBL FIX> (STR) VARTBL)
+ <CALL-RTE ,IREAD!-MIMOP CALL .RES FIX .CHN .STR .NUMARGS .GARB>>
+
+<DEFINE PRINT-GEN (CHN STR NUMARGS)
+ #DECL ((CHN NUMARGS) <OR VARTBL FIX> (STR) VARTBL)
+ <CALL-RTE ,IPRINT!-MIMOP CALL <> <> .CHN .STR .NUMARGS>>
+
+<DEFINE RNTIME-GEN ("OPTIONAL" (RES <>))
+ <CALL-RTE ,IRNTIME!-MIMOP CALL .RES <>>>
+
+<DEFINE SAVE-GEN (CHN "OPTIONAL" (ATMZN <>) (PURZN <>) (RES <>))
+ #DECL ((CHN) <OR VARTBL FIX>)
+ <CALL-RTE ,ISAVE!-MIMOP CALL .RES <> .CHN .ATMZN .PURZN>
+ NORMAL>
+
+<DEFINE RESTORE-GEN (CHN "OPTIONAL" (RES <>))
+ #DECL ((CHN) <OR VARTBL FIX>)
+ <CALL-RTE ,IRESTORE!-MIMOP CALL .RES <> .CHN>
+ NORMAL>
+
+<DEFINE COMPERR-GEN () <CALL-RTE ,ICOMPERR!-MIMOP CALL <> <>> NORMAL>
+
+<DEFINE UNWCNT-GEN () <CALL-RTE ,IUNWCNT!-MIMOP JUMP <> <>> NORMAL>
+
+<DEFINE IRECORD-GEN (TYPEC NARGS NWORDS RES "OPTIONAL" (HINT <>))
+ #DECL ((TYPEC NARGS NWORDS) <OR VARTBL FIX> (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,BIREC!-MIMOP CALL .RES .HINT .TYPEC .NARGS .NWORDS>
+ NORMAL>
+
+<DEFINE ADJ-GEN (AMT "AUX" VAC LVAR)
+ #DECL ((AMT) <OR FIX VARTBL>)
+ <COND (<TYPE? .AMT FIX> <ADD-CONSTANT-TO-AC <* .AMT 8> ,AC-TP>)
+ (<AND <SET LVAR <FIND-CACHE-VAR .AMT>>
+ <SET VAC <LINKVAR-VALUE-AC .LVAR>>>
+ <EMIT ,INST-ASHL <MA-IMM 3> <MA-REG .VAC>
+ <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>
+ <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG ,AC-TP>>)
+ (ELSE
+ <EMIT ,INST-ASHL <MA-IMM 3> <VAR-VALUE-ADDRESS .AMT>
+ <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>
+ <EMIT ,INST-ADDL2 <MA-REG .VAC> <MA-REG ,AC-TP>>)>
+ NORMAL>
+
+<DEFINE NTHU-GEN (STRUC NUM RES "OPTIONAL" (HINT <>))
+ <CALL-RTE ,INTHU!-MIMOP CALL .RES .HINT .STRUC .NUM>
+ NORMAL>
+
+<DEFINE RESTU-GEN (STRUC NUM RES "OPTIONAL" (HINT <>))
+ <CALL-RTE ,IRESTU!-MIMOP CALL .RES .HINT .STRUC .NUM>
+ NORMAL>
+
+<DEFINE PUTU-GEN (STRUC NUM VAL "OPTIONAL" (HINT <>))
+ <CALL-RTE ,IPUTU!-MIMOP CALL <> <> .STRUC .NUM .VAL>
+ NORMAL>
+
+<DEFINE ATIC-GEN (ARG "OPTIONAL" (RES <>) (HINT <>))
+ <CALL-RTE ,IATIC!-MIMOP CALL .RES .HINT .ARG>
+ NORMAL>
+
+<DEFINE PFRAME-GEN (FRM RES "OPTIONAL" HINT "AUX" VAC TAC NPL TLAB)
+ #DECL ((FRM) VARTBL (RES) <OR ATOM VARTBL>)
+ <SET TAC <GET-AC>>
+ <SET VAC <LOAD-VAR .FRM VALUE <> ANY-AC>>
+ <EMIT ,INST-MOVL <MA-DISP .VAC -12> <MA-REG .VAC>>
+ <SET TLAB <MAKE-LABEL>>
+ <EMIT-LABEL .TLAB T>
+ <EMIT ,INST-TSTB <MA-DISP .VAC -1>>
+ <SET NPL <MAKE-LABEL>>
+ <GEN-BRANCH ,INST-BLSS .NPL <>>
+ <EMIT ,INST-MOVL <MA-DISP .VAC -4> <MA-REG .VAC>>
+ <GEN-BRANCH ,INST-BRB .TLAB UNCONDITIONAL-BRANCH>
+ <EMIT-LABEL .NPL <>>
+ <EMIT ,INST-MOVL <TYPE-WORD FRAME> <MA-REG .TAC>>
+ <DEST-PAIR .VAC .TAC .RES>
+ NORMAL>
+
+<DEFINE ARGS-GEN (FRM "OPTIONAL" (RES <>) (HINT <>))
+ #DECL ((FRM) VARTBL)
+ <CALL-RTE ,IARGS!-MIMOP CALL .RES .HINT .FRM>>
+
+<DEFINE VALUE-GEN (VAL RES "OPTIONAL" HINT "AUX" VAC)
+ #DECL ((RES) <OR ATOM VARTBL>)
+ <SET VAC <GET-AC>>
+ <MOVE-VALUE .VAL .VAC>
+ <DEST-DECL .VAC .RES FIX>
+ NORMAL>
+
+<DEFINE OBJECT-GEN (TYP CNT VAL RES "AUX" TAC VAC (TDONE? <>))
+ <COND (<==? .RES STACK>
+ <COND (<TYPE? .TYP VARTBL>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .TYP> WORD>)
+ (<EMIT-PUSH <MA-IMM .TYP> WORD>)>
+ <COND (<TYPE? .CNT VARTBL>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .CNT> WORD>)
+ (<EMIT-PUSH <MA-IMM .CNT> WORD>)>
+ <COND (<TYPE? .VAL VARTBL>
+ <EMIT-PUSH <VAR-VALUE-ADDRESS .VAL> LONG>)
+ (<EMIT-PUSH <MA-IMM .VAL> LONG>)>)
+ (T
+ <SET TAC <GET-AC DOUBLE T>>
+ <COND (<NOT <TYPE? .CNT VARTBL>>
+ <COND (<==? .CNT 0>
+ <SET TDONE? T>
+ <COND (<TYPE? .TYP VARTBL>
+ <EMIT ,INST-MOVZWL <VAR-VALUE-ADDRESS .TYP>
+ <MA-REG .TAC>>)
+ (T
+ <EMIT-MOVE <MA-IMM .TYP> <MA-REG .TAC> LONG>)>)
+ (<NOT <TYPE? .TYP VARTBL>>
+ <SET TDONE? T>
+ <EMIT-MOVE <MA-IMM <ORB .TYP <LSH .CNT 16>>>
+ <MA-REG .TAC> LONG>)>)>
+ <COND (<NOT .TDONE?>
+ <EMIT ,INST-MOVW <COND (<TYPE? .CNT VARTBL>
+ <VAR-VALUE-ADDRESS .CNT>)
+ (<MA-IMM .CNT>)> <MA-REG .TAC>>
+ <EMIT ,INST-ASHL <MA-LIT 16> <MA-REG .TAC> <MA-REG .TAC>>
+ <EMIT ,INST-MOVW <COND (<TYPE? .TYP VARTBL>
+ <VAR-VALUE-ADDRESS .TYP>)
+ (<MA-IMM .TYP>)> <MA-REG .TAC>>)>
+ <EMIT ,INST-MOVL <COND (<TYPE? .VAL VARTBL>
+ <VAR-VALUE-ADDRESS .VAL>)
+ (<MA-IMM .VAL>)>
+ <MA-REG <SET VAC <NEXT-AC .TAC>>>>
+ <DEST-PAIR .VAC .TAC .RES T>)>
+ NORMAL>
+
+<DEFINE NTH1-GEN (VAL RES "OPTIONAL" (HINT <>))
+ <CALL-RTE ,CINTH!-MIMOP CALL .RES .HINT .VAL>>
+
+<DEFINE REST1-GEN (VAL RES "OPTIONAL" (HINT <>))
+ <CALL-RTE ,CIRST!-MIMOP CALL .RES .HINT .VAL>>
+
+<DEFINE EMPTY?-GEN (VAR DIR LABEL "AUX" XLABEL)
+ #DECL ((VAR) VARTBL (DIR LABEL) ATOM)
+ <CALL-RTE ,CIEMP!-MIMOP CALL <> <> .VAR>
+ <COND (<==? .DIR +>
+ <GEN-BRANCH ,INST-BRB <SET XLABEL <MAKE-LABEL>>
+ UNCONDITIONAL-BRANCH <> T>)>
+ <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH <> <==? .DIR ->>
+ <COND (<==? .DIR +> <EMIT-LABEL .XLABEL <>>)>>
+
+<DEFINE GASSIGNED?-GEN (VAL RES "OPTIONAL" (HINT <>))
+ <CALL-RTE ,CIGAS!-MIMOP CALL .RES .HINT .VAL>>
+
+<DEFINE MONAD?-GEN (VAR DIR LABEL "AUX" XLABEL)
+ #DECL ((VAR) VARTBL (DIR LABEL) ATOM)
+ <CALL-RTE ,CIMON!-MIMOP CALL <> <> .VAR>
+ <COND (<==? .DIR +>
+ <GEN-BRANCH ,INST-BRB <SET XLABEL <MAKE-LABEL>>
+ UNCONDITIONAL-BRANCH <> T>)>
+ <GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH <> <==? .DIR ->>
+ <COND (<==? .DIR +> <EMIT-LABEL .XLABEL <>>)>>
+
+<DEFINE FGVAL-GEN (VAL RES "OPTIONAL" (HINT <>))
+ <CALL-RTE ,CIGVL!-MIMOP CALL .RES .HINT .VAL>>
+
+<DEFINE ACALL-GEN (SBR NARG "OPT" (RES <>) (HINT <>))
+ <CALL-RTE ,IACALL!-MIMOP CALL .RES .HINT .SBR .NARG>>
+
+; "return 0 if pointer is not to stack; 1 if to unused stack area; -1 if to
+ actual stack"
+<DEFINE ON-STACK?-GEN (OBJ RES "OPTIONAL" (HINT <>) (LABEL <MAKE-LABEL>) TAC)
+ #DECL ((OBJ) VARTBL)
+ <SET TAC <GET-AC PREF-VAL T>>
+ <LOAD-CONSTANT .TAC 0>
+ <DEST-DECL .TAC .RES FIX>
+ <EMIT ,INST-CMPL <MA-ABS ,STKBOT-LOC> <VAR-VALUE-ADDRESS .OBJ>>
+ <GEN-BRANCH ,INST-BGTR .LABEL <>> ; "Below stack"
+ <EMIT ,INST-CMPL <MA-ABS ,STKTOP-LOC> <VAR-VALUE-ADDRESS .OBJ>>
+ <GEN-BRANCH ,INST-BLSS .LABEL <>> ; "Above stack area"
+ <LOAD-CONSTANT .TAC 1> ; "Assume loser"
+ <EMIT ,INST-CMPL <MA-REG ,AC-TP> <VAR-VALUE-ADDRESS .OBJ>>
+ <GEN-BRANCH ,INST-BLSS .LABEL <>> ; "Above top of stack"
+ <LOAD-CONSTANT .TAC -1>
+ <EMIT-LABEL .LABEL <>>
+ NORMAL>
projects / pdp10-muddle.git / blobdiff