-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathLARITH.mc
More file actions
403 lines (344 loc) · 15.5 KB
/
Copy pathLARITH.mc
File metadata and controls
403 lines (344 loc) · 15.5 KB
1
: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 opLRSH1regOP1[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 opLRSH1regOP1[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 happensregOP1[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 quotientregOP1[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 remainderregOP1[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 TregOP1[361, StackM2BR, opIGREATERP, noNData]; * IGREATERP*--------------------------------------------------------------------* Generic arithmetic entries*--------------------------------------------------------------------regOP1[324, StackM2BR, opIPLUS2, noNData]; * PLUSregOP1[325, StackM2BR, opIDIFFERENCE, noNData]; * DIFFERENCEregOP1[326, StackM2BR, opITIMES2, noNData]; * TIMESregOP1[327, StackM2BR, opIQUOTIENT, noNData]; * QUOTIENTregOP1[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 typePAGEFAULTOK; 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 typePAGEFAULTOK; 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 typePAGEFAULTOK; T_ (FETCH_ LTEMP3) + 1;* End of subroutine T_ MD, fetch_ T, LTEMP4_ Q; * Kludge for .STOREBOXPAGEFAULTNOTOK; Q_ Md; * Q_ lo.word of A, and memBase_ StackBR, branch[.ubxBothdone]; * restore memBaseTOP 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];