[eris]<Lisp>Harmony>uCode>LISPDMC.DM!1>LMEM.mc

*--------------------------------------------------------------------
opADDBASE:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, Call[.addrNfetch];
branch[.adbs1, alu#0], LTEMP1← (LTEMP1) + (Md);* + Lo.word of addr
branch[.+2, carry], LEFT← (LEFT) + 1;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode; * Done - fast case
T← (store← T) - 1, dbuf← LTEMP1;* Carry over into next
TSP← (fetch← T) + (2c);* next segment
LTEMP0← (1s) + (Md);
store← T, dbuf← LTEMP0, NextOpCode;

SUBROUTINE;
.addrNfetch:
* Enter and exit with StackBR
* Leaves 0 on pd iff TOS is a smallposp
LTEMP0← Md, T← (fetch← T) - (2c);* LTEMP0← Hi.word of n
LTEMP1← Md, (fetch← T);* LTEMP1← Lo.word of n
pd← (LTEMP0) xor (SmallHi), Return; * Is n a smallP?
TOPLEVEL;

.adbs1:
CallUFN;
%* This could continue something like . . .
LEFT← (LEFT) - 1, memBase← StackM2BR;
T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX1];
T← (TSP) + 1, flipMemBase;* Change back to StackM2BR
T← (fetch← T) - 1;* TSP was "pulled back"
(fetch← T), LTEMP1← Md;* LTEMP1← lo.word of addr
T← (LTEMP1) + Q, LTEMP1← T;* Lo.word sum
LTEMP0← (LTEMP0) + (Md), XorSavedCarry;* Hi.word sum
T← (store← LTEMP1) + 1, dbuf← T;* Store Lo.word
(store← T), dbuf← LTEMP0, NextOpCode;* Store Hi.word
%

regOP1[320, StackM2BR, opADDBASE, noNData];

*--------------------------------------------------------------------
opVAG2:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX2];
pd← (LTEMP0) or (T);
Branch[.+2, alu=0], T← (store← TSP) + 1, dbuf← Q;
CallUFN;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;

% *This old code is 6 instruction executions instead of 11, but it
* consumes two more locations, and does no error checking.
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, StackM2BR, opVAG2, noNData];

*--------------------------------------------------------------------
opBLT: * (destinationaddr sourceaddr #wds)
*--------------------------------------------------------------------
* Defined to move one word at a time, from the high end to the
* low end, and be continuable after interrupts.
* These highly-bummed ideas are taken from Taft’s implementation of
* Mesa BLT and BLTL, found in DMesaRW.mc
* Enter with:
*Q set to 20b
* T set to number of words to move minus one
* stack has running count (minus 1)
* Branch back around the loop:
*stack updated to next value
* T set up 17 for the next full munch
* Before starting the transfer, touch the last word of the source and
* destination blocks, to force any page faults that would happen, to
* happen now rather than in the inner loop. Maybe need not touch the
* first words, since a fault there will abort the loop before it has
* done anything permanent. Also, "pre-warm" the cache for the next
* time around.

T← (fetch← TSP) - 1, flipMemBase, Call[.addrNfetch];
Branch[.+2, alu=0], T← T - 1;
CallUFN;* Punt: #wds not smallposp
LTEMP2← Md, T← (fetch← T) - 1;* Why 2 for StkP? ’Cause
LTEMP0← Md, T← (fetch← T) - 1;* BitBlt does it that way
LTEMP3← Md, (fetch← T), T← (2c);* Fetch on hi.word of Dest
T← LTEMP1, StkP← T;* LTEMP1 had #wds to move
T← Md, stack← T - 1, memBase← BBDSTBR;* Stack← #wds-1
BRHi← T, Branch[.bltxit, alu<0]; * Zero words to transfer?
T← (20c);
Q← T, T← T - 1;* Q← (20c), T← (17c)
BRLo← LTEMP3;
T← (stack) and T, memBase← BBSRCBR;* T← (#wds [mod 20b]) - 1
BRHi← LTEMP0;
BRLo← LTEMP2;
PSTATE← (add[PS.PFOK!, PS.INBLT!]c);

.bltloop:
Cnt← T;
LTEMP0← T← (FETCH← stack) - T;* Fetch on first src wd
LTEMP2← (FETCH← T) - (Q);* Fetch on last src wd
PreFetch← LTEMP2, flipMemBase;
FETCH← stack;* Fetch on first dest wd
FETCH← LTEMP0;* Fetch on last dest wd
PreFetch← LTEMP2, T← MD, flipMemBase;* Synchronize PageFaults
*** Here’s the tight inner loop to move a munch
.bltmm:
fetch← stack, flipMemBase;
stack← (STORE← stack) - 1, dbuf← Md, flipMembase,
Branch[.bltmm, Cnt#0&-1];
***
pd← stack, Branch[.+2, Reschedule’];* Tails into BitBlt code if
Branch[BBXitToContinue];* need to xit for interrupt
T← (17c), Branch[.bltloop, alu>=0];* Should be 17 or -1, not 0

.bltdone:
PSTATE← A0;
.bltxit:
LEFT← (LEFT) + (2c);* LEFT is re-computed if
TSP← (TSP) - (4c), NextOpCode;* there is a fault-out

%

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, Call[.gbsFetch];
:if[Debugging];
PAGEFAULTOK;
IFETCH← LTEMP0;
T← MD, memBase← StackM2Br;
PAGEFAULTNOTOK, Branch[REPSMALLT];
:else;
IFETCH← LTEMP0;
T← MD, memBase← StackM2BR, Branch[REPSMALLT];
:endif;

regOP2[310, StackM2BR, opGETBASEN, noNData];

SUBROUTINE;
.gbsFetch:
T← Md, fetch← T, LTEMP1← (rhmask);
LTEMP0← Md, memBase← ScratchLZBR;
BrHi← T, Return;
TOPLEVEL;

*--------------------------------------------------------------------
opGETBITS:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, Call[.gbsFetch];
PAGEFAULTOK;
IFETCH← LTEMP0, TisID;
memBase← StackM2BR;
LTEMP0← MD, RF← Id;
PAGEFAULTNOTOK;
T← ShiftLMask[LTEMP0], memBase← StackM2BR, Branch[REPSMALLT];

regOP3[312, StackM2BR, opGETBITS, noNData];

*--------------------------------------------------------------------
opGETBASEPTRN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, Call[.gbsFetch];
PAGEFAULTOK;
LTEMP0← (IFETCH← LTEMP0) + 1;
T← MD, ifetch← LTEMP0;
PAGEFAULTNOTOK;
T← T and (LTEMP1), memBase← StackM2BR;
T← Md, TSP← (store← TSP) + 1, dbuf← T, Branch[REPSMT2];

regOP2[311, StackM2BR, opGETBASEPTRN, noNData];

*--------------------------------------------------------------------
opGETBASEBYTE:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, Call[.addrNfetch];* See opADDBASE
branch[.+2, alu=0], T← T - 1;
CallUFN;* Index not smallPosp
fetch← T, LTEMP0← Md;
memBase← LScratchBR, LEFT← (LEFT) + 1;
LTEMP0← Md, BrLo← LTEMP0;
BrHi← LTEMP0, call[.getByte];
T← (store← T) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;

regOP1[302, StackM2BR, opGETBASEBYTE, noNData];

SUBROUTINE;
.getByte:
* called by BIN, GETBASEBYTE;
* Assumes current memBase is pointer, LTEMP1 is byte offset
* Returns byte in LTEMP1
* Must not clobber T
dblbranch[.dgbeven, .dgbodd, R even], LTEMP1← (LTEMP1) rsh 1;
.dgbeven:
PAGEFAULTOK;
FETCH← LTEMP1;
LTEMP1← MD, memBase← StackBR;
PAGEFAULTNOTOK;
LTEMP1← RSH[LTEMP1, 10], return;
.dgbodd:
PAGEFAULTOK;
FETCH← LTEMP1;
LTEMP1← MD, memBase← StackBR;
PAGEFAULTNOTOK;
LTEMP1← (LTEMP1) and (rhmask), return;

TOP LEVEL;

*--------------------------------------------------------------------
opPUTBASEN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, Call[.pbsFetch];* fetch val hi
STORE← T, dbuf← LTEMP0;
:if[Debugging];
T← MD, TSP ← (TSP) - (2c);
PAGEFAULTNOTOK, NextOpCode;
:else;
T← MD, TSP ← (TSP) - (2c), NextOpCode;* wait for faults
:endif;

SUBROUTINE;
.pbsFetch:
LTEMP0← Md, T← (fetch← T) - (3c);* LTEMP0← Hi.newByte
pd← (LTEMP0) xor (SmallHi);* check for smallPosp
branch[.+2, alu=0], LTEMP0← Md, Q← Md,* LTEMP0← newByte
T← (fetch← T) + 1;
TOPLEVEL; CallUFN; SUBROUTINE;
LTEMP2← Md, fetch← T;* LTEMP2← Hi.addr
LEFT← (LEFT) + 1, memBase← ScratchLZBR;
T← (Id) + (Md);* T← Lo.addr + alpha
branch[.+2, carry’], BrHi← LTEMP2;
LTEMP2← (LTEMP2) + 1, branch[.-1];
:if[Debugging];
PAGEFAULTOK, Return;
:else;
Return;
:endif;
TOPLEVEL;

regOP2[315, StackM2BR, opPUTBASEN, noNData];

*--------------------------------------------------------------------
opPUTBITS:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, Call[.pbsFetch];* fetch val hi
FETCH← T;
WF← Id, LTEMP1← T;
T← ShMdBothMasks[LTEMP0];
PAGEFAULTNOTOK;
store← LTEMP1, dbuf← T, Branch[TL.POP1];

regOP3[317, StackM2BR, opPUTBITS, 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
LTEMP2← Md, fetch← T;* LTEMP0, Q have newval
memBase← ScratchLZBR, LEFT← (LEFT) + 1;
T← (Id) + (Md);
branch[.+2, carry’], BrHi← LTEMP2;
LTEMP2← (LTEMP2) + 1, branch[.-1];
:if[Debugging];
PAGEFAULTOK;
T← (STORE← T) + 1, dbuf← LTEMP0;
STORE← T, dbuf← Q;
PAGEFAULTNOTOK, Branch[TL.POP1];
:else;
T← (STORE← T) + 1, dbuf← LTEMP0;
STORE← T, dbuf← Q, Branch[TL.POP1];
:endif;

regOP2[316, StackM2BR, opPUTBASEPTRN, 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;

%
T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX2];
LTEMP0← T or (LTEMP0);* displacement and value
T← (LTEMP1) and not (rhmask);* must be smallPosp’s
pd← T or (LTEMP0);* value at most 8 bits
Branch[.pbb1, alu=0], T← (TSP) - 1;
TSP← (TSP) + (4c);
CallUFN;
.pbb1:
LTEMP3← T← (fetch← T) - 1;* LTEMP1 has new byte value
LTEMP0← Md, T← (fetch← T) + (6c);* (must restore TSP, fault!)
TSP← T, memBase← LScratchBR;* LScratchBR points to base
LTEMP0← Md, BrLo← LTEMP0;
BrHi← LTEMP0, LTEMP0← Q;* LTEMP0← displacement
branch[.putRight, R odd], LTEMP0← (LTEMP0) rsh 1;
PAGEFAULTOK;
.putLeft:
FETCH← LTEMP0;
LTEMP2← LTEMP1, T← (MD);
LTEMP2← LSH[LTEMP2, 10];
T← (T) and (rhmask), branch[.restoreByte];
.putRight:
FETCH← LTEMP0;
LTEMP2← LTEMP1, T← (MD);
T← T and (lhmask), branch[.restoreByte];
.restoreByte:
T← T or (LTEMP2);
store← LTEMP0, dbuf← T;
PAGEFAULTNOTOK;
LEFT← (LEFT) - (2c);
T← LTEMP3, memBase← StackBR;
T← (store← T) + 1, dbuf← SmallHi;
TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;

%

regOP1[307, StackBR, opPUTBASEBYTE, noNData];