"CODE IS STORED IN A LIST OF UVECTORS.  EACH INSTRUCTION IS A FIX.  THE
 INSTRUCTION CONTAINS THE INSTRUCTION BYTE (8 BITS) + INFORMATION TO FIX UP THE
 INSTRUCTION.  WHEN AN INSTRUCTION DOES NOT FIT INTO A SINGLE FIX IT IS
 FOLLOWED BY ADDITIONAL FIXES.  EVERY INSTRUCTION TAKES UP AN INTEGER NUMBER OF
 FIXES EVEN THOUGH THE OUTPUT VERSION MAY BE DIFFERENT.  THERE IS A TEMPORARY 
 FIXUP TABLE WHICH IS USED TO DETERMINE THE LOCATION OF THE TEMPORARIES AND
 ALSO A LABEL FIXUP TABLE TO KEEP TRACK OF THE LABELS.  THE SYSTEM ATTEMPTS
 TO FIX UP LABELS IN PARTICULAR INTERVALS SO THAT IT DOESN'T HAVE TO KEEP
 TRACK OF TOO MANY LABELS.  ANY NON-LOOPING LABELS WILL BE FLUSHED AS SOON
 AS THEY ARE FIXED UP.  THERE IS ALSO A CONSTANT TABLE WHICH KEEPS TRACK OF
 THE LOCATION OF ALL FULL-WORD CONSTANTS.  THESE ARE FIXED UP LIKE LABELS.  IN
 GENERAL THE FIRST OCCURANCE OF A 32 BIT CONSTANT WILL BE OUTPUT AS AN
 IMMEDIATE INSTRUCTION.  ALL OTHER OCCURANCES WILL BE OUTPUT AS A REFERENCE
 TO THAT CONSTANT IN PC-RELATIVE MODE (THIS WILL BE AN OPTION.  WE MAY
 EVENTUALLY GENERATE ALL CONSTANTS IMMEDIATE IF THAT PROVES TO GENERATE
 FASTER RUNNING CODE"

<DEFINE INIT-CODE () 
	<SETG CURRENT-CODE <IUVECTOR ,CODEVEC-LENGTH 0>>
	<SETG CODE-LIST (,CURRENT-CODE)>
	<SETG CODE-COUNT 1>>

<DEFINE RESET-CODE () 
	<SETG CURRENT-CODE <1 ,CODE-LIST>>
	<SETG CODE-COUNT 1>
	<SETG SAVED-CODE-COUNT <>>
	<SETG SAVED-CODE-STACK ()>>

<DEFINE NTH-CODE (NUM "AUX" (CL ,CODE-LIST)) 
	#DECL ((NUM) FIX (CL) <LIST [REST CODEVEC]>)
	<REPEAT ((PTR .NUM))
		<COND (<L=? .PTR ,CODEVEC-LENGTH> <RETURN <NTH <1 .CL> .PTR>>)>
		<COND (<EMPTY? <SET CL <REST .CL>>>
		       <ERROR OUT-OF-BOUNDS .NUM NTH-CODE>)>
		<SET PTR <- .PTR ,CODEVEC-LENGTH>>>>

<DEFINE PUT-CODE (NUM VAL "AUX" (CL ,CODE-LIST)) 
	#DECL ((NUM VAL) FIX (CL) <LIST [REST CODEVEC]>)
	<REPEAT ((PTR .NUM))
		<COND (<L=? .PTR ,CODEVEC-LENGTH>
		       <PUT <1 .CL> .PTR .VAL>
		       <RETURN>)>
		<COND (<EMPTY? <SET CL <REST .CL>>>
		       <ERROR OUT-OF-BOUNDS .NUM>)>
		<SET PTR <- .PTR ,CODEVEC-LENGTH>>>>

<DEFINE ADD-WORD-TO-CODE (WD
			  "AUX" RLST (CCODE ,CURRENT-CODE)
				(COUNT ,CODE-COUNT))
	#DECL ((WD) FIX)
	<COND (<EMPTY? .CCODE>
	       <SET RLST
		    <REST ,CODE-LIST <- </ <- .COUNT 1> ,CODEVEC-LENGTH> 1>>>
	       <COND (<1? <LENGTH .RLST>>
		      <SET CCODE <IUVECTOR ,CODEVEC-LENGTH 0>>
		      <PUTREST .RLST (.CCODE)>)
		     (ELSE <SET CCODE <2 .RLST>>)>)>
	<PUT .CCODE 1 .WD>
	<SETG CURRENT-CODE <REST .CCODE>>
	<SETG CODE-COUNT <+ .COUNT 1>>>

<DEFINE PRINT-SPEC-LABEL (X "AUX" (OUTCHAN .OUTCHAN)) 
	#DECL ((X) SPEC-LABEL)
	<PRINC "ITAG" .OUTCHAN>
	<PRIN1 <CHTYPE .X FIX> .OUTCHAN>>

<COND (<GASSIGNED? PRINT-SPEC-LABEL> <PRINTTYPE SPEC-LABEL ,PRINT-SPEC-LABEL>)>

<DEFINE PRINT-LABEL-REF (LREF "AUX" (OUTCHAN .OUTCHAN)) 
	#DECL ((LREF) LABEL-REF)
	<PRINC "#LABEL-REF " .OUTCHAN>
	<PRIN1 <LABEL-REF-NAME .LREF> .OUTCHAN>>

<COND (<GASSIGNED? PRINT-LABEL-REF> <PRINTTYPE LABEL-REF ,PRINT-LABEL-REF>)>

<DEFINE INIT-LABEL-TABLE (RESTART "AUX" TMP LAB) 
	<SETG LABEL-TABLE ()>
	<SET LAB <CREATE-LABEL-REF \ >>
	<SET TMP <IVECTOR ,MAX-OUTST-LABELS '.LAB>>
	<SETG OUTST-LABEL-TABLE <REST .TMP <LENGTH .TMP>>>
	<AND .RESTART <SETG CURRENT-SLABEL 0>>
	<SETG PTNS-TABLE ()>
	<SETG PTNS-COUNT 1>>

<DEFINE MAKE-LABEL ("OPTIONAL" (ATM? <>) "AUX" STR 
		    (NUM <COND (<NOT <GASSIGNED? CURRENT-SLABEL>> 0)
			       (,CURRENT-SLABEL)>)) 
	<SET NUM <+ .NUM 1>>
	<SETG CURRENT-SLABEL .NUM>
	<COND (.ATM?
	       <COND (<NOT <TYPE? .ATM? STRING>> <SET ATM? "ITAG">)>
	       <SET STR <STRING .ATM? <UNPARSE .NUM>>>
	       <OR <LOOKUP .STR ,VAR-OBLIST> <INSERT .STR ,VAR-OBLIST>>)
	      (<CHTYPE .NUM SPEC-LABEL>)>>

<DEFINE COPY-PSAVE (PSAVE NCODE "AUX" RES INST) 
	#DECL ((PSAVE) PTN-SAVE (NCODE) CODEVEC)
	<SET RES
	     <CHTYPE <VECTOR .NCODE
			     <PTNS-VAR .PSAVE>
			     <PTNS-KIND .PSAVE>
			     <PTNS-USE .PSAVE>
			     ()>
		     PTN-SAVE>>
	<PUT .PSAVE ,PTNS-SUBS (.RES !<PTNS-SUBS .PSAVE>)>
	<SETG PTNS-TABLE (.RES !,PTNS-TABLE)>
	<SET INST <PUT-RHW ,INST-PSTORE ,PTNS-COUNT>>
	<SETG PTNS-COUNT <+ ,PTNS-COUNT 1>>
	.INST>

<DEFINE KILL-PSAVE (PSAVE) 
	#DECL ((PSAVE) PTN-SAVE)
	<PUT .PSAVE ,PTNS-USE <>>
	<MAPF <> <FCN (SPS) <PUT .SPS ,PTNS-USE <>>> <PTNS-SUBS .PSAVE>>>

<DEFINE EMIT-POTENTIAL-STORE (CODE KIND LVAR "AUX" PTN) 
	#DECL ((CODE) CODEVEC (KIND) ATOM (LVAR) LINKVAR)
	<SET PTN
	     <CHTYPE <VECTOR .CODE <LINKVAR-VAR .LVAR> .KIND T ()> PTN-SAVE>>
	<SETG PTNS-TABLE (.PTN !,PTNS-TABLE)>
	<ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-PSTORE 24>
				       ,PTNS-COUNT>
				  FIX>>
	<SETG PTNS-COUNT <+ ,PTNS-COUNT 1>>
	<MAPF <>
	      <FCN (XREF "AUX" (CPSAVE <XREF-INFO-PSAVES .XREF>))
		   <PUT .XREF ,XREF-INFO-PSAVES (.PTN !.CPSAVE)>>
	      <LINKVAR-POTENTIAL-SAVES .LVAR>>>

<DEFINE GET-PTNS (NUM) <NTH ,PTNS-TABLE <- ,PTNS-COUNT .NUM>>>

<DEFINE SAVE-XREF-AC-INFO (XREF SSTATE SLSTATE) 
	#DECL ((XREF) XREF-INFO (SSTATE) AC-STATE (SLSTATE) SLOAD-STATE)
	<PUT .XREF ,XREF-INFO-SAVED-AC-INFO .SSTATE>
	<PUT .XREF ,XREF-INFO-SLSTATE .SLSTATE>>

<DEFINE PRINT-XREF-INFO (XREF "AUX" (OUTCHAN .OUTCHAN)) 
	#DECL ((XREF) XREF-INFO)
	<PRINC "#XREF-INFO " .OUTCHAN>
	<PRIN1 <LABEL-REF-NAME <XREF-INFO-LABEL .XREF>> .OUTCHAN>
	<PRINC " " .OUTCHAN>
	<PRIN1 <XREF-INFO-POINT .XREF> .OUTCHAN>>

<COND (<GASSIGNED? PRINT-XREF-INFO> <PRINTTYPE XREF-INFO ,PRINT-XREF-INFO>)>

"UPDATE THE LABEL TABLES FOR A BRANCH"

<DEFINE UPDLT-BRANCH (LABEL CODEPTR STATUS? LILEN FORCEL?
		      "AUX" NLREF (OUTST ,OUTST-LABEL-TABLE) XREF)
	#DECL ((LABEL) <OR ATOM SPEC-LABEL> (CODEPTR) FIX (FORCEL?) BOOLEAN)
	<SET NLREF <GET-LREF .LABEL>>
	<ADD-XREF .NLREF .CODEPTR .STATUS? .LILEN .FORCEL?>>

<DEFINE GET-LREF GL (LABEL "OPTIONAL" (JUST-LOOKING? <>) "AUX" NLR)
  #DECL ((LABEL) <OR ATOM SPEC-LABEL>)
  <MAPF <>
    <FUNCTION (LREF)
      #DECL ((LREF) LABEL-REF)
      <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
	     <COND (<NOT .JUST-LOOKING?>
		    <LABEL-REF-NOT-REAL .LREF <>>)>
	     <RETURN .LREF .GL>)>>
    ,OUTST-LABEL-TABLE>
  <SET NLR <CREATE-LABEL-REF .LABEL>>
  <LABEL-REF-NOT-REAL .NLR .JUST-LOOKING?>
  <ADD-OUTSTANDING-LABEL .NLR>
  .NLR>

<DEFINE CREATE-LABEL-REF (NAME) 
	#DECL ((NAME) <OR ATOM SPEC-LABEL>)
	<CHTYPE [.NAME () -1 0 <> <> () () <>] LABEL-REF>>

<DEFINE ADD-OUTSTANDING-LABEL (LREF "AUX" (OUTST ,OUTST-LABEL-TABLE) NOUTST) 
	#DECL ((LREF) LABEL-REF)
	<COND (<==? .OUTST <TOP .OUTST>>
	       <SET NOUTST <VECGROW .OUTST ,MAX-OUTST-LABELS>>
	       <SET NOUTST <REST .NOUTST <- ,MAX-OUTST-LABELS 1>>>
	       <PUT .NOUTST 1 .LREF>
	       <SUBSTRUC .OUTST 0 <LENGTH .OUTST> <REST .NOUTST>>
	       <SETG OUTST-LABEL-TABLE .NOUTST>)
	      (ELSE
	       <SET OUTST <BACK .OUTST>>
	       <PUT .OUTST 1 .LREF>
	       <SETG OUTST-LABEL-TABLE .OUTST>)>>

"FINDS AND REMOVES A LABEL FROM THE OUTSTANDING LABEL TABLE.  THE LABEL WILL
 NOT BE REMOVED IF IT IS A LOOP LABEL"

<DEFINE REMOVE-OUTSTANDING-LABEL (LABEL "AUX" (OUTST ,OUTST-LABEL-TABLE)) 
	#DECL ((LABEL) <OR SPEC-LABEL ATOM> (OUTST) <VECTOR [REST LABEL-REF]>
	       (VALUE) <OR FALSE LABEL-REF>)
	<REPEAT ((PTR 1) LREF (LEN <LENGTH .OUTST>))
		<COND (<G? .PTR .LEN> <RETURN <>>)>
		<SET LREF <NTH .OUTST .PTR>>
		<COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
		       <COND (<OR <LABEL-REF-LOOP-LABEL .LREF>
				  <LABEL-REF-NOT-REAL .LREF>>
			      <RETURN .LREF>)
			     (<==? .PTR 1>
			      <SETG OUTST-LABEL-TABLE <REST .OUTST>>
			      <RETURN .LREF>)
			     (ELSE
			      <SUBSTRUC .OUTST 0 <- .PTR 1> <REST .OUTST>>
			      <SETG OUTST-LABEL-TABLE <REST .OUTST>>
			      <RETURN .LREF>)>)>
		<SET PTR <+ .PTR 1>>>>

"UPDATE LABEL TABLES WHEN ENCOUNTERING AN ACTUAL LABEL"

<DEFINE UPDLT-LABEL (LABEL CODEPTR LOOP?
		     "AUX" LREF (LTAB ,LABEL-TABLE)
			   (TABPTR <+ <LENGTH .LTAB> 1>))
	#DECL ((LABEL) <OR ATOM SPEC-LABEL> (CODEPTR) FIX
	       (LOOP?) <OR FALSE AC-STATE ATOM>)
	<SET LREF <REMOVE-OUTSTANDING-LABEL .LABEL>>
	<COND (<NOT .LREF>
	       <SET LREF <CREATE-LABEL-REF .LABEL>>
	       <ADD-OUTSTANDING-LABEL .LREF>)
	      (<LABEL-REF-NOT-REAL .LREF <>>)>
	<PUT .LREF ,LABEL-REF-CODE-PTR .CODEPTR>
	<PUT .LREF ,LABEL-REF-LOOP-LABEL .LOOP?>
	<COND (<EMPTY? .LTAB> <SETG LABEL-TABLE (.LREF)>)
	      (<PUTREST <REST .LTAB <- <LENGTH .LTAB> 1>> (.LREF)>)>
	<FIXUP-BRANCH-REFERENCES <LABEL-REF-XREFS .LREF> .TABPTR>
	<LABEL-REF-LIVE-VARS .LREF ()>
	<LABEL-REF-DEAD-VARS .LREF ()>
	.LREF>

<DEFINE FIXUP-BRANCH-REFERENCES (XREFS TABPTR) 
	#DECL ((XREFS) <LIST [REST XREF-INFO]> (TABPTR) FIX)
	<MAPF <>
	      <FCN (XREF "AUX" (CODPTR <XREF-INFO-POINT .XREF>) INST)
		   <SET INST
			<CHTYPE <ORB <NTH-CODE .CODPTR> .TABPTR> FIX>>
		   <PUT-CODE .CODPTR .INST>>
	      .XREFS>>

<DEFINE ADD-XREF (LREF CODPTR STATUS? LILEN FORCEL? "AUX" XREF) 
	#DECL ((LREF) LABEL-REF (CODPTR) FIX (VALUE) XREF-INFO (STATUS?) ANY
	       (LILEN) FIX (FORCEL?) BOOLEAN)
	<SET XREF
	     <CHTYPE <VECTOR .LREF
			     .CODPTR
			     <>
			     <>
			     <>
			     0
			     .STATUS?
			     .LILEN
			     ,CODE-COUNT
			     <>
			     ()
			     .FORCEL?>
		     XREF-INFO>>
	<PUT .LREF ,LABEL-REF-XREFS (.XREF !<LABEL-REF-XREFS .LREF>)>
	.XREF>

<DEFINE EMIT-BRANCH (INST LABEL STATUS? LILEN
		     "OPTIONAL" (ACNUM <>) (FORCEL? <>) (XT <>)
		     "AUX" XREF (CNT 1) LREF)
	#DECL ((INST) FIX (LABEL) <OR ATOM SPEC-LABEL> (XREF) XREF-INFO
	       (FORCEL?) BOOLEAN)
	<SET INST <CHTYPE <LSH .INST 24> FIX>>
	<SET XREF <UPDLT-BRANCH .LABEL ,CODE-COUNT .STATUS? .LILEN .FORCEL?>>
	<SET LREF <XREF-INFO-LABEL .XREF>>
	<COND (<NOT <0? <LABEL-REF-CODE-PTR .LREF>>>
	       <MAPF <>
		     <FUNCTION (TREF) 
			     <COND (<==? .TREF .LREF> <MAPLEAVE>)>
			     <SET CNT <+ .CNT 1>>>
		     ,LABEL-TABLE>
	       <SET INST <CHTYPE <ORB .INST .CNT> FIX>>)>
	<COND (.ACNUM <SET INST <CHTYPE <ORB .INST <LSH .ACNUM -8>> FIX>>)>
	<ADD-WORD-TO-CODE .INST>
	<SETG LAST-INST-LENGTH 1>
	.XREF>

<DEFINE EMIT-LABEL (LABEL LOOP?) 
	#DECL ((LABEL) <OR ATOM SPEC-LABEL> (LOOP?) <OR FALSE AC-STATE ATOM>)
	<UPDLT-LABEL .LABEL ,CODE-COUNT .LOOP?>>

"THE CONSTANT TABLE CONSISTS OF CONSTANT ADDRESS PAIRS.  THE ADDRESS MAY HAVE
 3 STATES.  IF IT IS NON-ZERO. THEN IT IS THE ADDRESS OF THE MOST RECENT 
 EMITTED VERSION OF A CONSTANT.  IF IT IS ZERO THEN IT INDICATES THAT A VERSION
 OF THE CONSTANT WILL BE EMITTED BY SOME INSTRUCTION IN THE CURRENT SUBROUTINE
 -1 IS USED BY THE SCAN PASS TO INDICATE THAT THE CONSTANT WILL HAVE BEEN
 BEEN EMITTED BY A PREVIOUS INSTRUCTION"

<DEFINE INIT-CONSTANTS () 
	<SETG CONSTANT-POINTER 1>
	<SETG CONSTANT-TABLE <IUVECTOR ,CONSTANT-TABLE-SIZE 0>>>

<DEFINE RESET-CONSTANTS () <SETG CONSTANT-POINTER 1>>

"WARNING: THIS ADDS AN ENTRY  TO THE CONSTANT TABLE  IF IT IS NOT
  ALREADY THERE.  THE INITIAL VERSION OF THIS ALGORITHM USES LINEAR
  SEARCH.  THIS MAY SLOW DOWN THE WORLD"

<DEFINE AGEN-CONST (NUM "AUX" (TAB ,CONSTANT-TABLE) NTAB) 
   #DECL ((NUM) FIX)
   <REPEAT ((PTR 1))
	   <COND
	    (<==? .PTR ,CONSTANT-POINTER>
	     <COND (<G? .PTR <LENGTH .TAB>>
		    <SET NTAB
			 <IUVECTOR <+ <LENGTH .TAB> ,CONSTANT-TABLE-INCREMENT>
				   0>>
		    <MAPR <>
			  <FCN (TAB1 TAB2) <PUT .TAB1 1 <1 .TAB2>>>
			  .TAB
			  .NTAB>
		    <SET TAB .NTAB>
		    <SETG CONSTANT-TABLE .TAB>)>
	     <PUT ,CONSTANT-TABLE .PTR .NUM>
	     <PUT ,CONSTANT-TABLE <+ .PTR 1> 0>
	     <SETG CONSTANT-POINTER <+ ,CONSTANT-POINTER 2>>
	     <RETURN .PTR>)
	    (<==? .NUM <NTH .TAB .PTR>> <RETURN .PTR>)>
	   <SET PTR <+ .PTR 2>>>>

<DEFINE INIT-PATCH-TABLE () <SETG PATCH-TABLE ()> <SETG NUM-PATCH 1>>

<DEFINE ADD-PATCH (PATCHTYPE "AUX" NPATCH INST (NUM ,NUM-PATCH)) 
	#DECL ((PATCHTYPE) ATOM)
	<SET NPATCH <CHTYPE <VECTOR ![!] .PATCHTYPE> PATCH>>
	<SETG PATCH-TABLE (.NPATCH !,PATCH-TABLE)>
	<SET INST <CHTYPE <ORB <LSH ,INST-PATCH 24> .NUM> FIX>>
	<ADD-WORD-TO-CODE .INST>
	<SETG NUM-PATCH <+ .NUM 1>>
	.NUM>

<DEFINE GET-PATCH (NUM "AUX" (TAB ,PATCH-TABLE)) 
	#DECL ((NUM) FIX (CDV) CODEVEC)
	<NTH .TAB <- <LENGTH .TAB> <- .NUM 1>>>>

<DEFINE INSERT-PATCH (NUM CDV "AUX" PATCH) 
	#DECL ((NUM) FIX (CDV) CODEVEC)
	<SET PATCH <GET-PATCH .NUM>>
	<PUT .PATCH ,PATCH-CODE .CDV>>

<DEFINE EMIT (INST "TUPLE" FIELDS) 
	<COND (<MEMQ .INST ,SPECIAL-OPS>
	       <ADD-WORD-TO-CODE
		<CHTYPE <ORB <LSH .INST 24> <ANDB .INST *7777*>> FIX>>)
	      (ELSE <REAL-EMIT .INST .FIELDS <>>)>>

<GDECL (LAST-INST-LENGTH) FIX>


<DEFINE REAL-EMIT (INST FIELDS WHERE
		   "AUX" (INST-INFO <GET-INST-INFO .INST>)
			 (NUM-OPS <CHTYPE <LSH <2 .INST-INFO> <- ,INIT-SHIFT>>
					  FIX>)
			 (SHFT 16) (FNUM 1))
   #DECL ((FNUM INST NUM-OPS SHFT) FIX (WHERE) <OR FALSE FIX>
	  (INST-INFO) <UVECTOR [3 FIX]> (FIELDS) TUPLE)
   <SET INST <CHTYPE <LSH .INST 24> FIX>>
   <COND (<NOT .WHERE> <SETG LAST-INST-LENGTH 0>)>
   <MAPF <>
	 <FCN (FLD "AUX" REG-OR-LIT EAC SIZC MODC OPREQ (NBYTES 0) IMWRD)
	      #DECL ((REG-OR-LIT EAC SIZC MODC OPREQ NBYTES IMWRD) FIX)
	      <COND (<0? .NUM-OPS>
		     <ERROR TOO-MANY-OPERANDS!-ERRORS .INST !.FIELDS>)>
	      <COND (<NOT <TYPE? .FLD EFF-ADDR LADDR>>
		     <ERROR BAD-CALL-TO-EMIT!-ERRORS .INST !.FIELDS>)>
	      <COND (<TYPE? .FLD LADDR>
		     <SET IMWRD <CHTYPE <2 .FLD> FIX>>
		     <SET FLD <CHTYPE <LSH <1 .FLD> -24> FIX>>)
		    (ELSE
		     <SET IMWRD <CHTYPE <LSH .FLD 8> FIX>>
		     ; "??? May be loser"
		     <SET FLD <CHTYPE <LSH .FLD -24> FIX>>)>
	      <SET EAC <CHTYPE <ANDB .FLD 240> FIX>>
	      <SET REG-OR-LIT <CHTYPE <ANDB .FLD 15> FIX>>
	      <COND (<N==? .EAC ,AM-INX>
		     <SET NUM-OPS <- .NUM-OPS 1>>
		     <SET OPREQ <GET-OP-INFO .FNUM .INST-INFO>>
		     <SET SIZC <CHTYPE <ANDB .OPREQ 7> FIX>>
		     <SET MODC <CHTYPE <LSH .OPREQ -3> FIX>>
		     <SET FNUM <+ .FNUM 1>>)>
	      <COND (<AND <G=? .EAC ,AM-INX>
			  <L=? .EAC ,AM-ADEC>
			  <==? .REG-OR-LIT ,NAC-PC>>
		     <ERROR CANT-INDEX-PC!-ERRORS .INST !.FIELDS>)
		    (<G=? .EAC ,AM-AINC>
		     <COND (<OR <AND <OR <==? .EAC ,AM-AINCD>
					 <AND <==? .EAC ,AM-AINC>
					      <OR <==? .SIZC ,SZ-L>
						  <==? .SIZC ,SZ-F>>>>
				     <==? .REG-OR-LIT ,NAC-PC>>
				<==? .EAC ,AM-LD>
				<==? .EAC ,AM-LDD>>
			    <SET NBYTES 4>)
			   (<OR <==? .EAC ,AM-WD>
				<==? .EAC ,AM-WDD>
				<AND <==? .EAC ,AM-AINC>
				     <==? .SIZC ,SZ-W>
				     <==? .REG-OR-LIT ,NAC-PC>>>
			    <SET NBYTES 2>)
			   (<OR <==? .EAC ,AM-BD>
				<==? .EAC ,AM-BDD>
				<AND <==? .EAC ,AM-AINC>
				     <==? .SIZC ,SZ-B>
				     <==? .REG-OR-LIT ,NAC-PC>>>
			    <SET NBYTES 1>)
			   (<AND <==? .EAC ,AM-AINC> <==? .REG-OR-LIT ,NAC-PC>>
			    <COND (<OR <==? .SIZC ,SZ-Q> <==? .SIZC ,SZ-D>>
				   <SET NBYTES 8>)
				  (<==? .SIZC ,SZ-O> <SET NBYTES 16>)
				  (ELSE <ERROR FOO!-ERRORS>)>)
			   (ELSE <SET NBYTES 0>)>)
		    (ELSE <SET NBYTES 0>)>
	      <SET INST <CHTYPE <ORB .INST <LSH .FLD .SHFT>> FIX>>
	      <COND (<L? <SET SHFT <- .SHFT 8>> 0>
		     <SET SHFT 24>
		     <COND (.WHERE
			    <PUT-CODE .WHERE .INST>
			    <SET WHERE <+ .WHERE 1>>)
			   (ELSE
			    <ADD-WORD-TO-CODE .INST>
			    <SETG LAST-INST-LENGTH <+ ,LAST-INST-LENGTH 1>>)>
		     <SET INST 0>)>
	      <REPEAT ()
		      <COND (<L? <SET NBYTES <- .NBYTES 1>> 0> <RETURN>)>
		      <SET INST
			   <CHTYPE <ORB .INST
					<LSH <ANDB .IMWRD *37700000000*>
					     <- .SHFT 24>>>
				   FIX>>
		      <SET IMWRD <CHTYPE <LSH .IMWRD 8> FIX>>
		      <COND (<L? <SET SHFT <- .SHFT 8>> 0>
			     <COND (.WHERE
				    <PUT-CODE .WHERE .INST>
				    <SET WHERE <+ .WHERE 1>>)
				   (ELSE
				    <ADD-WORD-TO-CODE .INST>
				    <SETG LAST-INST-LENGTH
					  <+ ,LAST-INST-LENGTH 1>>)>
			     <SET SHFT 24>
			     <SET INST 0>)>>>
	 .FIELDS>
   <COND (<N==? .NUM-OPS 0> <ERROR TOO-FEW-FIELDS!-ERRORS .INST !.FIELDS>)>
   <COND (<N==? .SHFT 24>
	  <COND (.WHERE <PUT-CODE .WHERE .INST> <SET WHERE <+ .WHERE 1>>)
		(ELSE
		 <ADD-WORD-TO-CODE .INST>
		 <SETG LAST-INST-LENGTH <+ ,LAST-INST-LENGTH 1>>)>)>>


<DEFINE EMIT-LABEL-WORD (LABEL "AUX" XREF LREF (INST 0) (CNT 1))
	#DECL ((LABEL) ATOM (XREF) XREF-INFO)
 	<SET XREF <UPDLT-BRANCH .LABEL ,CODE-COUNT NORMAL 1 <>>>
	<SET LREF <XREF-INFO-LABEL .XREF>>
	<COND (<NOT <0? <LABEL-REF-CODE-PTR .LREF>>>
	       <MAPF <>
		     <FUNCTION (TREF) 
			     <COND (<==? .TREF .LREF> <MAPLEAVE>)>
			     <SET CNT <+ .CNT 1>>>
		     ,LABEL-TABLE>
	       <SET INST <CHTYPE <ORB .INST .CNT> FIX>>)>
	<ADD-WORD-TO-CODE .INST>
	<SETG LAST-INST-LENGTH 1>
	.XREF>


<DEFINE BAD-MOVE (EA1 EA2 MSIZE "OPT" EXTRA "AUX" INST) 
	#DECL ((MSIZE) ATOM)
	<COND (<==? .MSIZE ZWL> <SET INST ,INST-MOVZWL>)
	      (<==? .MSIZE LONG> <SET INST ,INST-MOVL>)
	      (<==? .MSIZE WORD> <SET INST ,INST-MOVW>)
	      (<==? .MSIZE BYTE> <SET INST ,INST-MOVB>)
	      (<==? .MSIZE DOUBLE> <SET INST ,INST-MOVQ>)>
	<COND (<AND <ASSIGNED? EXTRA> .EXTRA>
	       <COND (<N==? <PRIMTYPE .EXTRA> FIX>
		      <EMIT .INST .EA1 !.EXTRA .EA2>)
		     (T
		      <EMIT .INST .EA1 .EXTRA .EA2>)>)
	      (T
	       <EMIT .INST .EA1 .EA2>)>>

<DEFINE RE-EMIT-MOVE (PTR EA1 EA2 MSIZE "AUX" INST (X <TUPLE .EA1 .EA2>)) 
	#DECL ((EA1 EA2) EFF-ADDR (MSIZE) ATOM (PTR) FIX)
	<SET PTR <- .PTR 2>>
	<COND (<==? .MSIZE LONG> <SET INST ,INST-MOVL>)
	      (<==? .MSIZE WORD> <SET INST ,INST-MOVW>)
	      (<==? .MSIZE BYTE> <SET INST ,INST-MOVB>)
	      (<==? .MSIZE DOUBLE> <SET INST ,INST-MOVQ>)>
	<REAL-EMIT .INST .X .PTR>>

"MAKE SURE CONSTANT IS CORRECT IF IMMEDIATE.  IF LONG WORD OPERATION
 SHOULD USE CONSTANT TABLE"

<DEFINE IMM-CHECK (EA SIZE "AUX" FLD NUM) 
	#DECL ((EA) EFF-ADDR (SIZE) ATOM)
	<SET FLD <GET-FIELD .EA ,EA-FIELD>>
	<COND (<==? .SIZE LONG>
	       <COND (<==? .FLD ,ADDRESS-IMM-LONG>
		      <CHTYPE <PUTBITS .EA ,EA-FIELD ,ADDRESS-IMM> EFF-ADDR>)
		     (<==? .FLD ,ADDRESS-IMM>
		      <SET NUM <EXTEND <LHW .EA>>>
		      <SET NUM <AGEN-CONST .NUM>>
		      <CHTYPE <PUT-LHW .FLD .NUM> EFF-ADDR>)
		     (.EA)>)
	      (<==? .FLD ,ADDRESS-IMM-LONG>
	       <ERROR "CANT USE LONG CONSTANT" .EA .SIZE IMM-CHECK>)
	      (.EA)>>

<DEFINE START-CODE-INSERT ("AUX" (CNT ,SAVED-CODE-COUNT)) 
	<COND (.CNT <SETG SAVED-CODE-STACK (.CNT !,SAVED-CODE-STACK)>)>
	<SETG SAVED-CODE-COUNT ,CODE-COUNT>>

<DEFINE END-CODE-INSERT ("AUX" (CCOUNT ,CODE-COUNT) RES
			       (START ,SAVED-CODE-COUNT))
	#DECL ((VALUE) CODEVEC)
	<SET RES
	     <MAPF ,UVECTOR
		   <FCN ("AUX" EL)
			<COND (<==? .CCOUNT .START> <MAPSTOP>)>
			<SET EL <NTH-CODE .START>>
			<SET START <+ .START 1>>
			<MAPRET .EL>>>>
	<SETG CODE-COUNT ,SAVED-CODE-COUNT>
	<REPEAT ((PTR ,CODE-COUNT) (CL ,CODE-LIST))
		#DECL ((CL) <LIST [REST UVECTOR]>)
		<COND (<L=? <- .PTR 1> ,CODEVEC-LENGTH>
		       <SETG CURRENT-CODE <REST <1 .CL> <- .PTR 1>>>
		       <RETURN>)>
		<COND (<EMPTY? <SET CL <REST .CL>>>
		       <ERROR OUT-OF-BOUNDS END-CODE-INSERT>)>
		<SET PTR <- .PTR ,CODEVEC-LENGTH>>>
	<COND (<EMPTY? ,SAVED-CODE-STACK> <SETG SAVED-CODE-COUNT <>>)
	      (ELSE
	       <SETG SAVED-CODE-COUNT <1 ,SAVED-CODE-STACK>>
	       <SETG SAVED-CODE-STACK <REST ,SAVED-CODE-STACK>>)>
	.RES>

<DEFINE EMIT-MOVE GM (EA1 EA2 SZ "OPT" (EXTRA <>) "AUX" TMP (ISZ .SZ) ABS TB
		      INST)
  <COND (<AND <NOT .EXTRA>
	      <TYPE? .EA1 LADDR>
	      <==? <1 .EA1> <MA-AINC ,AC-PC>>
	      <==? <LENGTH .EA1> 2>
	      <N==? .SZ ZWL>>
	 ; "Get constant back"
	 <SET TMP <CHTYPE <LREV <2 .EA1>> FIX>>
	 <IFSYS ("TOPS20"
		 ; "Do sign-extension"
		 <COND (<NOT <0? <ANDB .TMP *020000000000*>>>
			<SET TMP <PUTBITS .TMP <BITS 4 32> -1>>)>)>
	 <SET ABS <ABS .TMP>>
	 <COND (<AND <L? .TMP 256>
		     <G? .TMP -128>>
		<SET ISZ BYTE>)
	       (<AND <L? .TMP 65536>
		     <G? .TMP -32768>>
		<SET ISZ WORD>)
	       (T
		<SET ISZ LONG>)>)
	(<AND <TYPE? .EA1 EFF-ADDR>
	      <L=? <SET TMP <LREV .EA1>> *77*>
	      <G=? .TMP 0>>
	 <SET ABS .TMP>
	 <SET ISZ BYTE>)
	(T
	 ; "can't do anything here"
	 <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>
	 <RETURN T .GM>)>
  <COND (<==? .TMP 0>
	 <SET INST <COND (<==? .SZ BYTE> ,INST-CLRB)
		     (<==? .SZ WORD> ,INST-CLRW)
		     (<==? .SZ LONG> ,INST-CLRL)
		     (<==? .SZ DOUBLE> ,INST-CLRQ)>>
	 <EMIT .INST .EA2>)
	(<AND <L=? .ABS *77*>
	      <G=? .ABS 0>>
	 <SET EA1 <MA-LIT .ABS>>
	 <COND (<G? .TMP 0>
		<BAD-MOVE .EA1 .EA2 .SZ .EXTRA>)
	       (T
		<SET INST <COND (<==? .SZ BYTE> ,INST-MNEGB)
				(<==? .SZ WORD> ,INST-MNEGW)
				(<==? .SZ LONG> ,INST-MNEGL)>>
		<EMIT .INST .EA1 .EA2>)>)
	(<==? .SZ .ISZ>
	 <BAD-MOVE .EA1 .EA2 .SZ .EXTRA>)
	(T
	 <COND (<==? .ISZ BYTE>
		<SET TB ,BYTE-TAB>)
	       (<==? .ISZ WORD>
		<SET TB ,WORD-TAB>)>
	 <COND (<L? .TMP 0>
		<SET TB <1 .TB>>)
	       (T
		<SET TB <2 .TB>>)>
	 <EMIT <COND (<==? .SZ WORD> <1 .TB>)
		     (T <2 .TB>)>
	       <COND (<==? .ISZ BYTE> <MA-BYTE-IMM .TMP>)
		     (<==? .ISZ WORD> <MA-WORD-IMM .TMP>)
		     (<==? .ISZ LONG> <MA-LONG-IMM .TMP>)>
	       .EA2>)>>

<DEFINE EMIT-PUSH EP (EADDR SZ "AUX" TMP (ISZ .SZ) ABS TB) 
	#DECL ((EADDR) <OR EFF-ADDR LADDR> (SZ) ATOM (TB) VECTOR)
	<EMIT-MOVE .EADDR <MA-AINC ,AC-TP> .SZ>>

<SETG BYTE-TAB [[,INST-CVTBW ,INST-CVTWL]
		[,INST-MOVZBW ,INST-MOVZBL]]>
<SETG WORD-TAB [[0 ,INST-CVTWL]
		[0 ,INST-MOVZWL]]>

<DEFINE EMIT-POP (EADDR SZ) 
	#DECL ((EADDR) <OR AC EFF-ADDR> (SZ) ATOM)
	<COND (<TYPE? .EADDR EFF-ADDR> <EMIT-MOVE <MA-ADEC ,AC-TP> .EADDR .SZ>)
	      (ELSE <EMIT-MOVE  <MA-ADEC ,AC-TP> <MA-REG .EADDR> .SZ>)>>

<DEFINE CLEAR-PUSH ("OPTIONAL" (LENGTH LONG)) 
	<EMIT <COND (<==? .LENGTH LONG> ,INST-CLRL)
		    (<==? .LENGTH WIRD> ,INST-CLRW)
		    (<==? .LENGTH BYTE> ,INST-CLRB)
		    (<==? .LENGTH DOUBLE> ,INST-CLRQ)
		    (ELSE ,INST-CLRO)>
	      <MA-AINC ,AC-TP>>>

<DEFINE FIND-CALL-ENTRY (NAME) 
	#DECL ((NAME) ATOM)
	<MAPF <>
	      <FCN (CE)
		   <COND (<SAME-NAME? <CET-MSUBR-NAME .CE> .NAME>
			  <MAPLEAVE .CE>)>>
	      ,CALL-ENTRY-TABLE>>

<DEFINE FIND-CALL-POINT (NAME NARGS "AUX" CE) 
	#DECL ((NAME) ATOM (NARGS) FIX)
	<COND (<SET CE <FIND-CALL-ENTRY .NAME>> <FIND-ENTRY-LOC .CE .NARGS>)>>

<DEFINE FIND-ENTRY-LOC (CE NARGS "AUX" (CUV <CET-DISPATCH .CE>)) 
	#DECL ((CE) CALL-ENTRY (NARGS) FIX)
	<REPEAT ((FINAL <>))
		<AND <==? <1 .CUV> .NARGS> <RETURN <2 .CUV>>>
		<AND <==? <1 .CUV> -1> <SET FINAL <2 .CUV>>>
		<COND (<AND <==? .NARGS -1> .FINAL> <RETURN .FINAL>)
		      (<AND <==? <LENGTH .CUV> 2> <G? .NARGS <1 .CUV>>>
		       <RETURN <2 .CUV>>)
		      (<EMPTY? .CUV> <RETURN .FINAL>)>
		<SET CUV <REST .CUV 2>>>>

<DEFINE INIT-INTERNAL-ENTRYS () <SETG INTERNAL-ENTRY-TABLE ()>>

<DEFINE INIT-CALL-ENTRYS () <SETG CALL-ENTRY-TABLE ()>>

<DEFINE ADD-INTERNAL-ENTRY (NUMARGS LABEL "AUX" IE) 
	#DECL ((NUMARGS) FIX (LABEL) <OR ATOM SPEC-LABEL>)
	<MAPF <>
	      <FCN (LREF)
		   <COND (<==? <LABEL-REF-NAME .LREF> .LABEL>
			  <SET IE <CHTYPE <VECTOR .NUMARGS .LREF> INT-ENTRY>>
			  <SETG INTERNAL-ENTRY-TABLE
				(.IE !,INTERNAL-ENTRY-TABLE)>)>>
	      ,OUTST-LABEL-TABLE>>

<DEFINE UPDATE-CALL-ENTRY-TABLE (FNAME "AUX" CUV CE) 
	#DECL ((FNAME) ATOM)
	<SET CUV
	     <MAPF ,UVECTOR
		   <FCN (IE
			 "AUX"
			 (NARGS <IE-NUMBER-ARGS .IE>)
			 (LABEL <IE-LABEL-REF .IE>))
			<MAPRET .NARGS <LABEL-REF-REL-ADDR .LABEL>>>
		   ,INTERNAL-ENTRY-TABLE>>
	<SET CE <CHTYPE <VECTOR .FNAME .CUV> CALL-ENTRY>>
	<SETG CALL-ENTRY-TABLE (.CE !,CALL-ENTRY-TABLE)>
	.CE>

<SETG CALL-TABLE <IVECTOR ,CT-NUMBER-CALLS <>>>

<DEFINE RESET-CALL-TABLE () 
	<SETG CALL-POINTER 1>
	<MAPR <> <FCN (X) <PUT .X 1 <>>> ,CALL-TABLE>>

<DEFINE EMIT-CALL (FCN NUMARGS
		   "AUX" UC (CNT ,CALL-POINTER) (TAB ,CALL-TABLE) INST)
	#DECL ((FCN) ATOM (NUMARGS) FIX)
	<SET UC <CHTYPE <VECTOR .FCN .NUMARGS 0 0> UNRESOLVED-CALL>>
	<COND (<G? .CNT <LENGTH .TAB>>
	       <SETG CALL-TABLE <VECGROW ,CALL-TABLE ,CT-NUMBER-CALLS>>)>
	<PUT ,CALL-TABLE .CNT .UC>
	<SETG CALL-POINTER <+ .CNT 1>>
	<ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-CALL 24>
				       .CNT>
				  FIX>>
	T>

<DEFINE VECGROW (TAB INCR "AUX" NEWVEC) 
	#DECL ((INCR) FIX (TAB) VECTOR)
	<SET NEWVEC <IVECTOR <+ <LENGTH .TAB> .INCR>>>
	<MAPR <> <FCN (OVEC NVEC) <PUT .NVEC 1 <1 .OVEC>>> .TAB .NEWVEC>
	.NEWVEC>

<SETG PUSH-LABEL-TABLE <IVECTOR 100 <>>>

<DEFINE RESET-PUSH-LABEL-TABLE () <SETG PUSH-LABEL-COUNT 1>>

<DEFINE EMIT-PUSH-LABEL (LABEL
			 "AUX" (CNT ,PUSH-LABEL-COUNT) (TAB ,PUSH-LABEL-TABLE)
			       INST NLREF)
	#DECL ((LABEL) <OR ATOM SPEC-LABEL>)
	<SET NLREF <CREATE-LABEL-REF .LABEL>>
	<ADD-OUTSTANDING-LABEL .NLREF>
	<COND (<G? .CNT <LENGTH .TAB>>
	       <SETG PUSH-LABEL-TABLE <VECGROW .TAB 100>>)>
	<PUT ,PUSH-LABEL-TABLE .CNT .NLREF>
	<SETG PUSH-LABEL-COUNT <+ .CNT 1>>
	<ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-PUSHLAB 24> .CNT>
				  FIX>>
	T>

<SETG MOVE-LABEL-TABLE <IVECTOR 100 <>>>

<DEFINE RESET-MOVE-LABEL-TABLE () <SETG MOVE-LABEL-COUNT 1>>

<DEFINE EMIT-MOVE-LABEL (LABEL EA
			 "AUX" (CNT ,MOVE-LABEL-COUNT) (TAB ,MOVE-LABEL-TABLE)
			       INST NLREF)
	#DECL ((LABEL) <OR ATOM SPEC-LABEL>)
	<SET NLREF <CREATE-LABEL-REF .LABEL>>
	<ADD-OUTSTANDING-LABEL .NLREF>
	<COND (<G? .CNT <LENGTH .TAB>>
	       <SETG MOVE-LABEL-TABLE <VECGROW .TAB 100>>)>
	<PUT ,MOVE-LABEL-TABLE .CNT .NLREF>
	<SETG MOVE-LABEL-COUNT <+ .CNT 1>>
	<ADD-WORD-TO-CODE <CHTYPE <ORB <LSH ,INST-MOVELAB 24>
				       <LSH <ANDB .EA *37700000000*> -8>
				       .CNT> FIX>>
	T>