:Title[LOPS];
* Edit history:
* Masinter, August 7, 1985 8:25 PM, add EQL, EQUAL
* March 29, 1985 2:01 PM, make MISC1 also turn on ether
* March 29, 1985 11:00 AM, Masinter, make CREATECELL ufn if free list NIL
* March 22, 1985, 12:04, Masinter, change TYPEMASK, reformat
* January 21, 1985 12:00 PM, Masinter, unglobal REPSMALLT
* January 19, 1985 1:56 PM, Masinter, add TYPEMASK, assume TYPREV masks bits
* 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← (rhmask);
T← (T) and (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];
*--------------------------------------------------------------------
opEQL:
*--------------------------------------------------------------------
T← (fetch← TSP) - 1, flipMemBase, call[ABFETCH];
T← Md, TSP← (fetch← T) - 1;
pd← T xor (LTEMP0);
branch[.+2, alu=0], pd← (Md) xor (LTEMP1);
LEFT← (LEFT) + 1, branch[.neql];
branch[.+2, alu#0], LEFT← (LEFT) + 1;
TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHTRUE];
.NEQL:
PD ← LTEMP0;
branch[.+2, alu#0], pd ← T;
TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL];
branch[.+2, alu#0];
TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL];
TSP ← (TSP) + (4C);
opEQUAL:
CallUFN;
regOP1[72, StackM2BR, opEQL, NoNData]; * EQL
regOP1[364, StackM2BR, opEQL, NoNData]; * EQUAL
*--------------------------------------------------------------------
opNTYPX:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
*--------------------------------------------------------------------
REPSMALLT:
*--------------------------------------------------------------------
* Store a smallp into the Top-of-Stack slot;
* Assumes TSP is correct and StackM2BR is memBase
PAGEFAULTNOTOK;
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];
PAGEFAULTOK;
FETCH← T, T ← LTEMP0, RisID; * This is like T← (Id);
T← LSH[T, 10]; * Get the litatom index
T← (Id) + T; * same ID
pd← T - (MD);
PAGEFAULTNOTOK;
branch[.+2, alu=0];
CallUFN; * type disagree
NextOpCode;
regOP3[6, StackM2BR, opDTEST, noNData]; * this one is "coerce"
regOP3[56, StackM2BR, opDTEST, noNData]; * this one is "typecheck"
*--------------------------------------------------------------------
opTYPEP: * TYPEP, LISTP same code
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
pd← (Id) xor T;
.typepTAIL:
branch[.+2, alu#0], T← AT.NIL;
NextOpcode; * Continue if type same
TSP← (store← TSP) + 1, dbuf← (atomHiVal), * Otherwise, return NIL
branch[TL.REPNIL2];
regOP1[3, StackM2BR, opTYPEP, listType!];
regOP2[5, StackM2BR, opTYPEP, noNData];
*--------------------------------------------------------------------
opTYPEMASK: * used for NUMBERP, FIXP, etc.
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, fetch← T;
LTEMP1← Md, memBase← tybaseBR;
T← RCY[T, LTEMP1, 11];
fetch← T;
T← Md, memBase← StackM2BR;
T← RSH[T,10];
pd← (Id) and T;
branch[.+2, alu=0], T← AT.NIL;
NextOpcode; * Continue if type same
TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.REPNIL2];
regOP2[63, StackM2BR, opTYPEMASK, noNData];
*--------------------------------------------------------------------
opCREATECELL:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, CELLHINUM ← (fetch← T) - T; * TOS = typenumber
pd← NARGS← T - (SmallHi); * NARGS← 0 if normal
branch[.+2, alu=0], T← Md, memBase← dtdBR, CELLLONUM ← T - T; CallUFN; * non-small arg
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 when done
* 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);
pd← LTEMP0; * LTEMP0, LTEMP1 ← freelist head
branch[.+2, alu#0], LTEMP1← Md, fetch← T;
CallUFN; * free list is empty
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];
*--------------------------------------------------------------------
opBIN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV]; * returns with type in T
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; *setup BR to base of buffer
uCodeCheck[ExtraBitsInBufferAddress];
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!];
*--------------------------------------------------------------------
opMISC1:
*--------------------------------------------------------------------
* One arg miscellaneous opcode
T← ID;
pd← (T) - (11c);
Branch[opRWMufMan, alu=0], pd← (T) - (12c);
Branch[Reset10MBEther, alu=0];
callUFN;
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];
regOP1[54, StackM2BR, opEVAL, noNData];
*--------------------------------------------------------------------
opEVAL:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
pd← T and (370c); * Only the first 8 type codes
Branch[.+2, alu=0], T← T and (7c); * are handled by ucode
CallUFN;
BDispatch← T;
Branch[.evdispatch];
.evdispatch: DispTable[10],
CallUfn; * Type 0 is randomness
NextOpCode; * Smallp
NextOpCode; * Fixp
NextOpCode; * Floatp
FVNAME← pd← (LTEMP1), Branch[.evatom]; * Litatom. "xor (AT.NIL)"
NARGS← (1c), Branch[.evListp]; * Listp
NextOpCode; * Arrayp
NextOpCode; * Stringp
% code use to read:
pd← T - (atomType);
branch[.evalatom, alu=0], pd← T;
branch[.evalother, alu=0], pd← T - (add[FixpType!, 1]c);
branch[.evalret, alu<0], pd← T - (ListType);
branch[.evListp, alu=0], NARGS← 1c;
CallUFN; * not atom, fixp, listp
.evalother:
CallUFN; * let UFN decide
.evalret: NextOpCode; * return self
.evalatom:
FVNAME← pd← (LTEMP1); * "xor (AT.NIL)"
%
.evatom:
Branch[.+2, alu#0], pd← (FVNAME) xor (AT.T);
NextOpCode; * eval of NIL=NIL
Branch[.+2, alu#0], T← (FX.PVAR);
NextOpCode; * eval of T=T
nop; * Call can be false target of conditional branch
FVEP← (PVAR) - T, Call[DOLOOKUP];
memBase← ScratchLZBR;
BrHi← FVHI;
PAGEFAULTOK;
T← (FETCH← FVLO) + 1; * Might fault, since it
T← Md, fetch← T; * may be global cell
PAGEFAULTNOTOK;
pd← (FVHI) - (StackHi);
Branch[.+2, alu#0], memBase← StackM2BR;
Branch[REPTMD1]; * Stack-bound value is OK
pd← (add[AT.NOBIND!]s) xor (Md);
Branch[REPTMD1, alu#0]; * Global binding ok
CallUFN; * Hmmm, NOBIND in topcell
.evListp:
DEFLO← AT.EVALFORM, Branch[DOCALLPUNT];
REPTMD: * Replace value on top of stack with value in T,,MD
memBase← StackM2BR;
REPTMD1:
T← Md, TSP← (store← TSP) + 1, dbuf← T;
TSP← (store← TSP) - 1, dbuf← T, NextOpcode;