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

diff --git a/mim/development/mim/vaxc/toplev.mud b/mim/development/mim/vaxc/toplev.mud
new file mode 100644
index 0000000..3c6f696
--- /dev/null
+++ b/mim/development/mim/vaxc/toplev.mud
@@ -0,0 +1,688 @@
+<SETG HAS-RESULT <>>
+
+<DEFINE MIMOC (CODLIST "OPTIONAL" (NEW-MSUBR T) "AUX" STATUS ARGS
+	       (CODPTR .CODLIST)) 
+	#DECL ((CODLIST) <LIST [REST <OR FORM ATOM>]> (RESET-ALL) BOOLEAN
+	       (CODPTR) <SPECIAL LIST>)
+	<INIT-ALL-STUFF .NEW-MSUBR>
+	<SETG FLUSH-NEXT 0>
+	<REPEAT (NUM APL CODITEM PPTR OSTATUS (LABEL? <>)
+		 (FROB? <>) (FIRST? T) (PROTECT? <>) TF)
+		<SET CODITEM <1 .CODPTR>>
+		<SET PPTR .CODPTR>
+		<SET CODPTR <REST .CODPTR>>
+		<AND <GASSIGNED? MAX-SPACE> ,MAX-SPACE <PUTREST .PPTR ()>>
+		<COND (<G? ,FLUSH-NEXT 0>
+		       <SETG FLUSH-NEXT <- ,FLUSH-NEXT 1>>
+		       <COND (<EMPTY? .CODPTR> <RETURN>) (<AGAIN>)>)>
+		<UNPROTECT-ACS>
+		<CLEAR-DEATH>
+		<COND (<GETPROP .CODITEM DONE>)
+		      (<TYPE? .CODITEM FORM>
+		       <COND (<OR <NOT <GASSIGNED? <1 .CODITEM>>>
+				  <NOT <TYPE? <SET NUM ,<1 .CODITEM>> FIX>>>
+			      <ERROR "UNKNOWN" .CODITEM>)>
+		       <COND (<L? .NUM 0>
+			      <SET PROTECT? T>
+			      <SET NUM <- .NUM>>)
+			     (T
+			      <SET PROTECT? <>>)>
+		       <SET APL <NTH ,OP-APPLY-VECTOR .NUM>>
+		       <COND (<AND
+			       <SET TF <OR <MEMQ + .CODITEM>
+					   <MEMQ - .CODITEM>>>
+			       <PROG ((OUTST ,OUTST-LABEL-TABLE)
+				      (LAB <2 .TF>))
+			         #DECL ((OUTST) VECTOR)
+				 <MAPF <>
+				   <FUNCTION (LREF)  #DECL ((LREF) LABEL-REF)
+				     <COND (<==? <LABEL-REF-NAME .LREF> .LAB>
+					    <COND (<LABEL-REF-LOOP-LABEL .LREF>
+						   <MAPLEAVE T>)
+						  (<MAPLEAVE <>>)>)>>
+				   .OUTST>>>)
+			     (<SET-DEATH .CODPTR>)>
+		       <COND (<==? .NUM ,BAD-OPERATION>
+			      <ERROR "BAD OPERATION" MIMOC .CODITEM>)>
+		       <COND (<AND <==? .NUM ,DEAD!-MIMOP> <NOT .LABEL?>>
+			      <SET OSTATUS .STATUS>)
+			     (<SET OSTATUS <>>)>
+		       <COND (.FIRST?
+			      <SET FIRST? <>>
+			      <SET FROB? <>>)
+			     (<NOT .FROB?>
+			      <COND (<N==? <SET FROB? <FIRST-PROCESS .CODPTR>>
+					   TEMP!-MIMOP>
+				     <ILDB-LOOKAHEAD .CODPTR>)>)>
+		       <COND (<MEMQ .NUM ,PASS-OPS>
+			      <SET STATUS <APPLY .APL !<REST .CODITEM>>>)
+			     (ELSE
+			      <SET ARGS <PROCESS-ARGS <REST .CODITEM> .NUM
+						      .PROTECT?>>
+			      <SET STATUS <APPLY .APL !.ARGS>>)>
+		       <COND (<OR <NOT .FROB?>
+				  <==? <1 .CODITEM> MAKTUP!-MIMOP>
+				  <==? <1 .CODITEM> OPT-DISPATCH!-MIMOP>>
+			      <COND (<N==? <SET FROB? <FIRST-PROCESS .CODPTR>>
+					    TEMP!-MIMOP>
+				     <ILDB-LOOKAHEAD .CODPTR>)>)>
+		       <COND (.OSTATUS <SET STATUS .OSTATUS> <SET OSTATUS <>>)
+			     (<NOT .STATUS>
+			      <SET STATUS NORMAL>)>
+		       <SET LABEL? <>>)
+		      (<TYPE? .CODITEM ATOM>
+		       <SET LABEL? T>
+		       <GEN-LABEL .CODITEM .STATUS>)
+		      (<ERROR "BAD CODE ITEM" MIMOC>)>
+		<COND (<EMPTY? .CODPTR> <RETURN>)>>
+	<PUSH-TEMPS>
+	T>
+
+<DEFINE SET--DEATH (CODPTR "OPT" (REALLY-DEAD <>) "AUX" (N ,FLUSH-NEXT)) 
+   #DECL ((CODPTR) LIST (N) FIX)
+   <MAPF <>
+    <FCN
+     (CODITEM "AUX" VAR)
+     <COND
+      (<TYPE? .CODITEM FORM>
+       <COND (<AND <L? <SET N <- .N 1>> 0> <NOT <GETPROP .CODITEM DONE>>>
+	      <COND (<==? <1 .CODITEM> DEAD!-MIMOP>
+		     <MAPF <>
+		      <FCN (ATM)
+			   <COND (<TYPE? .ATM VARTBL>
+				  <VARTBL-DEAD? .ATM T>
+				  <COND (.REALLY-DEAD <DEAD-VAR .ATM>)>)>>
+		      <REST .CODITEM>>)
+		    (<MAPLEAVE>)>)>)
+      (<MAPLEAVE>)>>
+    .CODPTR>>
+
+<SETG ARGVEC <IVECTOR ,MAX-NUMBER-ARGS>>
+
+<DEFINE FIRST-PROCESS FP (L "AUX" VAL) 
+   #DECL ((L) <LIST [REST <OR FORM ATOM>]>)
+   <SET VAL
+    <MAPF <>
+      <FUNCTION (X) 
+	    <COND
+	     (<AND <TYPE? .X FORM>
+		   <GASSIGNED? <1 .X>>>
+	      <COND
+	       (<NOT <MEMQ ,<1 .X> ,PASS-OPS>>
+		<REPEAT ((PTR <REST .X>) ITEM ARG TTYP)
+		      <COND (<EMPTY? .PTR> <RETURN>)>
+		      <COND (<==? <SET ITEM <1 .PTR>> =>
+			     <1 .PTR <CHTYPE .ITEM RES-IND>>
+			     <SET PTR <REST .PTR>>
+			     <SET ITEM <1 .PTR>>
+			     <COND (<==? .ITEM STACK>)
+				   (<SET ITEM <FIND-VAR .ITEM>> <1 .PTR .ITEM>)
+				   (<ERROR "NOT A VARIABLE"
+					   <1 .PTR>
+					   PROCESS-ARGS>)>)
+			    (<TYPE? .ITEM ATOM>
+			     <COND (<SET ARG <FIND-VAR .ITEM>>
+				    <VARTBL-DEAD? .ARG <>>
+				    <1 .PTR .ARG>)>)
+			    (<AND <TYPE? .ITEM FORM>
+				  <==? <LENGTH .ITEM> 2>
+				  <==? <1 .ITEM> TYPE>
+				  <==? <1 .X> CHTYPE!-MIMOP>>
+			     <COND (<SET ARG <FIND-VAR <2 .ITEM>>>
+				    <1 .PTR <FORM TYPE .ARG>>
+				    <VARTBL-DEAD? .ARG <>>)>)
+			    (<AND <TYPE? .ITEM FORM>
+				  <==? <LENGTH .ITEM> 2>
+				  <OR <==? <SET TTYP <1 .ITEM>> QUOTE>
+				      <==? .TTYP TYPE-CODE>>
+				  <TYPE? <2 .ITEM> ATOM>>
+			     <SET ITEM <2 .ITEM>>
+			     <AND <==? .TTYP TYPE-CODE>
+				  <SET TTYP <CHECK-MIMOP-TYPE .ITEM>>
+				  <SET ITEM .TTYP>>
+			     <1 .PTR .ITEM>)>
+		      <SET PTR <REST .PTR>>>)
+	       (<==? <1 .X> TEMP!-MIMOP>
+		<PROG ((FIRST-PROCESS? T))
+		      #DECL ((FIRST-PROCESS?) <SPECIAL ATOM>)
+		      <TEMP-PROCESS !<REST .X>>>
+		<MAPR <>
+		      <FUNCTION (L "AUX" (X <1 .L>)) 
+				#DECL ((L) LIST)
+				<COND (<TYPE? .X LIST>
+				       <COND (<TYPE? <1 .X> ADECL>
+					      <1 .X <FIND-VAR <1 <1 .X>>>>)
+					     (T
+					      <1 .X <FIND-VAR <1 .X>>>)>)
+				      (<TYPE? .X ADECL> <1 .L <FIND-VAR <1 .X>>>)
+				      (T <1 .L <FIND-VAR .X>>)>>
+		      <REST .X>>)
+	       (<OR <==? <1 .X> MAKTUP!-MIMOP>
+		    <==? <1 .X> OPT-DISPATCH!-MIMOP>>
+		<MAPLEAVE TEMP!-MIMOP>)>)>>
+    .L>>
+    .VAL>
+
+<DEFINE PROCESS-ARGS (LST NUM PROTECT? "AUX" (CNT 1) (ARGS ,ARGVEC) ARG TTYP DISP) 
+	#DECL ((LST) LIST (NUM) FIX)
+	<SETG HAS-RESULT <>>
+	<REPEAT ((PTR .LST) ITEM)
+		<COND (<EMPTY? .PTR> <RETURN>)>
+		<COND (<TYPE? <SET ITEM <1 .PTR>> RES-IND>
+		       <SET PTR <REST .PTR>>
+		       <SET ITEM <1 .PTR>>
+		       <COND (<==? .NUM ,CHANNEL-OP!-MIMOP>
+			      <SETG HAS-RESULT .ITEM>
+			      <SET PTR <REST .PTR>>
+			      <AGAIN>)
+			     (<==? .ITEM STACK>)
+			     (<MEMQ .NUM ,DEAD-MIM-CODES>
+			      <VARTBL-DEAD? .ITEM T>)>)
+		      (<TYPE? .ITEM VARTBL>
+		       <COND (.PROTECT? <PROTECT-VAL .ITEM>)>
+		       <VARTBL-DEAD? .ITEM <>>)
+		      (<AND <TYPE? .ITEM FORM>
+			    <==? <LENGTH .ITEM> 2>
+			    <==? <1 .ITEM> TYPE>
+			    <==? .NUM ,CHTYPE!-MIMOP>>
+		       <COND (.PROTECT? <PROTECT-VAL <2 .ITEM>>)>
+		       <VARTBL-DEAD? <2 .ITEM> <>>)>
+		<COND (<G? .CNT <LENGTH .ARGS>>
+		       <SETG ARGVEC <IVECTOR <+ <LENGTH .ARGS> 50>>>
+		       <SET ARGS <SUBSTRUC .ARGS 0 <LENGTH .ARGS> ,ARGVEC>>)>
+		<PUT .ARGS .CNT .ITEM>
+		<SET CNT <+ .CNT 1>>
+		<SET PTR <REST .PTR>>>
+	<SET DISP <- <LENGTH .ARGS> <- .CNT 1>>>
+	<SUBSTRUC .ARGS 0 <- .CNT 1> <REST .ARGS .DISP>>>
+
+<GDECL (DEAD-MIM-CODES) <UVECTOR [REST FIX]>>
+
+<DEFINE INIT-ALL-STUFF (RESET-ALL) 
+	#DECL ((RESET-ALL) BOOLEAN)
+	<SETG MAKTUP-FLAG <>>
+	<SETG ICALL-LEVEL 0>
+	<RESET-AC-STACK-MODEL>
+	<RESET-CODE>
+	<COND (.RESET-ALL
+	       <RESET-FCODE>
+	       <RESET-CONSTANTS>
+	       <INIT-MVEC-STUFF>
+	       <INIT-UNRESOLVED-CALLS>
+	       <INIT-CALL-ENTRYS>)>
+	<INIT-LABEL-TABLE .RESET-ALL>
+	<RESET-CALL-TABLE>
+	<INIT-VAR-LIST>
+	<INIT-INTERNAL-ENTRYS>
+	<SETG TEMP-PATCH -1>
+	<RESET-FRAME-LABEL-TABLE>
+	<INIT-PATCH-TABLE>
+	<RESET-PUSH-LABEL-TABLE>
+	<RESET-MOVE-LABEL-TABLE>>
+
+<DEFINE FCN-PROCESS (NAME DCLS
+		     "TUPLE" VARS
+		     "AUX" (VARLST ()) (NVARLST ())
+			   (LAB <MAKE-LABEL "FNAME">))
+	#DECL ((DCLS) LIST (VARS) <TUPLE [REST ATOM]>)
+	<SETG FUNCTION-DECL .DCLS>
+	<COND (<=? <1 .DCLS> "VALUE">
+	       <SET DCLS <REST .DCLS 2>>)>
+	<SETG FUNCTION-NAME .NAME>
+	<SETG ICALL-LABELS ()>
+	<REPEAT (VAR VDCL TBL)
+		<COND (<EMPTY? .VARS> <RETURN>)>
+		<SET VAR <1 .VARS>>
+		<COND (<TYPE? <SET VDCL <1 .DCLS>> STRING>
+		       <SET DCLS <REST .DCLS>>
+		       <SET VDCL <1 .DCLS>>)>
+		<SET TBL <CREATE-VAR .VAR <>>>
+		<COND (<EMPTY? .VARLST>
+		       <SET VARLST (.TBL)>
+		       <SET NVARLST .VARLST>)
+		      (ELSE
+		       <PUTREST .NVARLST (.TBL)>
+		       <SET NVARLST <REST .NVARLST>>)>
+		<INDICATE-VAR-DECL .TBL <ISTYPE? .VDCL>>
+		<SET VARS <REST .VARS>>
+		<SET DCLS <REST .DCLS>>>
+	<SETG ARGLIST-VARS .VARLST>
+	<EMIT-LABEL .LAB <>>
+	<ADD-INTERNAL-ENTRY -1 .LAB>
+	NORMAL>
+
+<DEFINE TEMP-PROCESS ("TUPLE" TEMPS
+		      "AUX" ADL SLABEL
+			    (NOT-YET?
+			     <AND <ASSIGNED? FIRST-PROCESS?>
+				  .FIRST-PROCESS?>))
+   #DECL ((TEMPS) <TUPLE [REST <OR VARTBL ATOM ADECL LIST>]>)
+   <COND (<NOT .NOT-YET?>
+	  <SET SLABEL <MAKE-LABEL>>
+	  <EMIT-LABEL .SLABEL <>>
+	  <INDICATE-TEMP-PATCH <ADD-PATCH TEMPORARIES>>)>
+   <MAPF <>
+	 <FCN (TMP "AUX" TBL TC)
+	      <COND (<TYPE? .TMP VARTBL> <CREATE-VAR .TMP T .NOT-YET?>)
+		    (<TYPE? .TMP ATOM> <CREATE-VAR .TMP T .NOT-YET?>)
+		    (<TYPE? .TMP LIST>
+		     <COND (<TYPE? <SET ADL <1 .TMP>> ADECL>
+			    <SET TBL <CREATE-VAR <1 .ADL> T .NOT-YET?>>
+			    <INDICATE-VAR-DECL .TBL <2 .ADL>>)
+			   (ELSE <SET TBL <CREATE-VAR .ADL T .NOT-YET?>>)>
+		     <COND (<NOT .NOT-YET?>
+			    <COND (<AND <TYPE? <SET TC <2 .TMP>> FORM>
+					<==? <LENGTH .TC> 2>
+					<==? <1 .TC> QUOTE>
+					<TYPE? <2 .TC> ATOM>>
+				   <SET TC <2 .TC>>)>
+			    <INDICATE-VAR-INIT .TBL .TC>)>)
+		    (<TYPE? .TMP ADECL>
+		     <SET TBL <CREATE-VAR <1 .TMP> T .NOT-YET?>>
+		     <INDICATE-VAR-DECL .TBL <2 .TMP>>)
+		    (<ERROR "BAD TEMP STATEMENT" TEMP-PROCESS>)>>
+	 .TEMPS>
+   NORMAL>
+
+<DEFINE ISTYPE? (DCL) 
+	#DECL ((DCL) <OR ATOM FORM>)
+	<COND (<TYPE? .DCL ATOM> <AND <VALID-TYPE? .DCL> .DCL>)
+	      (<AND <TYPE? <SET DCL <1 .DCL>> ATOM> <VALID-TYPE? .DCL>> .DCL)>>
+
+<DEFINE END-GEN () UNCONDITIONAL-BRANCH>
+
+<DEFINE UCBRANCH-GEN (DIR LABEL) 
+	#DECL ((DIR LABEL) ATOM)
+	<GEN-BRANCH ,INST-BRB .LABEL UNCONDITIONAL-BRANCH>
+	UNCONDITIONAL-BRANCH>
+
+<DEFINE LOCATION-GEN (DIR LABEL RES "AUX" VAC) 
+	#DECL ((DIR LABEL) ATOM (RES) VARTBL)
+	<PROTECT <SET VAC <GET-AC ANY-AC T>>>
+	<EMIT-MOVE-LABEL .LABEL <MA-REG .VAC>>
+	<DEST-DECL .VAC .RES FIX>
+	NORMAL>
+
+<DEFINE LOAD-VAR-APP (VAR
+		      "OPTIONAL" (MUNG T) (DCL <VARTBL-DECL .VAR>) (USE? T))
+	#DECL ((VAR) VARTBL)
+	<COND (<OR <NOT .DCL> <STRUCTURED-TYPE? .DCL>>
+	       <LOAD-VAR .VAR VALUE .MUNG PREF-VAL .DCL .USE?>)
+	      (ELSE <LOAD-VAR .VAR VALUE .MUNG PREF-VAL .DCL .USE?>)>>
+
+<DEFINE PROCESS-DESTINATION-HINT (HINT DEST "AUX" DCL) 
+	#DECL ((HINT) <OR FALSE HINT ATOM> (DEST) <OR ATOM VARTBL>)
+	<COND (<AND <TYPE? .DEST VARTBL>
+		    <COND (<TYPE? .HINT LIST>
+			   <SET DCL <PARSE-HINT .HINT TYPE>>)
+			  (<TYPE? .HINT ATOM> <SET DCL .HINT>)>>
+	       <INDICATE-VAR-TEMP-DECL .DEST .DCL>)>>
+
+<DEFINE MOVE-TYPE (VAL TEADDR
+		   "OPTIONAL" (CEADDR <>)
+		   "AUX" DCL RADDR ADDR1 LVAR)
+   #DECL ((VAL) ANY (TEADDR) <OR AC EFF-ADDR> (CEADDR) <OR FALSE EFF-ADDR>)
+   <COND (<TYPE? .TEADDR AC> <SET RADDR <MA-REG .TEADDR>>)
+	 (<SET RADDR .TEADDR>)>
+   <COND (<TYPE? .VAL VARTBL>
+	  <COND (<OR <SAFE-TYPE-WORD? .VAL>
+		     <AND <SET LVAR <FIND-CACHE-VAR .VAL>>
+			  <OR <AND <NOT <LINKVAR-TYPE-AC .LVAR>>
+				   <NOT <LINKVAR-TYPE-WORD-AC .LVAR>>
+				   <NOT <LINKVAR-COUNT-AC .LVAR>>
+				   <NOT <VARTBL-DECL .VAL>>>
+			      <AND <LINKVAR-TYPE-STORED .LVAR>
+				   <LINKVAR-COUNT-STORED .LVAR>>>>>
+		 <EMIT-MOVE <VAR-TYPE-ADDRESS .VAL TYPE-WORD> .RADDR LONG>
+		 <AND <TYPE? .TEADDR AC>
+		      <LOAD-AC .TEADDR <VAR-TYPE-ADDRESS .VAL TYPE-WORD>>>)
+		(<SET DCL <VARTBL-DECL .VAL>>
+		 <COND (<COUNT-NEEDED? .DCL>
+			<SET ADDR1 <VAR-COUNT-ADDRESS .VAL>>
+			<COND (<TYPE? .TEADDR AC>
+			       <EMIT-MOVE <TYPE-WORD .DCL> .RADDR LONG>
+			       <EMIT ,INST-BISW2 .ADDR1 <MA-REG .TEADDR>>
+			       <USE-AC .TEADDR>)
+			      (ELSE
+			       <EMIT-MOVE .ADDR1 .CEADDR WORD>
+			       <EMIT-MOVE <TYPE-CODE .DCL WORD>
+					  .TEADDR
+					  WORD>)>)
+		       (ELSE
+			<EMIT-MOVE <TYPE-WORD .DCL> .RADDR LONG>
+			<AND <TYPE? .TEADDR AC>
+			     <LOAD-AC .TEADDR <TYPE-WORD .DCL>>>)>)
+		(<ERROR "NO TYPE WORD" MOVE-TYPE>)>)
+	 (<FIX-CONSTANT? .VAL>
+	  <EMIT-MOVE <TYPE-WORD <TYPE .VAL>> .RADDR LONG>
+	  <AND <TYPE? .TEADDR AC> <LOAD-AC .TEADDR <TYPE-WORD <TYPE .VAL>>>>)
+	 (ELSE
+	  <SET ADDR1 <ADDR-TYPE-M <ADD-MVEC .VAL>>>
+	  <EMIT-MOVE .ADDR1 .TEADDR LONG>
+	  <AND <TYPE? .TEADDR AC> <LOAD-AC .TEADDR .ADDR1>>)>>
+
+<DEFINE GEN-CONSTANT (RCNS VALUE-AC TYPE-AC GEN-PREF
+		      "AUX" (CNS .RCNS) VAC TAC (TYP <TYPE .CNS>))
+	#DECL ((CNS) ANY (VALUE-AC TYPE-AC) <OR ATOM AC> (GEN-PREF) ATOM)
+	<PROTECT <SET VAC <GET-AC .VALUE-AC T>>>
+	<MOVE-VALUE .CNS .VAC>
+	<COND (<AND <N==? .GEN-PREF TYPE-WORD> <NOT <COUNT-NEEDED? .TYP>>>
+	       <SETG CONSTANT-TYPE-AC <>>
+	       <SETG CONSTANT-COUNT-AC <>>)
+	      (ELSE
+	       <SET TAC <GET-AC PREF-TYPE>>
+	       <MUNG-AC .TAC>
+	       <COND (<==? .GEN-PREF TYPE-WORD>
+		      <COND (<SET CNS <FIX-CONSTANT? .CNS>>
+			     <EMIT-MOVE <TYPE-WORD .TYP> <MA-REG .TAC> LONG>
+			     <LOAD-AC .TAC <TYPE-WORD .TYP>>)
+			    (ELSE
+			     <EMIT-MOVE <ADDR-TYPE-MQUOTE .RCNS>
+					<MA-REG .TAC>
+					LONG>
+			     <LOAD-AC .TAC <ADDR-TYPE-MQUOTE .RCNS>>)>
+		      <SETG CONSTANT-TYPE-AC .TAC>)
+		     (ELSE
+		      <LOAD-CONSTANT .TAC <LENGTH .RCNS>>
+		      <SETG CONSTANT-COUNT-AC .TAC>)>)>
+	.VAC>
+
+<DEFINE LOAD-CONSTANT (DEST RVAL "AUX" VAL ADDR) 
+	#DECL ((AC) AC (VAL) FIX)
+	<COND (<TYPE? .DEST AC> <SET ADDR <MA-REG .DEST>>)
+	      (ELSE <SET ADDR .DEST>)>
+	<SET VAL <FIX-CONSTANT? .RVAL>>
+	<COND (<0? .VAL> <EMIT ,INST-CLRL .ADDR>)
+	      (<AND <G=? .VAL 1> <L=? .VAL 63>>
+	       <EMIT ,INST-MOVL <MA-LIT .VAL> .ADDR>)
+	      (<AND <G=? .VAL -63> <L=? .VAL -1>>
+	       <EMIT ,INST-MNEGL <MA-LIT <- .VAL>> .ADDR>)
+	      (<AND <G=? .VAL 64> <L=? .VAL 255>>
+	       <EMIT ,INST-MOVZBL <MA-BYTE-IMM .VAL> .ADDR>)
+	      (<AND <G=? .VAL -127> <L=? .VAL -64>>
+	       <EMIT ,INST-CVTBL <MA-BYTE-IMM .VAL> .ADDR>)
+	      (<AND <G=? .VAL 255> <L=? .VAL ,MAXP16C>>
+	       <EMIT ,INST-MOVZWL <MA-WORD-IMM .VAL> .ADDR>)
+	      (<AND <G=? .VAL ,MIN16C> <L=? .VAL -128>>
+	       <EMIT ,INST-CVTWL <MA-WORD-IMM .VAL> .ADDR>)
+	      (<TYPE? .RVAL FLOAT>
+	       <COND (<G=? .RVAL 0.0>
+		      <EMIT ,INST-MOVF <FLOAT-IMM .VAL> .ADDR>)
+		     (ELSE
+		      <EMIT ,INST-MNEGF <FLOAT-IMM <FLOATCONVERT <- .RVAL>>>
+			    .ADDR>)>)
+	      (ELSE <EMIT ,INST-MOVL <MA-LONG-IMM .VAL> .ADDR>)>>
+
+<DEFINE DEST-DECL (AC DEST DCL "OPTIONAL" (STATUS? <>)) 
+	#DECL ((AC) AC (DEST) <OR ATOM VARTBL> (DCL) ATOM
+	       (STATUS?) <OR FALSE ATOM>)
+	<COND (<==? .DEST STACK> <PUSH-PAIR .DCL .AC> <CLEAR-STATUS>)
+	      (<TYPE? .DEST VARTBL>
+	       <DEAD-VAR .DEST>
+	       <LINK-VAR-TO-AC .DEST .AC VALUE <>>
+	       <INDICATE-CACHED-VARIABLE-DECL .DEST .DCL>
+	       <COND (.STATUS?
+		      <SET-STATUS-AC .AC>
+		      <SET-STATUS-VAR .DEST .STATUS?>)>)>>
+
+<DEFINE DEST-COUNT-DECL (VAC CAC DEST DCL "OPTIONAL" (STATUS? <>)) 
+	#DECL ((VAC CAC) AC (DEST) <OR ATOM VARTBL> (DCL) ATOM
+	       (STATUS?) <OR FALSE ATOM>)
+	<COND (<==? .DEST STACK>
+	       <PUSH-PAIR-WITH-CNT .DCL .VAC .CAC>
+	       <CLEAR-STATUS>)
+	      (<TYPE? .DEST VARTBL>
+	       <DEAD-VAR .DEST>
+	       <LINK-VAR-TO-AC .DEST .VAC VALUE <>>
+	       <INDICATE-CACHED-VARIABLE-DECL .DEST .DCL>
+	       <LINK-VAR-TO-AC .DEST .CAC COUNT <>>
+	       <COND (.STATUS?
+		      <SET-STATUS-AC .VAC>
+		      <SET-STATUS-VAR .DEST .STATUS?>)>)>>
+
+<DEFINE DEST-PAIR (VAC CAC DEST "OPTIONAL" (STATUS? <>)) 
+	#DECL ((CAC VAC) AC (DEST) <OR ATOM VARTBL> (STATUS?) <OR FALSE ATOM>)
+	<COND (<==? .DEST STACK>
+	       <AND ,GC-MODE
+		    <EMIT ,INST-BICW2
+			  <MA-IMM ,SHORT-TYPE-MASK>
+			  <MA-REG .CAC>>>
+	       <COND (<==? <+ <AC-NUMBER .CAC> 1> <AC-NUMBER .VAC>>
+		      <EMIT-PUSH <MA-REG .CAC> DOUBLE>)
+		     (ELSE
+		      <EMIT-PUSH <MA-REG .CAC> LONG>
+		      <EMIT-PUSH <MA-REG .VAC> LONG>)>
+	       <CLEAR-STATUS>)
+	      (<TYPE? .DEST VARTBL>
+	       <DEAD-VAR .DEST>
+	       <LINK-VAR-TO-AC .DEST .VAC VALUE <>>
+	       <LINK-VAR-TO-AC .DEST .CAC TYPE-WORD <>>
+	       <COND (.STATUS?
+		      <SET-STATUS-AC .VAC>
+		      <SET-STATUS-VAR .DEST VALUE>)>)>>
+
+<DEFINE DEST-TYPE-VALUE (VAC TAC DEST "OPTIONAL" (STATUS? <>) LVAR) 
+	#DECL ((VAC TAC) AC (DEST) <OR ATOM VARTBL> (STATUS?) <OR FALSE ATOM>
+	       (LVAR) LINKVAR)
+	<COND (<==? .DEST STACK>
+	       <EMIT-PUSH <MA-REG .TAC> WORD>
+	       <CLEAR-PUSH WORD>
+	       <EMIT-PUSH <MA-REG .VAC> LONG>
+	       <CLEAR-STATUS>)
+	      (<TYPE? .DEST VARTBL>
+	       <DEAD-VAR .DEST>
+	       <LINK-VAR-TO-AC .DEST .VAC VALUE <>>
+	       <LINK-VAR-TO-AC .DEST .TAC TYPE <>>
+	       <SET LVAR <FIND-CACHE-VAR .DEST>>
+	       <PUT .LVAR ,LINKVAR-COUNT-STORED T>
+	       <COND (.STATUS?
+		      <SET-STATUS-AC .VAC>
+		      <SET-STATUS-VAR .DEST VALUE>)>)>>
+
+<DEFINE PUSH-PAIR (TYP VAC) 
+	#DECL ((TYP) ATOM (VAC) AC)
+	<EMIT-PUSH <TYPE-WORD .TYP> LONG>
+	<EMIT-PUSH <MA-REG .VAC> LONG>>
+
+<DEFINE PUSH-PAIR-WITH-CNT (DCL VAC DAC) 
+	#DECL ((VAC DAC) AC (DCL) ATOM)
+	<EMIT-PUSH <TYPE-CODE .DCL> WORD>
+	<EMIT-PUSH <MA-REG .DAC> WORD>
+	<EMIT-PUSH <MA-REG .VAC> LONG>>
+
+<DEFINE PUSH-GEN (VAL) 
+	#DECL ((VAL) ANY)
+	<COND (<TYPE? .VAL VARTBL> <PUSH-VAR .VAL>) (<PUSH-CONSTANT .VAL>)>
+	NORMAL>
+
+<DEFINE POP-GEN (RES "AUX" VAC TAC) 
+	#DECL ((RES) VARTBL)
+	<SET TAC <GET-AC DOUBLE>>
+	<EMIT-POP .TAC DOUBLE>
+	<DEST-PAIR <NEXT-AC .TAC> .TAC .RES>>
+
+<DEFINE INIT-OPERATIONS () 
+	<SETG OP-APPLY-VECTOR <IVECTOR ,MAX-NUMBER-OPS ,BAD-OPERATION>>
+	<SETG OP-COUNT 1>
+	<SETG MIMOP-OBLIST <MOBLIST MIMOP 51>>
+	<SETG VAR-OBLIST <MOBLIST VARS 51>>>
+
+<DEFINE DEFINE-MIMOP (NAME FCN "OPT" (PROTECT? <>) "AUX" (CNT ,OP-COUNT) ANAME) 
+	#DECL ((NAME) STRING)
+	<COND (<G? .CNT ,MAX-NUMBER-OPS>
+	       <ERROR "TOO MANY OPERATIONS" DEFINE-MIMOP>)>
+	<PUT ,OP-APPLY-VECTOR .CNT .FCN>
+	<SET ANAME
+	     <OR <LOOKUP .NAME ,MIMOP-OBLIST> <INSERT .NAME ,MIMOP-OBLIST>>>
+	<SETG .ANAME <COND (.PROTECT? <- .CNT>)
+			   (.CNT)>>
+	<SETG OP-COUNT <+ .CNT 1>>>
+
+<DEFINE STRUCTURED-TYPE? (DCL) 
+	#DECL ((DCL) ATOM)
+	<COND (<ISTYPE? .DCL>
+	       <MEMQ <TYPEPRIM .DCL>
+		     '[OFFSET RECORD UVECTOR STRING LIST VECTOR ATOM]>)
+	      (T)>>
+
+<DEFINE COUNT-NEEDED? (DCL) 
+	#DECL ((DCL) ATOM)
+	<SET DCL <CLEAN-DECL .DCL>>
+	<AND <ISTYPE? .DCL>
+	     <MEMQ <TYPEPRIM .DCL>
+		   '[OFFSET STRING VECTOR RECORD UVECTOR TUPLE BYTES]>>>
+
+<DEFINE PARSE-HINT (HINT NAME "AUX" HTYP VAL) 
+	#DECL ((HINT) HINT (NAME) ATOM)
+	<COND (<AND <TYPE? <SET HTYP <1 .HINT>> FORM>
+		    <==? <LENGTH .HTYP> 2>
+		    <==? <1 .HTYP> QUOTE>>
+	       <SET HTYP <2 .HTYP>>)>
+	<COND (<==? .HTYP .NAME>
+	       <COND (<AND <==? .HTYP TYPE>
+			   <NOT <VALID-TYPE? <2 .HINT>>>
+			   <SET VAL <CHECK-MIMOP-TYPE <2 .HINT>>>>
+		      .VAL)
+		     (<2 .HINT>)>)>>
+
+<DEFINE ADD-TO-AC (VAC VADDR) 
+	#DECL ((VAC) AC (VADDR) EFF-ADDR)
+	<EMIT ,INST-ADDL2 .VADDR <MA-REG .VAC>>>
+
+<DEFINE SUB-FROM-AC (VAC VADDR) 
+	#DECL ((VAC) AC (VADDR) EFF-ADDR)
+	<EMIT ,INST-SUBL2 .VADDR <MA-REG .VAC>>>
+
+<DEFINE MOVE-VALUE (VAL EADDR "AUX" FX? ADDR1) 
+	#DECL ((VAL) ANY (EADDR) <OR AC EFF-ADDR>)
+	<COND (<TYPE? .VAL VARTBL>
+	       <SET ADDR1 <VAR-VALUE-ADDRESS .VAL>>
+	       <COND (<TYPE? .EADDR AC>
+		      <EMIT-MOVE .ADDR1 <MA-REG .EADDR> LONG>
+		      <LOAD-AC .EADDR .ADDR1>)
+		     (<EMIT-MOVE .ADDR1 .EADDR LONG>)>)
+	      (<FIX-CONSTANT? .VAL> <LOAD-CONSTANT .EADDR .VAL>)
+	      (ELSE
+	       <SET ADDR1 <ADDR-VALUE-MQUOTE .VAL>>
+	       <COND (<TYPE? .EADDR AC>
+		      <EMIT-MOVE .ADDR1 <MA-REG .EADDR> LONG>
+		      <LOAD-AC .EADDR .ADDR1>)
+		     (<EMIT-MOVE .ADDR1 .EADDR LONG>)>)>>
+
+
+
+<DEFINE ADD-CONSTANT-TO-AC (VAL DEST
+			    "AUX" SDATA (ACADDR <MA-REG .DEST>) SZ DADDR)
+	#DECL ((VAL) FIX (DEST) AC)
+	<SET VAL <FIX-CONSTANT? .VAL>>
+	<COND (<0? .VAL>)
+	      (<==? .VAL 1> <EMIT ,INST-INCL .ACADDR>)
+	      (<==? .VAL -1> <EMIT ,INST-DECL .ACADDR>)
+	      (<AND <G=? .VAL 0> <L=? .VAL 63>>
+	       <EMIT ,INST-ADDL2 <MA-LIT .VAL> .ACADDR>)
+	      (<AND <G=? .VAL -63> <L=? .VAL 0>>
+	       <EMIT ,INST-SUBL2 <MA-LIT <- .VAL>> .ACADDR>)
+	      (ELSE <EMIT ,INST-ADDL2 <MA-LONG-IMM .VAL> .ACADDR>)>>
+
+<DEFINE CLEAN-DECL (DCL "AUX" (NAME <SPNAME .DCL>) (SNAME .NAME)) 
+	#DECL ((DCL) ATOM)
+	<COND (<AND <G? <LENGTH .NAME> 2>
+		    <==? <2 .NAME> !\$>
+		    <==? <1 .NAME> !\T>
+		    <SET NAME <LOOKUP <REST .NAME 2> <ROOT>>>
+		    <OR <ISTYPE? .NAME> <MEMQ .NAME '[LBIND GBIND]>>>
+	       .NAME)
+	      (<ISTYPE? .DCL> .DCL)
+	      (<LOOKUP .SNAME <ROOT>>)
+	      (.DCL)>>
+
+<DEFINE CHECK-MIMOP-TYPE (ITEM) 
+	#DECL ((ITEM) ATOM)
+	<COND (<AND <==? <OBLIST? .ITEM> ,MIMOP-OBLIST>
+		    <NOT <VALID-TYPE? .ITEM>>
+		    <SET ITEM <LOOKUP <SPNAME .ITEM> <ROOT>>>
+		    <VALID-TYPE? .ITEM>>
+	       .ITEM)>>
+
+<DEFINE PRINT-MSUBR (BYTEOFF "OPTIONAL" (OUTCHAN .OUTCHAN)) 
+	#DECL ((OUTCHAN) CHANNEL)
+	<COND (<NOT ,BOOT-MODE>
+	       <PRINC "<SETG " .OUTCHAN>
+	       <PRIN1 ,FUNCTION-NAME .OUTCHAN>
+	       <PRINC " " .OUTCHAN>)>
+	<PRINC "#MSUBR [" .OUTCHAN>
+	<PRIN1 ,INTERNAL-MSUBR-NAME .OUTCHAN>
+	<PRINC !\  .OUTCHAN>
+	<PRIN1 ,FUNCTION-NAME .OUTCHAN>
+	<PRINC !\  .OUTCHAN>
+	<PRIN1 ,FUNCTION-DECL .OUTCHAN>
+	<PRINC !\  .OUTCHAN>
+	<PRIN1 .BYTEOFF .OUTCHAN>
+	<PRINC !\] .OUTCHAN>
+	<OR ,BOOT-MODE <PRINC ">" .OUTCHAN>>
+	<CRLF .OUTCHAN>>
+
+<MSETG INFINITY <CHTYPE <MIN> FIX>>
+
+<DEFINE PRINT-IMSUBR ("OPTIONAL" (OUTCHAN .OUTCHAN) "AUX" (LLEN
+							   <M-HLEN .OUTCHAN>)) 
+	#DECL ((OUTCHAN) CHANNEL)
+	<CRLF .OUTCHAN>
+	<COND (<NOT ,BOOT-MODE>
+	       <PRINC "<SETG " .OUTCHAN>
+	       <PRIN1 ,INTERNAL-MSUBR-NAME .OUTCHAN>
+	       <PRINC " " .OUTCHAN>)>
+	<PRINC "#IMSUBR [" .OUTCHAN>
+	<COND (,BOOT-MODE <PRINT-HEX-CODE .OUTCHAN>)
+	      (ELSE <PRINT-NHEX-CODE .OUTCHAN>)>
+	<PRINC !\  .OUTCHAN>
+	<PRIN1 ,INTERNAL-MSUBR-NAME .OUTCHAN>
+	<PRINC !\  .OUTCHAN>
+	<PRINT-MVEC-ELEMENTS .OUTCHAN>
+	<PRINC !\] .OUTCHAN>
+	<OR ,BOOT-MODE <PRINC ">" .OUTCHAN>>
+	<CRLF .OUTCHAN>>
+
+<GDECL (MSUBR-BUF) STRING (MSUBR-PTR) FIX>
+<DEFINE PRINT-NHEX-CODE ("OPTIONAL" (OUTCHAN .OUTCHAN) (PTR 1)
+				    (MAXPTR ,FBYTE-OFFSET)
+				    (LEN </ <+ .MAXPTR 1> 4>))
+	#DECL ((OUTCHAN) CHANNEL (PTR MAXPTR) FIX)
+	<COND (<NOT <GASSIGNED? MSUBR-BUF>>
+	       <SETG MSUBR-BUF <ISTRING 1024>>)
+	      (<SETG MSUBR-BUF <TOP ,MSUBR-BUF>>)>
+	<SETG MSUBR-PTR 0>
+	<SETG MSUBR-CHAN .OUTCHAN>
+	<WRITE-BYTE !\|>
+	<PRINTBYTE </ .LEN 65536>>
+	<PRINTBYTE </ <MOD .LEN 65536> 256>>
+	<PRINTBYTE <MOD .LEN 256>>
+	<REPEAT (WD)
+		<COND (<L=? <+ .PTR 3> .MAXPTR>
+		       <PRINTBYTE <NTH-FCODE <+ .PTR 3>>>)
+		      (ELSE <PRINTBYTE 0>)>
+		<COND (<L=? <+ .PTR 2> .MAXPTR>
+		       <PRINTBYTE <NTH-FCODE <+ .PTR 2>>>)
+		      (ELSE <PRINTBYTE 0>)>
+		<COND (<L=? <+ .PTR 1> .MAXPTR>
+		       <PRINTBYTE <NTH-FCODE <+ .PTR 1>>>)
+		      (ELSE <PRINTBYTE 0>)>
+		<PRINTBYTE <NTH-FCODE .PTR>>
+		<COND (<G? <SET PTR <+ .PTR 4>> .MAXPTR> <RETURN>)>>
+	<WRITE-BYTE !\|>
+	<CHANNEL-OP .OUTCHAN WRITE-BUFFER <TOP ,MSUBR-BUF> ,MSUBR-PTR>>
+
+<DEFINE PRINTBYTE (NUM) 
+	#DECL ((NUM) FIX)
+	<WRITE-BYTE <ASCII <+ <ASCII !\A> <CHTYPE <LSH .NUM -5> FIX>>>>
+	<WRITE-BYTE <ASCII <+ <ASCII !\A> <CHTYPE <ANDB .NUM 31> FIX>>>>>
+
+<DEFINE WRITE-BYTE (BYTE "AUX" (S ,MSUBR-BUF))
+  #DECL ((BYTE) CHARACTER (S) STRING)
+  <COND (<EMPTY? .S>
+	 <SET S <TOP .S>>
+	 <CHANNEL-OP ,MSUBR-CHAN WRITE-BUFFER .S ,MSUBR-PTR>
+	 <SETG MSUBR-PTR 0>)>
+  <1 .S .BYTE>
+  <SETG MSUBR-BUF <REST .S>>
+  <SETG MSUBR-PTR <+ ,MSUBR-PTR 1>>>