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