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