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

:Title[LOPS];
* Edit history:
* March 5, 1984 7:30 PM, JonL, added opMISC1 (alpha 9) for opRWMufMan
* (and retracted opRWMufMan as an opcode). GLOBALized REPSMALLT
* February 18, 1984 2:47 PM, JonL, added opRWMufMan
* February 18, 1984 12:53 PM, JonL, fix parity of branch condition for
* opEVAL of litatom; tried BDispatch in opEVAL again
* February 2, 1984 5:08 PM, JonL, opBIN checks bits[4:7] of BR for zero
* January 26, 1984 7:40 PM, JonL, spawned LLISTP off from this file;
*opEVAL uses BDispatch.
* January 26, 1984 6:59 PM, JonL, opNOP and NEXTOP to LJUMP
* January 7, 1984 5:38 PM, JonL, added commentary on TYPEP
* January 6, 1984, 8:18 AM, JonL, fixed TL.CREATECELL to take an arg in
*NARGS which is the number of words to "pull back" on TSP
* December 29, 1983 6:59 PM, JonL, "bubbled" inst in CREATECELL
*{memBase← StackM2BR, T← TSP} into previous inst, and replaced
*a few "0c"’s with (atomHiVal)’s; changed (MaxConsCount) test in
*CREATECELL to use carry’; TYPEP tails into REPSMT2; shortened BIN
*by saving CCOFF in T over DOGETBYTE, and tailing into REPSMALLT
*Put error checking into WRITEPRINTERPORT; CDR tails into
*TL.PUSHNIL etc
* December 27, 1983 6:30 PM, JonL, changed calls to GCLOOKT1 into calls
*to GCADDREF or GCDELREF
* December 26, 1983 6:53 PM, JonL, move in opEQ and opNOP from LOW,
*let opEQ call ABFETCH and tail-out into TL.PUSHTRUE (or NIL)
* December 26, 1983 6:40 PM, JonL, fixed callers of TYPREV to watch out
*for non-zero TT.*** bits
* December 21, 1983 5:15 AM, JonL, opRCLK from LOW, NEXTOP from from
*LSTACK, moved opPOP to LSTACK, tailed opNTYPX into REPSMALLT
* December 19, 1983 1:01 PM, JonL, TL.CREATECELL. Args in CELLHINUM and
*CELLLONUM
* December 15, 1983 3:42 PM, JonL, Put in labels REPSMALLT and TL.REPT
* November 29, 1983 4:42 PM, Masinter, change carry to < on createcell

KnowRBase[LTEMP0];
TOP LEVEL;
InsSet[LispInsSet, 1];

*--------------------------------------------------------------------
SUBROUTINE;TYPREV:* Get type of datum from cell being fetched from T
*--------------------------------------------------------------------
* Enter having done
* T← (fetch← <someLoc>) + 1, call[TYPREV];
* Exit with Ahi in LTEMP0
* Alo in LTEMP1
* typenumber in T

T← LTEMP0← Md, fetch← T;
LTEMP1← Md, memBase← tybaseBR;
T← RCY[T, LTEMP1, 11];
fetch← T;
T← Md, memBase← StackM2BR, return;

TOP LEVEL;

*--------------------------------------------------------------------
opEQ:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[ABFETCH];
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← (atomHiVal), branch[TL.PUSHTRUE];
.neq:
TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL];

regOP1[360, StackM2BR, opEQ, noNData];

*--------------------------------------------------------------------
opNTYPX:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
T← T and (rhmask), Branch[REPSMALLT];

*--------------------------------------------------------------------
REPSMALLT:GLOBAL,
*--------------------------------------------------------------------
* Smashes a smallp into the Top-of-Stack slot;
* Assumes TSP is correct and StackM2BR is memBase
TSP← (store← TSP) + 1, dbuf← smallHi;
REPSMT2:
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;

regOP1[4, StackM2BR, opNTYPX, noNData];

*--------------------------------------------------------------------
opDTEST:* test if type name of tos = arg, ufn if not
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
memBase← dtdBR;* fetch type name of DTD
T← LSH[T, 4];* shifts TT.*** bits out
PAGEFAULTOK;
FETCH← T, T ← LTEMP0, RisID;* This is really T← (Id);
T← LSH[T, 10];* Get the litatom index
T← (Id) + T;
pd← T - (MD);
PAGEFAULTNOTOK;
branch[.+2, alu=0];
CallUFN;* type disagree
NextOpCode;

regOP3[6, StackM2BR, opDTEST, noNData];

*--------------------------------------------------------------------
opTYPEP:* TYPEP, LISTP same code
*--------------------------------------------------------------------

%
T← (fetch← TSP) + 1, call[TYPREV];
T← T and (rhmask);
pd← (Id) xor T;
branch[.+2, alu#0], T← AT.NIL;
NextOpcode;* Continue if type same
TSP← (store← TSP) + 1, dbuf← (atomHiVal), * Otherwise, return NIL
branch[TL.REPNIL2];
%

* Try this code, if a huge speedup and space savings for LITATOM is
* worth a 10% slowdown in the "true" cases of STRINGP, LISTP, etc

T← (fetch← TSP) + 1, call[TYPREV];
T← T and (rhmask);
pd← (Id) xor T;
branch[.typep1, alu#0], pd← (LTEMP0) xor (atomHiVal);
branch[.+2, alu=0], T← AT.T;
NextOpcode;* Return arg if right type
TSP← (store← TSP) + 1, dbuf← smallHi, * But on LITATOMs, return T
branch[REPSMT2];

.typep1:
TSP← (store← TSP) + 1, dbuf← (atomHiVal), * Return NIL when not of
branch[TL.REPNIL2];* the selected type

regOP1[3, StackM2BR, opTYPEP, listType!];
regOP2[5, StackM2BR, opTYPEP, noNData];

:if[Reduced];
UFNOPS[37];
:else;
*--------------------------------------------------------------------
opCREATECELL:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, CELLHINUM ← (fetch← T) - T;* TOS = typenumber
pd← NARGS← T - (SmallHi);* Kludgy way to set
branch[.+2, alu=0], T← Md, memBase← dtdBR, * NARGS to 0 in the
CELLLONUM ← T - T;* normal case.
CallUFN;
T← LSH[T, 4];* 2↑4 wds per entry

TL.CREATECELL:
* Enter with T has the datatype number multiplied by the number of
*words per DTD entry;
* DEFHI has hiword value for first cell
* DEFLO has loword value for first cell
* NARGS has the number of words to "pull back" on TSP
* memBase is dtdBR
T← T + (DTD.FREE);* fetch free list
LTEMP2← T← (fetch← T) + 1;* fetch head of free list
LTEMP0← Md, T← (fetch← T) +
(sub[DTD.SIZE!, add[DTD.FREE!, 1]]c);
LTEMP1← Md, fetch← T;* LTEMP0, 1 ← freelist head
LTEMP3← Cnt← Md;* LTEMP3, Cnt ← size in wds
branch[.+2, Cnt#0&-1], memBase← ScratchLZBR;
UCodeCheck[allocateZeroSizeCell];
BrHi← LTEMP0;
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;* fetch contents of free
branch[.+2, Cnt#0&-1], LTEMP4← MD, T← (fetch← T) - (2c);
UCodeCheck[allocateOneSizeCell];
PAGEFAULTNOTOK;
LTEMP3← Md, T← T + (LTEMP3);* loloc+size-1

.clearnew:
PAGEFAULTOK;
T← (STORE← T) - 1, dbuf← 0c, branch[., Cnt#0&-1];
PAGEFAULTNOTOK;
.cleardone:

* All but first word has been cleared. Store args into 1st and 2nd word
T← (store← T) +1, dbuf← CELLHINUM;
store← T, dbuf← CELLLONUM;

T← LTEMP2, memBase← dtdBR;* store new free cell
T← (store← T) - 1, dbuf← LTEMP3;
store← T, pd← dbuf← LTEMP4;
branch[.+2, alu#0], LTEMP2← (LTEMP2) +
(sub[DTD.COUNTER!,add[1,DTD.FREE!]]c);
PSTATE← (PSTATE) or (PS.HTCNTFULL);* freelist became empty ?
fetch← LTEMP2;
T← (Md) + 1;* Add 1 to conscounter
store← LTEMP2, dbuf← T;
pd← T - (MaxConsCount);
T← NARGS, FreezeBC;
branch[.+2, carry’], T← TSP← (TSP) - T, memBase← StackM2BR;
* Exceeded MaxConsCount allocations of this type ?
PSTATE← (PSTATE) or (PS.HTCNTFULL);

* Result is address of newly allocated cell, which is smashed onto TOS
T← (store← T) + 1, dbuf← LTEMP0;
store← T, dbuf← LTEMP1;
*DELREF on new cell, so implicit refcnt of 1 goes to 0
Case← 1c, Call[GCLOOKUP1];
LTEMP4← (4c), Branch[GCOPTAIL];

regOP1[37, StackM2BR, opCREATECELL, noNData];
:endif;

:if[Reduced];
UfnOps[40];
:else;

*--------------------------------------------------------------------
opBIN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];* returns with type in T
T← T and (rhmask);* Flush TT.*** bits
PD← (Id) xor T, memBase← ScratchLZBR;* Set ScratchLZR to base of
Branch[.+2, alu=0], BrHi← LTEMP0;* segment containg STREAMP
CallUFN;* Arg not a STREAMP ?
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;
LTEMP0← MD, T← (fetch← T) + 1;* LTEMP0 ← CCOFF
PAGEFAULTNOTOK;
T← Md, LTEMP2← (fetch← T) + 1;* T ← NCCHARS
LTEMP0← Md, pd← T - (Q← LTEMP0) - 1;* LTEMP0 ← HiBuf, Q ← CCOFF
* also pd← NCCHARS-CCOFF-1
Branch[.+2, carry], LTEMP2← (fetch← LTEMP2) - (3c);
CallUFN;* Punt -- end of bufload
Branch[.+2, R<0], LTEMP0, memBase← ScratchBR;
CallUFN;* Punt -- readable bit off
T← Md, pd← (LTEMP0) and (7400c);
Branch[.+2, alu=0], BrHi← LTEMP0;
uCodeCheck[ExtraBitsInBufferAddress];* BR setup to base of buffer
BrLo← T, T← LTEMP1← Q, Call[.getByte];* and actually fetch byte

memBase← ScratchLZBR, T← T + 1;* Now increment CCOFF
store← LTEMP2, dbuf← T;
memBase← StackM2BR, T← LTEMP1, Branch[REPSMALLT];

regOP1[40, StackM2BR, opBIN, streamType!];

:endif;

*--------------------------------------------------------------------
opMISC1:
*--------------------------------------------------------------------
* One arg miscellaneous opcode
T← ID;
pd← (T) - (11c);
Branch[opRWMufMan, alu=0];
ucodeCheck[BadMISC1AlphaByte];

regOP2[170, StackM2BR, opMISC1, noNData];

*--------------------------------------------------------------------
opRWMufMan:
*--------------------------------------------------------------------
* One arg, a PosSMALLP, whose low-order 11 bits are a Muffler/Manifold
*address. If the high-order bit (i.e., 2↑15) is off, then read the
*the addressed muffler and return it’s bit as the high-order bit of
*a PosSMALLP; if it is on, then execute the corresponding Manifold
*operation and return NIL.
T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX1];
T← 13s;
pd← LTEMP0, Cnt← T;
Branch[.+2, alu=0],TSP← (TSP) + (2c);* Restore TSP
CallUfn;
flipMemBase;* Both exits expect memBase
* to be StackM2Br
.rwmmlp:
MidasStrobe← Q;* 11. iterations of strobe
Q lsh 1;* and shift
nop;
Branch[.rwmmlp, Cnt#0&-1];

Branch[.+2, R>=0], LTEMP1;* Don’t do flipMembase here,
UseDMD, Branch[REPNIL];* because that constrains
T← ALUFMEM, Branch[REPSMALLT];* too many locations

*--------------------------------------------------------------------
opRCLK:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
LTEMP0← Md, fetch← T, T← (30c);* LTEMP0 ← HiAddr to clobber
LTEMP1← Md, memBase← MDS;* LTEMP1 ← LoAddr to clobber
T← T + (400c);
taskingOff;
fetch← T;* fetch word 430 for hi part of clock
LTEMP2← Md, rbase← rbase[RTClock];* LTEMP2 ← hiword of clock
T← RTClock;* T ← loword of clock
taskingOn;
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];

*--------------------------------------------------------------------
opREADPRINTERPORT:
*--------------------------------------------------------------------
T← NOT(EventCntA’), branch[PUSHSMALLT];
regOP1[164, StackM2BR, opREADPRINTERPORT, noNData];

*--------------------------------------------------------------------
opWRITEPRINTERPORT:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase;* Using .UNBOX1 here
T← Md, fetch← T;* would only save 1
pd← T - (SmallHi), T← Md;* IM loc, but cost
Branch[.+2, alu=0];* an extra 3 cycles
CallUfn;
EventCntB← T, NextOpCode;

regOP1[165, StackM2BR, opWRITEPRINTERPORT, noNData];