:Title[LOW.dmc, February 23, 1983 5:28 PM, Masinter];
TOP LEVEL;
knowrbase[LTEMP0];
InsSet[LispInsSet, 1];
*--------------------------------------------------------------------
opLLSH1: * Replace TOS with it 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 it shifted right one
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX1];
LTEMP1← (LTEMP1) rsh 1;
LTEMP0← (LTEMP0) rsh 1, branch[.+2, R even];
LTEMP1← (LTEMP1) or (100000c);
pd← LTEMP0, branch[.BOX];
regOP1[342, StackM2BR, opLRSH1, noNData];
*--------------------------------------------------------------------
opLRSH8:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX1];
LTEMP1← RSH[LTEMP1, 10];
T← LSH[LTEMP0, 10];
LTEMP1← (LTEMP1) + T;
LTEMP0← RSH[LTEMP0, 10], branch[.BOX];
regOP1[343, StackM2BR, opLRSH8, noNData];
*--------------------------------------------------------------------
opLLSH8:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX1];
LTEMP0← LSH[T, 10];
T← RSH[LTEMP1, 10];
LTEMP1← LSH[LTEMP1, 10];
LTEMP0← (LTEMP0) + T, branch[.BOX];
regOP1[341, StackM2BR, opLLSH8, noNData];
*--------------------------------------------------------------------
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];
*--------------------------------------------------------------------
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[Reduced];
UfnOps[325];
:else;
regOP1[325, StackM2BR, opIDIFFERENCE, noNData]; * DIFFERENCE
:endif;
*--------------------------------------------------------------------
opIPLUS2:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
LTEMP1← (LTEMP1) + Q;
LTEMP0← (LTEMP0) + T, XorSavedCarry, branch[.BOX2];
regOP1[330, StackM2BR, opIPLUS2, noNData]; * IPLUS
:if[Reduced];
UfnOps[324];
:else;
regOP1[324, StackM2BR, opIPLUS2, noNData]; * PLUS
:endif;
:if[Reduced];
UfnOps[366];
:else;
*--------------------------------------------------------------------
opBOXIPLUS:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
LTEMP1← (LTEMP1) + Q;
LTEMP0← (LTEMP0) + T, XorSavedCarry, branch[.STOREBOX2];
regOP1[366, StackM2BR, opBOXIPLUS, noNData];
:endif;
:if[Reduced];
UfnOps[367];
:else;
*--------------------------------------------------------------------
opBOXIDIFFERENCE:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
LTEMP1← (Q) - (LTEMP1);
LTEMP0← (T) - (LTEMP0) - 1, XorSavedCarry, branch[.STOREBOX2];
regOP1[367, StackM2BR, opBOXIDIFFERENCE, noNData];
:endif;
*--------------------------------------------------------------------
* TIMES
*--------------------------------------------------------------------
:if[Reduced];
UfnOps[332];
UfnOps[326];
:else;
opITIMES2:
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
pd← T or (LTEMP0);
branch[.+2, alu=0], T← LTEMP1;
TSP← (TSP) + (4c), branch[.unboxfail]; * can't handle 32 bit
call[MulSub]; * unsigned multiply T * Q -> (T, Q)
LTEMP1← Q;
LTEMP0← T, branch[.BOX2];
regOP1[332, StackM2BR, opITIMES2, noNData]; * ITIMES
regOP1[326, StackM2BR, opITIMES2, noNData]; * TIMES
:endif;
*--------------------------------------------------------------------
* QUOTIENT
*--------------------------------------------------------------------
:if[Reduced];
UfnOps[333];
UfnOps[327];
:else;
opIQUOTIENT:
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
pd← T or (LTEMP0);
branch[.+2, alu=0]; * (could handle big positives)
TSP← (TSP) + (4c), branch[.unboxfail]; * failure return
DivTEMP1← LTEMP1, SCall[DivSub]; * unsigned divide T,,Q by DivTEMP1
TSP← (store← TSP) + 1, dbuf← SmallHi, branch[.+2];
TSP← (TSP) + (4c), branch[.unboxfail]; * failure return
TSP← (store← TSP) + 1, dbuf← Q, NextOpCode;
regOP1[333, StackM2BR, opIQUOTIENT, noNData]; * IQUOTIENT
regOP1[327, StackM2BR, opIQUOTIENT, noNData]; * QUOTIENT
:endif;
*--------------------------------------------------------------------
* REMAINDER
*--------------------------------------------------------------------
:if[Reduced];
UfnOps[334];
:else;
opIREMAINDER:
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
pd← T or (LTEMP0);
branch[.+2, alu=0];
TSP← (TSP) + (4c), branch[.unboxfail]; * failure return
DivTEMP1← LTEMP1, SCall[DivSub]; * unsigned divide T,,Q by DivTEMP1
TSP← (store← TSP) + 1, dbuf← SmallHi, branch[.+2];
TSP← (TSP) + (4c), branch[.unboxfail]; * failure return
TSP← (store← TSP) + 1, dbuf← T, NextOpCode; * T = remainder
regOP1[334, StackM2BR, opIREMAINDER, noNData];
:endif;
*--------------------------------------------------------------------
opIGREATERP:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
pd← T - (LTEMP0);
branch[.ig2, alu=0], pd← (Q) - (LTEMP1) - 1;
* hi parts differ
T← T xor (100000c);
LTEMP0← (LTEMP0) xor (100000c); * complement sign
pd← T - (LTEMP0) - 1;
.ig2:
branch[.+2, carry], TSP← (store← TSP) + 1, dbuf← 0c;
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
:if[Reduced]; UfnOps[363];
:else;
regOP1[363, StackM2BR, opIGREATERP, noNData]; * GREATERP
:endif;
*--------------------------------------------------------------------
opSWAP:
*--------------------------------------------------------------------
T← (TSP) - 1;
T← (fetch← T) - 1;
LTEMP1← Md, T← (fetch← T) - 1;
LTEMP0← Md, T← (fetch← T) - 1;
LTEMP2← Md, fetch← T;
LTEMP0← Md, T← (store← T) + 1, dbuf← LTEMP0;
T← (store← T) + 1, dbuf← LTEMP1;
T← (store← T) + 1, dbuf← LTEMP0;
store← T, dbuf← LTEMP2, NextOpcode;
regOP1[375, StackBR, opSWAP, noNData];
*--------------------------------------------------------------------
opEQ:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase;
LTEMP0← Md, T← (fetch← T) - (3c);
LTEMP1← Md, T← (fetch← T) + 1;
T← Md, TSP← (fetch← T) - 1;
T← Md, pd← T xor (LTEMP0);
branch[.+2, alu=0], pd← (T) xor (LTEMP1);
LEFT← (LEFT) + 1, branch[.neq];
branch[.neq, alu#0], LEFT← (LEFT) + 1;
TSP← (store← TSP) + 1, dbuf← 0c;
TSP← (store← TSP) + 1, dbuf← AT.T, NextOpCode;
.neq:
TSP← (store← TSP) + 1, dbuf← 0c;
TSP← (store← TSP) + 1, dbuf← 0c, NextOpCode;
regOP1[360, StackM2BR, opEQ, noNData];
*--------------------------------------------------------------------
opNOP:
*--------------------------------------------------------------------
NextOpcode;
regOP1[376, ifuBR, opNOP, noNData];
*--------------------------------------------------------------------
opBLT: * (destinationaddr sourceaddr nwords)
*--------------------------------------------------------------------
* Move nwords from source to destination. If nwords < tbd,
* then operation is uninterruptable, else must be prepared to
* service interrupts. On page fault or interrupt, update
* stack according to how much is moved, and back up pc.
* Result is unspecified. Behavior if source and destination
* overlap is unspecified
T← (fetch← TSP) + 1;
LTEMP0← Md, T← (fetch← T) - (2c);
pd← (LTEMP0) xor (SmallHi);
branch[.+2, alu=0], LTEMP2← Md, T← (fetch← T) - 1;
CallUFN;
LTEMP1← Md, T← (fetch← T) - 1;
LTEMP0← Md, T← (fetch← T) - 1;
LTEMP3← Md, fetch← T, pd ← T← (LTEMP2);
branch[.+2, alu#0], LTEMP2← Md, memBase← BBDSTBR, T← T - 1;
branch[.bltdone]; * no words to copy
Cnt← T; * number of words to transfer - 1
BRHi← LTEMP2;
BRLo← LTEMP3;
memBase← BBSRCBR;
BRHi← LTEMP0;
BRLo← LTEMP1;
* and now for the loop. This should really keep state in Stack a la BITBLT:
PAGEFAULTOK;
FETCH← T, flipMemBase;
T← (store← T) - 1, dbuf← MD, flipMembase, branch[.-1, Cnt#0&-1];
PAGEFAULTNOTOK;
.bltdone:
Left← (Left) + (2c);
TSP← (TSP) - (4c), NextOpCode;
regOP1[304, StackM2BR, opBLT, noNData];
*--------------------------------------------------------------------
opGETBASEN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, fetch← T;
LTEMP0← Md, memBase← ScratchLZBR;
BrHi← T;
PAGEFAULTOK;
IFETCH← LTEMP0;
memBase← StackM2BR;
T← MD, TSP← (store← TSP) + 1, dbuf← SmallHi;
PAGEFAULTNOTOK;
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;
regOP2[310, StackM2BR, opGETBASEN, noNData];
*--------------------------------------------------------------------
opGETBASEPTRN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, fetch← T, LTEMP1← (rhmask);
LTEMP0← Md, memBase← ScratchLZBR;
BrHi← T;
PAGEFAULTOK;
LTEMP0← (IFETCH← LTEMP0) + 1;
T← MD, ifetch← LTEMP0;
PAGEFAULTNOTOK;
T← T and (LTEMP1), memBase← StackM2BR;
T← Md, TSP← (store← TSP) + 1, dbuf← T;
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;
regOP2[311, StackM2BR, opGETBASEPTRN, noNData];
*--------------------------------------------------------------------
opGETBASE32N:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, fetch← T;
LTEMP0← Md, memBase← ScratchLZBR;
BrHi← T;
PAGEFAULTOK;
LTEMP0← (IFETCH← LTEMP0) + 1;
T← MD, ifetch← LTEMP0;
PAGEFAULTNOTOK;
memBase← StackM2BR;
T← Md, TSP← (store← TSP) + 1, dbuf← T;
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;
regOP2[313, StackM2BR, opGETBASE32N, noNData];
*--------------------------------------------------------------------
opGETBITS:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, fetch← T;
LTEMP0← Md, memBase← ScratchLZBR;
BrHi← T;
PAGEFAULTOK;
IFETCH← LTEMP0, TisID;
memBase← StackM2BR;
LTEMP0← MD, RF← Id;
PAGEFAULTNOTOK;
T← ShiftLMask[LTEMP0], memBase← StackM2BR;
TSP← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;
regOP3[312, StackM2BR, opGETBITS, noNData];
*--------------------------------------------------------------------
opGETBASEBYTE:
*--------------------------------------------------------------------
T← (TSP) - 1;
T← (fetch← T) - 1;
LTEMP0← Md, T← (fetch← T) - 1; * LTEMP0← offset
LTEMP1← Md, T← (fetch← T) - 1;
LTEMP1← Md, pd← (LTEMP1) xor (SmallHi);
branch[.+2, alu=0], fetch← T;
CallUFN;
memBase← LScratchBR;
LTEMP1← Md, BrLo← LTEMP1;
BrHi← LTEMP1, call[DOGETBYTE];
memBase← StackBR, LEFT← (LEFT) + 1;
T← (store← T) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP0, NextOpCode;
regOP1[302, StackBR, opGETBASEBYTE, noNData];
SUBROUTINE;
*--------------------------------------------------------------------
* DOGETBYTE: * called by BIN, GETBASEBYTE
*--------------------------------------------------------------------
* assumes current memBase is pointer, LTEMP0 is byte offset
* returns byte in LTEMP0
DOGETBYTE:
dblbranch[.gbev, .gbod, R even], LTEMP0← (LTEMP0) rsh 1;
.gbev:
PAGEFAULTOK;
FETCH← LTEMP0;
LTEMP0← MD;
PAGEFAULTNOTOK;
LTEMP0← RSH [LTEMP0, 10], return;
.gbod:
PAGEFAULTOK;
FETCH← LTEMP0;
LTEMP0← MD;
PAGEFAULTNOTOK;
LTEMP0← (LTEMP0) AND (rhmask), return;
TOP LEVEL;
*--------------------------------------------------------------------
opRCLK:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
LTEMP0← Md, fetch← T, T← (30c);
LTEMP1← Md, memBase← MDS;
T← T + (400c);
taskingOff;
fetch← T; * fetch word 430 for hi part of clock
LTEMP2← Md, rbase← rbase[RTClock];
T← RTClock;
taskingOn; * turn on tasking again;
rbase← rbase[LTEMP0];
memBase← ScratchLZBR;
BrHi← LTEMP0;
PAGEFAULTOK;
LTEMP1← (store← LTEMP1) + 1, dbuf← Md;
PAGEFAULTNOTOK;
store← LTEMP1, dbuf← T, nextOpCode;
regOP1[167, StackM2BR, opRCLK, noNData];
*--------------------------------------------------------------------
* scan GC tables
*--------------------------------------------------------------------
:if[Reduced];
UfnOps[173];
UfnOps[174];
:else;
opGCSCAN1:
T← (TSP) - 1;
fetch← T, LTEMP0← (-2c), branch[.gcscan];
opGCSCAN2:
T← (TSP) - 1;
fetch← T, LTEMP0← (HTSTKBIT), branch[.gcscan];
.gcscan:
LTEMP1← Md, memBase← htMainBR;
LTEMP1← (LTEMP1) - 1, Q← LTEMP1;
.gcscanlp:
branch[.gcscanfail, R<0], LTEMP1;
LTEMP1← (fetch← LTEMP1) - 1, Q← LTEMP1;
LTEMP2← Md, T← LTEMP0;
branch[.+2, R even], pd← (LTEMP2) and T;
memBase← StackBR, TSP← (TSP) - 1, branch[.gcfoundret];
branch[.gcscanlp, alu=0], pd← T;
dblbranch[.gcfound1, .gcfound2, alu<0], pd← (LTEMP2) and (HTSTKCNT);
.gcfound1:
branch[.gcfoundret, alu=0], memBase← StackBR, TSP← (TSP) - 1;
memBase← htMainBR, TSP← (TSP) + 1, branch[.gcscanlp];
.gcfound2:
LTEMP2← (LTEMP2) and not T, memBase←htMainBR; * turn off stkbit
T← (LTEMP2) and (HTSTKCNT);
T← T - (HT1CNT);
branch[.+2, alu#0];
store← Q, dbuf← T, branch[.gcscanlp]; * ref cnt went to 1
store← Q, dbuf← LTEMP2, branch[.gcscanlp]; * restore word
.gcfoundret:
TSP← (store← TSP) + 1, dbuf← Q, NextOpCode;
.gcscanfail:
memBase← StackBR, T← (TSP) - 1;
T← (store← T) - 1, dbuf← 0c;
store← T, dbuf← 0c, NextOpCode;
regOP1[173, StackBR, opGCSCAN1, NoNData];
regOP1[174, StackBR, opGCSCAN2, NoNData];
:endif; * reduced
*--------------------------------------------------------------------
opPUTBASEN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1; * fetch val hi
LTEMP0← Md, T← (fetch← T) - (3c); * fetch val lo
pd← (LTEMP0) xor (SmallHi); * check val hi
branch[.+2, alu=0], Q← Md, T← (fetch← T) + 1; * fetch addrhi
callUFN;
* Q= value
LTEMP2← Md, fetch← T;
LEFT← (LEFT) + 1, memBase← ScratchLZBR;
T← (Id) + (Md);
branch[.+2, carry'], BrHi← LTEMP2;
LTEMP2← (LTEMP2) + 1, branch[.-1];
PAGEFAULTOK;
STORE← T, dbuf← Q;
:if[Debugging];
T← Md, PAGEFAULTNOTOK;
:endif;
T← Md, TSP ← (TSP) - (2c), NextOpCode; * wait for faults
regOP2[315, StackM2BR, opPUTBASEN, noNData];
*--------------------------------------------------------------------
opPUTBASEPTRN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1; * fetch val hi
LTEMP0← Md, T← (fetch← T) - (3c); * fetch val lo
Q← Md, T← (fetch← T) + 1; * fetch addrhi
* LTEMP0, Q= value
LTEMP2← Md, fetch← T;
memBase← ScratchLZBR, LEFT← (LEFT) + 1;
T← (Id) + (Md);
branch[.+2, carry'], BrHi← LTEMP2;
LTEMP2← (LTEMP2) + 1, branch[.-1];
PAGEFAULTOK;
T← (STORE← T) + 1, dbuf← LTEMP0;
STORE← T, dbuf← Q;
PAGEFAULTNOTOK;
TSP ← (TSP) - (2c), NextOpCode;
regOP2[316, StackM2BR, opPUTBASEPTRN, noNData];
*--------------------------------------------------------------------
opPUTBITS:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1; * fetch val hi
LTEMP0← Md, T← (fetch← T) - (3c); * fetch val lo
pd← (LTEMP0) xor (SmallHi); * check val hi
branch[.+2, alu=0], LTEMP0← Md, T← (fetch← T) + 1; * fetch addrhi
callUFN;
* LTEMP0= value
LTEMP2← Md, fetch← T;
LEFT← (LEFT) + 1, memBase← ScratchLZBR;
T← (Id) + (Md);
branch[.+2, carry'], BrHi← LTEMP2;
LTEMP2← (LTEMP2) + 1, branch[.-1];
PAGEFAULTOK;
FETCH← T;
WF← Id, LTEMP1← T;
T← ShMdBothMasks[LTEMP0];
PAGEFAULTNOTOK;
store← LTEMP1, dbuf← T;
TSP ← (TSP) - (2c), NextOpCode;
regOP3[317, StackM2BR, opPUTBITS, noNData];
*--------------------------------------------------------------------
opPUTBASEBYTE: * PUTBASEBYTE(base, displacement, value)
*--------------------------------------------------------------------
T← (TSP) - 1;
T← (fetch← T) - 1;
LTEMP0← Md, T← (fetch← T) - 1; * LTEMP0 has new byte
pd← (LTEMP0) and not (rhmask);
LTEMP1← Md, T← (fetch← T) - 1, branch[.+2, alu=0];
CallUFN;
pd← (LTEMP1) xor (SmallHi);
LTEMP1← Md, T← (fetch← T) - 1, branch[.+2, alu=0];* LTEMP1←offset
CallUFN;
LTEMP2← Md, T← (fetch← T) - 1;
pd← (LTEMP2) xor (SmallHi);
LTEMP2← Md, fetch← T, branch[.+2, alu=0];
CallUFN;
LEFT← (LEFT) + 1, memBase← LScratchBR;
LTEMP2← Md, BrLo← LTEMP2;
BrHi← LTEMP2;
PAGEFAULTOK;
branch[.putRight, R odd], LTEMP1← (LTEMP1) rsh 1;
FETCH← LTEMP1;
T← Md, TSP← T; * CAN FAULT
T← T and (rhmask);
Q← LTEMP0;
LTEMP0← LSH[LTEMP0, 10];
T← T + (LTEMP0), branch[.restoreByte];
.putRight:
FETCH← LTEMP1;
T← Md, TSP← T; * CAN FAULT
T← T and (lhmask);
T← T + (LTEMP0), Q← LTEMP0, branch[.restoreByte];
.restoreByte:
store← LTEMP1, dbuf← T;
PAGEFAULTNOTOK;
LEFT← (LEFT) + 1, memBase← StackBR;
TSP← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← TSP) + 1, dbuf← Q, NextOpCode;
regOP1[307, StackBR, opPUTBASEBYTE, noNData];
*--------------------------------------------------------------------
opADDBASE:
*--------------------------------------------------------------------
T← (TSP) - 1;
T← (fetch← T) - 1;
LTEMP0← Md, T← (fetch← T) - 1;
LTEMP1← Md, fetch← T;
pd← (LTEMP1) xor (SmallHi);
branch[.+2, alu=0], LTEMP0← (LTEMP0) + (Md);
CallUFN;
branch[.addbasecarry, carry], LEFT← (LEFT) + 1;
TSP← (store← T) + 1, dbuf← LTEMP0, NextOpCode;
.addbasecarry:
T← (store← T) - 1, dbuf← LTEMP0;
TSP← (fetch← T) + (2c);
LTEMP0← (1s) + (Md);
store← T, dbuf← LTEMP0, NextOpCode;
regOP1[320, StackBR, opADDBASE, noNData];
*--------------------------------------------------------------------
opVAG2:
*--------------------------------------------------------------------
T← (TSP) - 1;
T← (fetch← T) - (2c);
LTEMP1← Md, T← (fetch← T) - 1;
LEFT← (LEFT) + 1;
T← (store← T) + 1, dbuf← Md;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;
regOP1[321, StackBR, opVAG2, noNData];
*--------------------------------------------------------------------
opHILOC:
*--------------------------------------------------------------------
fetch← TSP;
T← Md, TSP← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← TSP) - 1, dbuf← T, NextOpcode;
regOP1[322, StackM2BR, opHILOC, noNData];
*--------------------------------------------------------------------
opLOLOC:
*--------------------------------------------------------------------
store← TSP, dbuf← SmallHi, NextOpCode;
regOP1[323, StackM2BR, opLOLOC, noNData];
*--------------------------------------------------------------------
* BOX results * box result in LTEMP0, LTEMP1
*--------------------------------------------------------------------
:if[Reduced];
.BOX2: branch[.box2fail, alu#0];
T← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;
.BOX: branch[.box1fail, alu#0];
T← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;
.box2fail:
TSP← (TSP) + (4c), branch[.unboxfail];
.box1fail:
TSP← (TSP) + (2c), branch[.unboxfail];
:else; * not reduced
.BOX2:
.BOX: GLOBAL,
branch[.boxt2, alu#0], T← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;
.boxt2:
pd← (LTEMP0) + 1;
branch[.ARITHPUNT, alu#0], T← (store← TSP) + 1, dbuf← SmallNegHi;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;
.STOREBOX2:
memBase← ScratchLZBR, T← (LTEMP2);
T← (store← T) + 1, dbuf← LTEMP0;
store← T, dbuf← LTEMP1;
TSP← (TSP) + (2c), NextOpCode;
.ARITHPUNT: * push halves and call MAKENUMBER
T← (store← TSP) + 1, dbuf← SmallHi;
T← (store← T) + 1, dbuf← LTEMP0;
T← (store← T) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP1;
NARGS← 2c;
DEFLO← AT.MAKENUMBER, branch[DOCALLPUNT];
:endif; * not reduced
*--------------------------------------------------------------------
SUBROUTINE; .UNBOX1: GLOBAL,
*--------------------------------------------------------------------
* memBase← StackM2BR;
* T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX1];
* returns result in LTEMP0 & T,, Q & LTEMP1 with TSP - 2
* and memBase← StackBR
T← Md, fetch← T;
LTEMP0← T← T - (SmallHi);
branch[.unbox1X, alu#0], Q← LTEMP1← Md;
.unbox1ret:
TSP← (TSP) - (2c), return;
:if[Reduced];
.unbox1x: branch[.unboxfail];
:else;
.unbox1X:
T← T - 1;
branch[.+2, alu#0], LTEMP0← T← T - 1;
TSP← (TSP) - (2c), return;
T← T + (add[SmallHi!, 2]c);
memBase← tyBaseBR;
LTEMP1← rcy[T, LTEMP1, 11];
fetch← LTEMP1;
LTEMP1← Md, memBase← ScratchLZBR;
pd← (LTEMP1) - (fixptype);
branch[.+2, alu=0], BrHi← T, T← Q;
branch[.unboxfail];
PAGEFAULTOK;
T← (FETCH← T) + 1;
LTEMP0← T← MD, fetch← T;
PAGEFAULTNOTOK;
LTEMP1← Md, memBase← StackBR;
Q← LTEMP1, branch[.unbox1ret];
:endif; * not reduced
*--------------------------------------------------------------------
.UNBOX2: GLOBAL,
*--------------------------------------------------------------------
* memBase← StackM2BR;
* T← (fetch← TSP) - 1, flipMemBase, call[.UNBOX2];
* sets results to be LTEMP0, LTEMP1; T, Q
* sets TSP← TSP-4, LEFT← LEFT - 1;
* returns w/ memBase← StackBR
LTEMP0← Md, T← (fetch← T) - (3c); * LTEMP0← YHi, T← (oldTSP) - 4
LTEMP1← Md, T← (fetch← T) + 1; * LTEMP1← YLo, T← (oldTSP) - 3
LTEMP0← (LTEMP0) - (SmallHi); * LTEMP0← YHi (unboxed)
dblbranch[.unboxAX, .unboxB, alu#0],
T← Md, fetch← T; * T← XHi
.unboxB:
T← T - (SmallHi); * T← XHi (unboxed)
.unboxB1:
dblbranch[.unboxBX, .unbox2ret, alu#0],
Q← Md, LEFT← (LEFT) + 1; * Q← XLo
.unbox2ret:
TSP← (TSP) - (4c), return;
:if[Reduced];
.unboxAX:
branch[.unboxfail];
.unboxBX:
branch[.unboxfail];
:else; * not reduced
.unboxBX:
T← T - 1; * T was really neg?
branch[.+2, alu#0], T← T - 1; * make -1
TSP← (TSP) - (4c), return;
T← T + (add[SmallHi!, 2]c); * put T back
LTEMP2← Q, memBase← tyBaseBR;
LTEMP2← rcy[T, LTEMP2, 11];
fetch← LTEMP2;
LTEMP2← Md, memBase← ScratchLZBR;
pd← (LTEMP2) - (fixptype);
branch[.+2, alu=0], BrHi← T, T← Q;
branch[.unboxfail]; * nope, not fixp
PAGEFAULTOK;
T← (FETCH← T) + 1;
T← MD, fetch← T;
PAGEFAULTNOTOK;
LTEMP2← Q, memBase← StackBR; * save loloc
Q← Md, branch[.unbox2ret];
.unboxAX:
LTEMP0← (LTEMP0) - 1; * LTEMP0 was really neg?
branch[.+2, alu#0], LTEMP0← (LTEMP0) - 1; * make -1
T← T - (SmallHi), branch[.unboxB1];
Q← Md, LEFT← (LEFT) + 1;
LTEMP2← T, memBase← tyBaseBR; * save T
LTEMP0← T← (LTEMP0) + (add[SmallHi!, 2]c); * restore LTEMP0
T← rcy[T, LTEMP1, 11];
fetch← T;
T← Md, memBase← ScratchLZBR;
pd← (T) - (fixptype);
branch[.+2, alu=0], BrHi← LTEMP0;
branch[.unboxfail]; * nope, not fixp
PAGEFAULTOK;
LTEMP1← (FETCH← LTEMP1) + 1;
LTEMP0← MD, fetch← LTEMP1;
PAGEFAULTNOTOK;
T← (LTEMP2) - (SmallHi);
LTEMP1← Md, memBase← StackBR, dblbranch[.unboxBX, .unbox2ret, alu#0];
:endif; * not reduced
TOP LEVEL;
.unboxfail:
CallUFN;