:Title[LOPS.mc, January 18, 1983 5:15 PM, Masinter];
KnowRBase[LTEMP0];
TOP LEVEL;
InsSet[LispInsSet, 1];
*--------------------------------------------------------------------
opPOP:
*--------------------------------------------------------------------
TSP← (TSP) - (2c);
Left← (Left) + 1, NextOpcode;
regOP1[277, StackBR, opPOP, noNData];
*--------------------------------------------------------------------
opTYPEP:* TYPEP, LISTP same code
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
T← T and (rhmask);
pd← (Id) - T;
branch[.+2, alu#0];
NextOpcode;* continue if type same
TSP← (store← TSP) + 1, dbuf← 0c;* return NIL
TSP← (store← TSP) - 1, dbuf← 0c, NextOpCode;
regOP1[3, StackM2BR, opTYPEP, listType!];
regOP2[5, StackM2BR, opTYPEP, noNData];
*--------------------------------------------------------------------
opNTYPX:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];
T← T and (rhmask);
TSP← (store← TSP) + 1, dbuf← SmallHi;
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;
T← lsh[T, 4];* fetch type name of DTD
PAGEFAULTOK;
FETCH← T, T ← LTEMP0, RisID;* This is really T← (Id);
T← lsh[T, 10];
T← (Id) + T;
pd← T - (MD);
branch[.dtestfail, alu#0], Q← T;
PAGEFAULTNOTOK;
NextOpCode;
.dtestfail:
PAGEFAULTNOTOK;
CallUFN;* type disagree
regOP3[6, StackM2BR, opDTEST, noNData];
:if[NOCREATECELL];* NO CREATECELL AT ALL NOW
UFNOPS[37];
:else;
*--------------------------------------------------------------------
opCREATECELL:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1;
T← Md, fetch← T;
pd← T - (SmallHi);
branch[.+2, alu=0], T← Md, memBase← dtdBR;* TOS = typenumber
CallUFN;
T← lsh[T, 4];* get DTD
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← free list head
LTEMP3← Cnt← Md;* LTEMP3 & Cnt ← Size
:if[Debugging];
T← (LTEMP1) and (777c);* word # in MDSpage of new cell
T← T + (LTEMP3);* plus count
pd← T - (1000c);
branch[.+2, alu<=0];
UCodeCheck[CreateCrossesPageBoundary];
:endif;
branch[.+2, Cnt#0&-1], memBase← ScratchLZBR;
UCodeCheck[allocateZeroSizeCell];
BrHi← LTEMP0;
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;* fetch contents of free
LTEMP4← MD, T← (fetch← T) - (2c);
PAGEFAULTNOTOK;
LTEMP3← Md, T← T + (LTEMP3);* loloc + size - 1
*T← (STORE← T) - 1, branch[.+2, Cnt=0&-1];
*branch[.clearnew];
*PAGEFAULTNOTOK, branch[.cleardone];
.clearnew:
PAGEFAULTOK;
T← (STORE← T) - 1, dbuf← 0c, branch[., Cnt#0&-1];
PAGEFAULTNOTOK;
:if[Debugging];
pd← (LTEMP1) - T - 1;
branch[.+2, alu=0];
UCodeCheck[];
:endif;
.cleardone:
memBase← dtdBR, T← LTEMP2;
T← (store← T) - 1, dbuf← LTEMP3;
store← T, pd← dbuf← LTEMP4;* store back new free cell
branch[.+2, alu#0],
LTEMP2← (LTEMP2)+(sub[DTD.COUNTER!,add[1,DTD.FREE!]]c);
PSTATE← (PSTATE) or (PS.HTCNTFULL);* free list became empty
fetch← LTEMP2;
T← (Md) + 1;
store← LTEMP2, dbuf← T;
pd← T - (MaxConsCount);
branch[.+2, carry];
PSTATE← (PSTATE) or (PS.HTCNTFULL);* too many createcells
* save return value
memBase← StackM2BR, T← TSP;
T← (store← T) + 1, dbuf← LTEMP0;
store← T, dbuf← LTEMP1;
T← (fetch← TSP) + 1;
Case← 1c, call[GCLOOKUP];
branch[GCOPTAIL];
regOP1[37, StackM2BR, opCREATECELL, noNData];
:endif;* NOCREATECELL
*--------------------------------------------------------------------
* subroutine to get type of datum
*--------------------------------------------------------------------
* leaves rbase alone, returns with membase← StackBR
* ptr in LTEMP0,,LTEMP1, rbase[LTEMP0], T← type
SUBROUTINE;
TYPREV:
T← LTEMP0← Md, fetch← T;
LTEMP1← Md, memBase← tybaseBR;
T← rcy[T, LTEMP1, 11];
fetch← T;
T← Md, memBase← StackM2BR, return;
TOP LEVEL;
:if[NOBIN];
UfnOps[40];
:else;
*--------------------------------------------------------------------
opBIN:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV];* returns with type in T
PD← (Id) - T, memBase← ScratchLZBR;
branch[.+2, alu=0], BrHi← LTEMP0;
CallUFN;
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;
LTEMP0← MD, T← (fetch← T) + 1;* LTEMP0= CCOFF
PAGEFAULTNOTOK;
T← Md, LTEMP1← (fetch← T) + 1;* T=NCCHARS
LTEMP0← Md, pd← T - (Q← LTEMP0) - 1;* T← HiBuf, pd← NCCHARS-CCOFF
branch[.+2, carry], LTEMP1← (fetch← LTEMP1) - (3c);
CallUFN;
branch[.+2, R<0], LTEMP0, memBase← ScratchBR;
CallUFN;* readable bit is off
T← Md, BrHi← LTEMP0;
BrLo← T, LTEMP0← Q, call[DOGETBYTE];* actually fetch byte
memBase← StackM2BR, T← LTEMP0;
TSP← (store← TSP) + 1, dbuf← SmallHi;
TSP← (store← TSP) - 1, dbuf← T;
memBase← ScratchLZBR;
T← (Q) + 1;
store← LTEMP1, dbuf← T, NextOpCode;
regOP1[40, StackM2BR, opBIN, streamType!];
:endif; *NOBIN
*--------------------------------------------------------------------
opREADPRINTERPORT:
*--------------------------------------------------------------------
T← NOT(EventCntA’), branch[PUSHSMALLT];
regOP1[164, StackM2BR, opREADPRINTERPORT, noNData];
*--------------------------------------------------------------------
opWRITEPRINTERPORT:
*--------------------------------------------------------------------
T← (TSP) - 1;
fetch← T;
EventCntB← Md, NextOpCode;
regOP1[165, StackBR, opWRITEPRINTERPORT, noNData];
*--------------------------------------------------------------------
opCAR:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV]; * returns with type in T
PD← (Id) - T, memBase← ScratchLZBR;
.car1:
branch[.carnlist, alu#0], BrHi← LTEMP0;
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;
LTEMP0← MD, fetch← T;* CAN FAULT
PAGEFAULTNOTOK;
T← (LTEMP0) and (lhmask);
branch[.+2, alu#0], LTEMP0← T← (LTEMP0) - T, memBase← StackM2BR;
LTEMP1← Md, memBase← ScratchLZBR, pd← A0, branch[.car1];
T← Md, TSP← (store← TSP) + 1, dbuf← T;
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;
.carnlist:
T← (LTEMP1);
.crnlist:
pd← (LTEMP0) or T;
branch[.+2, alu#0];
NextOpCode;
CallUFN;
regOP1[1, StackM2BR, opCAR, listType!];
*--------------------------------------------------------------------
opCDR:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV]; * returns with type in T
pd← (Id) - T, memBase← ScratchLZBR;
.cdr1:
branch[.cdrnlist, alu#0], BrHi← LTEMP0;
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;
LTEMP0← MD, T← (fetch← T) and (lhmask);
PAGEFAULTNOTOK;
LTEMP1← T;
branch[.cdrind, R>=0], LTEMP0, T← ldf[LTEMP0, 7, 10];
T← T + T;
branch[.cdrnil, alu=0], T← T + (LTEMP1), memBase← StackM2BR;
.cdronpage:
TSP← (TSP) + 1;
TSP← (store← TSP) - 1, dbuf← T, NextOpCode;
.cdrnil:
TSP← (store← TSP) + 1, dbuf← 0c;
TSP← (store← TSP) - 1, dbuf← 0c, NextOpCode;
.cdrind:* indirect or local indirect
T← T + T;
branch[.+2, alu#0];
LTEMP1← Md, memBase← ScratchLZBR, pd← A0, branch[.cdr1];
.cdrlocalind:
T← (LTEMP1) + T;
T← (fetch← T) + 1;
T← Md, fetch← T, branch[REPTMD];
.cdrnlist:
T← (LTEMP1), branch[.crnlist];
regOP1[2, StackM2BR, opCDR, listType!];
:if[NORPLACS];
UfnOps[30];
UfnOps[31];
UfnOps[32];
:else;
*--------------------------------------------------------------------
opRPLACA:
*--------------------------------------------------------------------
T← (TSP) - (4c);
T← (fetch← T) + 1, call[TYPREV];* returns with type in T,
* pointer in LTEMP0, LTEMP1
PD← T - (listType);
branch[.+2, alu=0], LEFT← (LEFT) + 1, memBase← LScratchBR;
CallUFN;* not a list
.rplaca1:
BrHi← LTEMP0;
BrLo← LTEMP1;
PAGEFAULTOK;
T← (FETCH← 0s) + 1;
LTEMP0← MD;
PAGEFAULTNOTOK;
PD← (LTEMP0) and (lhmask);
branch[.rplacaind, alu=0];
branch[RPLPTR1];
.rplacaind:
fetch← T;
LTEMP1← Md, branch[.rplaca1];
regOP1[30, StackBR, opRPLACA, NoNData];* RPLACA
*--------------------------------------------------------------------
opRPLACD:
*--------------------------------------------------------------------
T← (TSP) - (4c);
T← (fetch← T) + 1, call[TYPREV];* returns with type in T,
* pointer in LTEMP0, LTEMP1
PD← T - (listType);
branch[.+2, alu=0], LEFT← (LEFT) + 1, memBase← LScratchBR;
CallUFN;* not a list
.rplacd1:
BrHi← LTEMP0, T← A0;
BrLo← T;* set LScratchBR to point to list cell’s segment
PAGEFAULTOK;
LTEMP1← (FETCH← LTEMP1) + 1, Q← LTEMP1;
LTEMP2← MD;* LTEMP2 now has high word of cell
PAGEFAULTNOTOK;
branch[.rplacdind, R>=0], T← (LTEMP2) and (77400c); * test hi bit of cell
* local bit of cdrcode on; look at TSP to see if NIL, samepage
memBase← StackM2BR;
TSP← (fetch← TSP) + 1;
T← Md, TSP← (fetch← TSP) - (3c);
LTEMP4← Md, pd← T or (Md), memBase← LScratchBR;
branch[.rplacdnil, alu=0], pd← T - (LTEMP0);
branch[.rplacdnewcell, alu#0], LTEMP1← Md, T← (Md) xor (LTEMP1);
pd← T and not (rhmask);
branch[.rplacdonpage, alu=0], T← LTEMP0;
branch[.rplacdnewcell];
.rplacdonpage:
* must addref new cell
CASE← 0c, call[GCLOOKT1];
memBase← LScratchBR;
LTEMP1← (fetch← Q) + 1;
LTEMP4← LSH[LTEMP4, 7];
T← Md, LTEMP4← (LTEMP4) or (100000c);
T← T and (77400c), branch[.rplacdlocal];
.rplacdnil:
LTEMP4← 100000c;
T← (LTEMP2) and (77400c);
.rplacdlocal:
branch[.rplacdnoref, alu=0], T← RSH[T, 7]; * potentially deleteref old ptr
LTEMP1← (LTEMP1) and (lhmask);
LTEMP1← T + (LTEMP1);
T← LTEMP0;
CASE← 1c, call[GCLOOKT1];* deleteref T,,LTEMP1
memBase← LScratchBR;
.rplacdnoref:* store new cdrcode
fetch← Q;
T← (rhmask);
T← T and (Md);
T← T + (LTEMP4);
store← Q, dbuf← T, branch[GCOPTAIL];
.rplacdnewcell:
TSP← (TSP) + (2c);
CallUFN;
.rplacdind:* "local" bit was off
branch[.rplacdlocalind, alu#0], T← RSH[T, 7];
LTEMP0← Md, fetch← LTEMP1;* full indirect, fetch new cell
LTEMP1← Md, branch[.rplacd1];* use new pointer
.rplacdlocalind:* use CDR code as offset
LTEMP1← (LTEMP1) and (lhmask);
T← T + (LTEMP1);
BrLo← T;
T← (fetch← 0s) + 1, branch[RPLPTR1];
regOP1[31, StackBR, opRPLACD, NoNData];* RPLACD
msc[DTD.NEXTPAGEs, DTD.NEXTPAGE!];
msc[DTD.COUNTERs, DTD.COUNTER!];
*--------------------------------------------------------------------
opCONS:
*--------------------------------------------------------------------
* LTEMP0, 1 have CDR
* LTEMP2, 3 hold new cons (and LScratchBR)
* LTEMP4 has CDR code (also used by .makeconscell subroutine)
T← (fetch← TSP) + 1, call[TYPREV];
pd← (Id) - T, memBase← LScratchBR;
branch[.conslist, alu=0], T← BRHi← LTEMP0;
pd← T or (LTEMP1), memBase← ListpDTDBR;
dblbranch[.consnil, .consother, alu=0], LTEMP4← (200c);* cdrcode
.conslist:
T← ldf[LTEMP1, 7, 1];* [src, size, pos];
LTEMP4← T + (200c);* new cdr code
T← (LTEMP1) and (lhmask), branch[.constail];* base of CDR’s page
.consnil:
fetch← DTD.NEXTPAGEs;
T← Md, memBase← LScratchBR;* T← nxtpage
LTEMP0← RSH[T, 10];
branch[.+2, alu#0], BRHi← LTEMP0;
branch[.consfail];
T← LSH[T, 10];
.constail:
LTEMP1← BrLo← T;
PAGEFAULTOK;
FETCH← 0s;
LTEMP3← MD;* word 0 of page: [cnt, nxt]
PAGEFAULTNOTOK;
branch[.cnsod1, R odd], LTEMP3,
T← LTEMP3← (LTEMP3) - (400c);
branch[.+2, alu>=0], T← T and (rhmask);* "next"
branch[.consfail];* no cells left
branch[.cnszer, alu=0],
LTEMP1← (fetch← T) + (LTEMP1);* fetch next
T← Md, LTEMP3← RSH[LTEMP3, 10];* T← [nxt,x], LTEMP3← cnt
LTEMP3← RCY[LTEMP3, T, 10];* [cnt,nxt]
branch[.cnsod2, R odd], store← 0s, dbuf← LTEMP3;
BRLo← LTEMP1;
T← LTEMP0;
Case← 1c, call[GCLOOKT1];* deleteref new cell
memBase← ListpDTDBR;* increment conscount
fetch← DTD.COUNTERs;
T← (MaxConsCount);
T← Md, pd← T - (Md);
branch[.+2, carry], T← T + 1;
PSTATE← (PSTATE) or (PS.HTOVERFLOW);
store← DTD.COUNTERs, dbuf← T;
memBase← StackM2BR, LEFT← (LEFT) + 1;
TSP← (TSP) - (2c);
T← fetch← TSP;
LTEMP0← Md, T← (store← T) + 1, dbuf← LTEMP0;
fetch← T;
LTEMP1← Md, store← T, dbuf← LTEMP1; * save new cell on stack
T← lsh[LTEMP4, 10];* shift cdrcode
T← (LTEMP0) or T;* merge with new CAR
LTEMP1← Md, memBase← LScratchBR;
store← 0s, dbuf← T;
store← 1s, dbuf← LTEMP1;
T← LTEMP0;
Case← A0, call[GCLOOKT1];* addref new CDR
Case← A0, memBase← StackBR;
T← (fetch← TSP) + 1, call[GCLOOKUP];* addref new CDR
branch[GCOPTAIL];
.consother:
CallUFN;
regOP1[32, StackM2BR, opCONS, listType!];* CONS
.cnsod1:
uCodeCheck[badcons];
.cnsod2:
uCodeCheck[badcons];
.cnszer:
uCodeCheck[badcons];
.consfail:
CallUFN;
:endif;* NORPLACS