:Title[LARITH];
*
* Edit History
* February 2, 1984  10:06 AM, JonL, fix all CallUFN's to be alone 
*		on line (permits new def of CallUFN)
* January 13, 1984  10:44 PM, JonL, spawned this file off LOW.mc
* January 12, 1984  12:22 AM, JonL, fix wrong-parity branches at
*		 .unboxB1 and .unboxA1, and straighten out mess at .unboxAcl
* January 6, 1984  8:16 AM, JonL, fixed .BOX2 and .BOX to account for
*		TSP height when tailing into TL.CREATECELL
* January 5, 1984  1:02 AM, JonL, fixed bug caused by no comments in
*		kludgy .STOREBOX code!
* January 4, 1984  7:08 PM, JonL, added label TL.GREATERP for
*		 opFGREATERP to use.
* January 3, 1984  10:59 PM, JonL, Mucked with .UNBOX* some more,
*		finding several bugs
* December 30, 1983  4:53 PM JonL& Masinter, fix TSP on entry to
*		TL.CREATECELL, fix TT.** in .UNBOX2
* December 29, 1983  8:42 PM, JonL, added opMAKENUMBER
* December 29, 1983  12:21 PM, JonL, Re-format some (flushing CR's), 
*		add .numfail as a place to UFN out rather than .unboxfail; fix bug
* 		of LRSH sometimes entering .BOX with ALU bad branch conditions
* December 27, 1983  9:50 PM, JonL, let .BOX tail into TL.CREATECELL
*		instead of punting out; cleanup .UNBOX2 to flush TT.*** bits etc.
* 		Used symbolic (sub[SmallNeg!, SmallHi!]c) instead of 1 in .unbox.
* December 26, 1983  6:46 PM, JonL, moved opEQ and opNOP to LOPS;
* December 26, 1983  1:22 PM, JonL, LLSH and LRSH use LCY and RCY;
*		cause .UNBOX* to flush TT.*** bits from type table 
* December 21, 1983  5:08 AM, JonL, Move opSWAP to LSTACK, opGCSCAN to
* 		LGC, opRCLK to LOPS.
*   - - -                   , Masinter

   TOP LEVEL;
   knowrbase[LTEMP0];
   InsSet[LispInsSet, 1];


*--------------------------------------------------------------------
opLOGAND2:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX2];
   LTEMP1_ (LTEMP1) and Q;
   LTEMP0_ (LTEMP0) and T, branch[.BOX2];

regOP1[345, StackM2BR, opLOGAND2, noNData];

*--------------------------------------------------------------------
opLOGOR2:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX2];
   LTEMP1_ (LTEMP1) or Q;
   LTEMP0_ (LTEMP0) or T, branch[.BOX2];

regOP1[344, StackM2BR, opLOGOR2, noNData];

*--------------------------------------------------------------------
opLOGXOR2:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX2];
   LTEMP1_ (LTEMP1) xor Q;
   LTEMP0_ (LTEMP0) xor T, branch[.BOX2];

regOP1[346, StackM2BR, opLOGXOR2, noNData];


*--------------------------------------------------------------------
opLLSH1:	* Replace TOS with fixp shifted left one
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX1];
   LTEMP1_ (LTEMP1) + (LTEMP1);
   LTEMP0_ T + T, XorSavedCarry, branch[.BOX];

regOP1[340, StackM2BR, opLLSH1, noNData];

*--------------------------------------------------------------------
opLRSH1:	* Replace TOS with fixp shifted right one
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX1];
	LTEMP1 _ RCY[T,LTEMP1,1];
		* Masking may cause a false "No" answer to the alu=0 question in 
		*   .BOX, but it will recuperate by testing LTEMP0 again.
	LTEMP0 _ RSH[LTEMP0,1], branch[.BOX];

regOP1[342, StackM2BR, opLRSH1, noNData];

*--------------------------------------------------------------------
opLRSH8:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX1];
	LTEMP1 _ RCY[T,LTEMP1,10];
	LTEMP0 _ RSH[LTEMP0,10], branch[.BOX];			* See comment at opLRSH1

regOP1[343, StackM2BR, opLRSH8, noNData];

*--------------------------------------------------------------------
opLLSH8:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX1];
	LTEMP1 _ LSH[LTEMP1,10];
	T _ Q;												* Can't specify Q in shifts
	LTEMP0 _ LCY[T,LTEMP0,10], branch[.BOX];	* See comment at opLRSH1

regOP1[341, StackM2BR, opLLSH8, noNData];



*--------------------------------------------------------------------
opIPLUS2:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
   LTEMP1_ (LTEMP1) + Q;
   LTEMP0_ (LTEMP0) + T, XorSavedCarry, branch[.BOX2];

regOP1[330, StackM2BR, opIPLUS2, noNData];	* IPLUS

*--------------------------------------------------------------------
opIDIFFERENCE:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
   LTEMP1_ (Q) - (LTEMP1);
   LTEMP0_ (T) - (LTEMP0) - 1, XorSavedCarry, branch[.BOX2];

regOP1[331, StackM2BR, opIDIFFERENCE, noNData];	* IDIFFERENCE

:if[NotReduced];

*--------------------------------------------------------------------
opBOXIPLUS:
*--------------------------------------------------------------------
	LTEMP4_ 1s;				
* When .UNBOX2 unboxes two args, it does the first one last, and leaves
*  its lo.word address LTEMP4.  That address must have the low-order bit
*	zero, since it will be a cell-aligned address.
	T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
	LTEMP1_ (LTEMP1) + Q;
	LTEMP0_ (LTEMP0) + T, XorSavedCarry, branch[.STOREBOX2];

regOP1[366, StackM2BR, opBOXIPLUS, noNData];

*--------------------------------------------------------------------
opBOXIDIFFERENCE:
*--------------------------------------------------------------------
	LTEMP4_ 1s;														* See comment above
	T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
	LTEMP1_ (Q) - (LTEMP1);
	LTEMP0_ (T) - (LTEMP0) - 1, XorSavedCarry, branch[.STOREBOX2];

regOP1[367, StackM2BR, opBOXIDIFFERENCE, noNData];

.STOREBOX2:
	Branch[.+2, R even], T_ (LTEMP4), memBase_ ScratchLZBR;
		TSP_ (TSP) + (4c), Goto[.arithpunt];	* First arg wasn't fixp type
	T_ (store_ T) + 1, dbuf_ LTEMP0;			* Smash results from LTEMP0,1
	store_ T, dbuf_ LTEMP1;						*  into the first arg's loc
	TSP_ (TSP) + (2c), NextOpCode;

:else; 	* Reduced
UfnOps[366];	UfnOps[367];					* BOXIPLUS and BOXIDIFFERENCE
:endif;


:if[NotReduced];

*--------------------------------------------------------------------
opITIMES2:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
   pd_ T or (LTEMP0);
   branch[.+2, alu=0], T_ LTEMP1;
		TSP_ (TSP) + (4c), Goto[.arithpunt];	* More than 32 bits => punt
   call[MulSub];										* T * Q -> (T, Q)
   LTEMP1_ Q;											*  MulSub is "unsigned" op
   LTEMP0_ T, branch[.BOX2];

regOP1[332, StackM2BR, opITIMES2, noNData];	* ITIMES

*--------------------------------------------------------------------
opIQUOTIENT:
*--------------------------------------------------------------------
	T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
	pd_ T or (LTEMP0);
	branch[.+2, alu=0];			* (could handle big positives)
		TSP_ (TSP) + (4c), Goto[.arithpunt];
	DivTEMP1_ LTEMP1, SCall[DivSub];							* T,,Q / DivTEMP1
		branch[.+2], TSP_ (store_ TSP) + 1, dbuf_ SmallHi;
			TSP_ (TSP) + (4c), Goto[.arithpunt];			* Failure return
	TSP_ (store_ TSP) + 1, dbuf_ Q, NextOpCode;			* Q has quotient

regOP1[333, StackM2BR, opIQUOTIENT, noNData];	* IQUOTIENT

*--------------------------------------------------------------------
opIREMAINDER:
*--------------------------------------------------------------------
	T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
	pd_ T or (LTEMP0);
	branch[.+2, alu=0];
		TSP_ (TSP) + (4c), Goto[.arithpunt];
   DivTEMP1_ LTEMP1, SCall[DivSub];							* T,,Q / DivTEMP1
		branch[.+2], TSP_ (store_ TSP) + 1, dbuf_ SmallHi;
			TSP_ (TSP) + (4c), Goto[.arithpunt];			* failure return
   TSP_ (store_ TSP) + 1, dbuf_ T, NextOpCode;			* T has remainder

regOP1[334, StackM2BR, opIREMAINDER, noNData];

:else;	* Reduced
* ITIMES, IQUOTIENT, and IREMAINDER
	UfnOps[332]; UfnOps[333]; UfnOps[334];
:endif;


*--------------------------------------------------------------------
opIGREATERP:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX2];
   pd_ T - (LTEMP0);
   branch[TL.GREATERP, alu=0], pd_ (Q) - (LTEMP1) - 1;
   T_ T xor (100000c);						* hi parts differ, so complement 
   LTEMP0_ (LTEMP0) xor (100000c);		* sign, and try again
   pd_ T - (LTEMP0) - 1;
TL.GREATERP:									* opFGREATERP also comes here
	branch[.+2, carry], TSP_ (store_ TSP) + 1, dbuf_ (atomHiVal);
		TSP_ (store_ TSP) + 1, dbuf_ AT.NIL, NextOpCode;	* push NIL
	TSP_ (store_ TSP) + 1, dbuf_ AT.T, NextOpCode;			* push T

regOP1[361, StackM2BR, opIGREATERP, noNData];	* IGREATERP

*--------------------------------------------------------------------
* Generic arithmetic entries
*--------------------------------------------------------------------
:if[Reduced];
	UfnOps[324];   UfnOps[325];							* PLUS and DIFFERENCE
	UfnOps[326];   UfnOps[327];							* TIMES and QUOTIENT
	UfnOps[334];												* REMAINDER
	UfnOps[363];												* GREATERP
:else;
regOP1[324, StackM2BR, opIPLUS2, noNData];			* PLUS
regOP1[325, StackM2BR, opIDIFFERENCE, noNData];	* DIFFERENCE
regOP1[326, StackM2BR, opITIMES2, noNData];			* TIMES
regOP1[327, StackM2BR, opIQUOTIENT, noNData];		* QUOTIENT
regOP1[363, StackM2BR, opIGREATERP, noNData];		* GREATERP
:endif;

*--------------------------------------------------------------------
opMAKENUMBER:
*--------------------------------------------------------------------
	T_ (fetch_ TSP) - 1, flipMemBase, Call[.UNBOX2];
	pd_ T or (LTEMP0);			* Ascertain that both args are SmallPosp's
	branch[.+2, alu=0];
		TSP_ (TSP) + (4c), Goto[.arithpunt];
	pd_ LTEMP0_ Q, branch[.BOX2];

regOP1[365, StackM2BR, opMAKENUMBER, noNdata];

.arithpunt:					* "Goto" here, so as to preserve Link for
	CallUFN;					*  SAVEUCODESTATE


*--------------------------------------------------------------------
SUBROUTINE;		.UNBOX1:		GLOBAL, 
*--------------------------------------------------------------------

* Enter with one argument A on top of stack
*            memBase set to StackM2BR, then do
*            T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX1];
* Exit with A hi.word in LTEMP0, T
*           A lo.word in LTEMP1, Q
*           TSP "pulled back" over the the argument
*           memBase set to StackBR
*				clobbers LTEMP2, SaveLink

   LTEMP2_ T_ Md, fetch_ T;						* Now memBase is StackBR
   LTEMP0_ T_ T - (SmallHi);
.unbox1.0:
   branch[.unbox1.1, alu#0], Q_ LTEMP1_ Md;
		* Note how the branch falls thru on SmallHi with LTEMP0 and
		*  T set to 0;  This is a "fast case" exit for SmallPosp's
	TSP_ (TSP) - (2c), return;

:if[NotReduced];

.unbox1.1:
   T_ T - (sub[SmallNeg!, SmallHi!]c);			* This "sub" had better be 1
   branch[.+2, alu#0], LTEMP0_ T_ T - 1;		* LTEMP0_ -1 in case A is a
		TSP_ (TSP) - (2c), return;					*  SmallNeg (and fast exit)
.unbox1cl:
* "A" may be stored in a cell -- check it out
	T_ LTEMP2, memBase_ tyBaseBR;	  				* Otherwise, restore T

*	Think of the following as a subroutine:
*		LTEMP2,T have hi.word, LTEMP1 has lo.word, memBase is tyBaseBr
   T_ RCY[T, LTEMP1, 11];							* Fetch the type table entry
   fetch_ T;
   T_ Md, memBase_ ScratchLZBR;
	T_ (T) and (rhmask); 							* Foo on TT.*** bits
   pd_ (T) xor (fixptype);
   branch[.+2, alu=0], BrHi_ LTEMP2;
		TOPLEVEL; CallUFN; SUBROUTINE;			* not fixp type
PAGEFAULTOK;
   T_ (FETCH_ LTEMP1) + 1;
*	This would be the subroutine exit

   LTEMP0_ T_ MD, fetch_ T;
PAGEFAULTNOTOK;
	pd_ T - T, memBase_ StackBr, Branch[.unbox1.0];

:else;
.unbox1.1: TOPLEVEL; CallUFN; SUBROUTINE;
:endif;


*--------------------------------------------------------------------
.UNBOX2: GLOBAL, 
*--------------------------------------------------------------------
*
* Enter with two arguments A and B on top of stack (B on top)
*            memBase set to StackM2BR
*            T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
* Exit with  A hi.word in T
*            A lo.word in Q
*            B hi.word in LTEMP0
*            B lo.word in LTEMP1
*            TSP "pulled back" over both A and B,  LEFT_ LEFT - 1
*            memBase set to StackBR
*				clobbers LTEMP2, LTEMP3, LTEMP4 and SaveLink

   LTEMP0_ Md, T_ (fetch_ T) - (3c);					 * LTEMP0_ Bhi
   LTEMP1_ Md, T_ (fetch_ T) + 1;						 * LTEMP1_ Blo
	LTEMP0_ (LTEMP0) - (SmallHi);							 * LTEMP0_ Bhi-SmallHi

:if[NotReduced];

.unboxB:															 * B is unboxed first
	Branch[.unboxB1, alu#0], LTEMP3_ Md, fetch_ T;	 * LTEMP3_ Ahi (unbox)
		T_ (LTEMP3) - (SmallHi), branch[.unboxA];		 * B done if SmallPosp
.unboxB1:
	LTEMP0_ (LTEMP0) - (sub[SmallNeg!, SmallHi!]c); * LTEMP0_ -1 if B is
	branch[.+2, alu#0], LTEMP0_ (LTEMP0) - 1;			 *  a SmallNeg
		T_ (LTEMP3) - (SmallHi), branch[.unboxA];		 * B done if SmallNeg
	Branch[.unboxBcl], Q_ Md, LEFT_ (LEFT) + 1; 		 * Q_ Alo word 

.unboxA:															 * pd has Ahi-SmallHi
	DblBranch[.ubxBothdone, .unboxA1, alu=0],			 * A done if SmallPosp
								 Q_ Md, LEFT_ (LEFT) + 1;	 * Q_ Alo word
.ubxBothdone:
   TSP_ (TSP) - (4c), return;

.unboxA1:
	T_ T - (sub[SmallNeg!, SmallHi!]c);					 * T_ -1 if A is
	branch[.unboxAcl, alu#0], T_ T - 1;					 *  SmallNeg
		TSP_ (TSP) - (4c), return;							 * A done if SmallNeg

.unboxBcl:
*  "B" may be stored in a cell -- check it out.
	T_ (LTEMP0) + (add[SmallNeg!, 1]c);					 * Restore Bhi & 
	LTEMP2_ T, memBase_ tyBaseBR;							 *  put in T & LTEMP2

* This could be a subroutine
	T_ RCY[T, LTEMP1, 11];
	fetch_ T;
	T_ Md, memBase_ ScratchLZBR;
	T_ T and (rhmask);										* flush TT.*** bits
	pd_ (T) xor (fixptype);
	branch[.+2, alu=0], BrHi_ LTEMP2;
		TOPLEVEL; CallUFN; SUBROUTINE;					* not fixp type
PAGEFAULTOK;
   T_ (FETCH_ LTEMP1) + 1;
* This would be the end of the subroutine

   fetch_ T, LTEMP0_ MD;
PAGEFAULTNOTOK;
	T_ (LTEMP3) - (SmallHi);								 * Unbox Ahi, and
	DblBranch[.ubxBothdone, .unboxA1, alu=0],			 * re-join code to
					LTEMP1_ Md, memBase_ StackBR; 		 * finish unboxing "A"


.unboxAcl:
*  "A" may be stored in a cell -- check it out.
	LTEMP2_ T_ LTEMP3;										* LTEMP2_ Ahi, freeing
	LTEMP3_ Q, memBase_ tyBaseBR;							*  LTEMP3 

* This would be the subroutine
	T_ RCY[T, LTEMP3, 11];
	fetch_ T;
	T_ Md, memBase_ ScratchLZBR;
	T_ (T) and (rhmask);										* flush TT.*** bits
	pd_ (T) xor (fixptype);
	branch[.+2, alu=0], BrHi_ LTEMP2;
		TOPLEVEL; CallUFN; SUBROUTINE;					* not fixp type
PAGEFAULTOK;
   T_ (FETCH_ LTEMP3) + 1;
* End of subroutine

   T_ MD, fetch_ T, LTEMP4_ Q;							* Kludge for .STOREBOX 
PAGEFAULTNOTOK;
   Q_ Md; 														* Q_ lo.word of A, and
   memBase_ StackBR, branch[.ubxBothdone]; 			*  restore memBase 


:else; * Reduced

.unboxB:	
	Branch[.+2, alu=0],T_ Md, fetch_ T;					 * T_ Ahi
		TOPLEVEL; CallUFN; SUBROUTINE;					 * B not SmallPosp
	T_ T - (SmallHi);
	Branch[.+2, alu=0], Q_Md, LEFT_ (LEFT) + 1;		 * Q_ Alo
		TOPLEVEL; CallUFN; SUBROUTINE;
	TSP_ (TSP) - (4c), Return;

:endif; 

TOP LEVEL;

*--------------------------------------------------------------------
* BOX results	* Make a fixp of result in LTEMP0,,LTEMP1
*--------------------------------------------------------------------
:if[NotReduced];

.BOX2:
	branch[.+2, alu=0], NARGS_ (2c);						* NARGS "adjusts" TSP 
		pd_ (LTEMP0) + 1, Branch[.box.1]; 				*  in CreateCell (cant
	T_ (store_ TSP) + 1, dbuf_ SmallHi;					*  punt or fault when
.BOXretsmp:														*  TSP is wrong)
	TSP_ (store_ T) + 1, dbuf_ LTEMP1, NextOpCode;	* Easy, when SMALLP

.BOX: GLOBAL,
* Enter with Hi word in LTEMP0 (and generally on Pd -- see "ALU" below)
*            Lo word in LTEMP1
*				 memBase is StackBR
* 		and with TSP "pulled back" over inputs, and LEFT decremented by 1

	branch[.+2, alu=0], NARGS_ T - T; 
		pd_ (LTEMP0) + 1, Branch[.box.1]; 
	* Trivial, if result is a non-negative SMALLP
	T_ (store_ TSP) + 1, dbuf_ SmallHi, Branch[.BOXretsmp];

.box.1:															* Check for negative 
	branch[.+2, alu#0], pd_ CELLHINUM_ LTEMP0; 		*  smallp's too
		T_ (store_ TSP) + 1, dbuf_ SmallNegHi, 
								Branch[.BOXretsmp];
	branch[.+2, alu#0], CELLLONUM_ LTEMP1;				* Check hi.word again  
		T_ (store_ TSP) + 1, dbuf_ SmallHi, 			* Shift masking can => 
								Branch[.BOXretsmp];			* false non-0 alu test 

*	Since TSP was "pulled back" upon entry, it must be restored.  So add
*  4 in the case of .BOX2 (4 words for 2 args), or 2 for .BOX
	T_ (NARGS) + 1, membase_ dtdBR;
	TSP_ (TSP) + T + 1;
	T_ (LShift[fixpType!, 4]c), branch[TL.CREATECELL];


:else;

.BOX2:	
* If this code were to CallUFN, it would have to know exactly how many 
* 	args were originally passed in, in order to un-"pull-back" the stack. 
*	Hence .BOX2 for 2 args, and .BOX for 1
.BOX:	
	branch[.box1b, alu#0];
		.box1a:
			T_ (store_ TSP) + 1, dbuf_ SmallHi;
			TSP_ (store_ T) + 1, dbuf_ LTEMP1, NextOpCode;
.box1b:
	pd_ LTEMP0;
	Branch[.+2, alu#0];		* Check hi.word once more -- ALU problems on 
		Branch[.box1a];		*  LRSH might have it wrong upon entry	
	LTEMP3_ T, T_ Link, Call[SAVEUCODESTATE];	
	memBase_ StackBR;
	T_ (store_ TSP) + 1, dbuf_ SmallHi;			* This punt code just calls
	T_ (store_ T) + 1, dbuf_ LTEMP0;				*  MAKENUMBER
	T_ (store_ T) + 1, dbuf_ SmallHi;
	TSP_ (store_ T) + 1, dbuf_ LTEMP1;
	DEFLO_ AT.MAKENUMBER, Goto[2ARGPUNT]; 

:endif; 
(635)\f8 11069f0 1f8