:Title[LARITH];
**Edit History
* 7-Jul-85 10:56:18, masintermake sure (TIMES max.smallp max.smallp) punts
* March 29, 1985  11:09 AM, Masinter, reformatting
* March 13, 1985  9:44 AM, Masinter, Remove call to SAVEUCODESTATE
* January 5, 1985 10:45 PM, JonL, Add overflow check opIPLUS2, opIDIFFERENCE
* 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[.ovchk];
.ovchk:
   branch[.BOX2, overflow'], pd_ LTEMP0;	* test for overflow, & punt
   TSP_ (TSP) + (4c), CallUFN;	*  if it happens

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

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

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

*--------------------------------------------------------------------
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 in opBOXIPLUS
   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), CallUFN;	* 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;

*--------------------------------------------------------------------
opITIMES2:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) - 1, flipMemBase, call[.UNBOX2];
   pd_ T or (LTEMP0);
   branch[.+2, alu=0], T_ LTEMP1;
      TSP_ (TSP) + (4c), CallUFN;	* More than 32 bits => punt
   call[MulSub], NARGS_ (2c);	* T * Q -> (T, Q)
   CELLHINUM_ pd_ T;
   branch[.+2, alu#0], FreezeBC, LTEMP1_ Q;
      T_ (store_ TSP) + 1, dbuf_ SmallHi, branch[.BOXretsmp];
   branch[.+2, alu>0], CELLLONUM_ Q;
      TSP_ (TSP) + (4c), CallUFN;	* high bit on, punt (full 32 bit ans)
   T_ (NARGS) + 1, membase_ dtdBR, branch[.boxtail];

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), CallUFN;
   DivTEMP1_ LTEMP1, SCall[DivSub];	* T,,Q / DivTEMP1
   	branch[.+2], TSP_ (store_ TSP) + 1, dbuf_ SmallHi;
   	TSP_ (TSP) + (4c), CallUFN;	* 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), CallUFN;
   DivTEMP1_ LTEMP1, SCall[DivSub];	* T,,Q / DivTEMP1
   	branch[.+2], TSP_ (store_ TSP) + 1, dbuf_ SmallHi;
   	TSP_ (TSP) + (4c), CallUFN;	* failure return
   TSP_ (store_ TSP) + 1, dbuf_ T, NextOpCode;	* T has remainder

regOP1[334, StackM2BR, opIREMAINDER, noNData];


*--------------------------------------------------------------------
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
*--------------------------------------------------------------------
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

*--------------------------------------------------------------------
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), CallUFN;
   pd_ LTEMP0_ Q, branch[.BOX2];

regOP1[365, StackM2BR, opMAKENUMBER, noNdata];

*--------------------------------------------------------------------
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;

.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];

*--------------------------------------------------------------------
.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

.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

TOP LEVEL;
*--------------------------------------------------------------------
* BOX results	* Make a fixp of result in LTEMP0,,LTEMP1
*--------------------------------------------------------------------
.BOX2:
   branch[.+2, alu=0], NARGS_ (2c);  * NARGS "adjusts" TSP in CreateCell
     pd_ (LTEMP0) + 1, Branch[.box.1];
   T_ (store_ TSP) + 1, dbuf_ SmallHi;
.BOXretsmp:
   TSP_ (store_ T) + 1, dbuf_ LTEMP1, NextOpCode; * Easy, when SmallPosP

* 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

.BOX:	branch[.+2, alu=0], NARGS_ A0;
   	pd_ (LTEMP0) + 1, Branch[.box.1];  * easy when SmallPosP
   T_ (store_ TSP) + 1, dbuf_ SmallHi, Branch[.BOXretsmp];

.box.1:	* Check for negative smallps too
   branch[.+2, alu#0], pd_ CELLHINUM_ LTEMP0;
     T_ (store_ TSP) + 1, dbuf_ SmallNegHi, Branch[.BOXretsmp];
.box.1.fixp:
   branch[.+2, alu#0], CELLLONUM_ LTEMP1;	* Check hi.word again
   T_ (store_ TSP) + 1, dbuf_ SmallHi, Branch[.BOXretsmp];

* Shift masking can => 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;
.boxtail:
   TSP_ (TSP) + T + 1;
   T_ (LShift[fixpType!, 4]c), branch[TL.CREATECELL];