:Title[LLISTP - CAR, CDR, CONS, RPLACA, RPLACD];
* Edit history:
* February 9, 1984 4:22 AM, JonL, fixed bug in .CARCDR where it was
*punting on NIL rather than on non-NIL litatoms
* February 9, 1984 12:36 AM, JonL, squeezed out one inst from CONS,
* near comment " LTEMP1← new CAR"
* January 26, 1984 7:08 PM, JonL, spawned this file off LOPS;
*opCDR goes directly to REPTMD1
* January 18, 1984 7:41 PM, JonL, added .rplc; modified opRPLACA
* January 18, 1984 6:05 PM, JonL, added subroutine .carcdr; moved
*REPTMD1 to near opCDR
* January 6, 1984 4:56 AM, JonL, Changed CDR to exit thru TL.REPNIL2
*rather than TL.PUSHNIL
* January 3, 1984 4:13 PM, JonL, Re-incorporated experimental changes
*made 12/30/83 fixing a clobberage of T by some TT.*** code
* affecting CAR, CDR, RPLACA, RPLACD
* December 27, 1983 6:30 PM, JonL, changed calls to GCLOOKT1 into calls
*to GCADDREF or GCDELREF
* December 26, 1983 6:40 PM, JonL, fixed callers of TYPREV to watch out
*for non-zero TT.*** bits
KnowRBase[LTEMP0];
TOP LEVEL;
InsSet[LispInsSet, 1];
*--------------------------------------------------------------------
SUBROUTINE;.CARCDR:
*--------------------------------------------------------------------
* Call to here has done a TYPREV, so pointer is in LTEMP0,1
* and typetable entry xor’d with listpType is in T
* Exit with hi.word (of cell pointed to) in LTEMP0, and
* with lo.word on Md.
branch[.crnlist, alu#0], pd← BrHi← LTEMP0;*(LTEMP0) xor (AtomHiVal)
.carcdr1:
PAGEFAULTOK;
T← (FETCH← LTEMP1) + 1;
:if[Debugging];
LTEMP0← MD, T← (fetch← T) and (lhmask);
PAGEFAULTNOTOK, Return;
:else;
LTEMP0← MD, T← (fetch← T) and (lhmask), Return;
:endif;
.crnlist:
Branch[.crnlist1, alu#0], pd← (LTEMP1);*(LTEMP1) xor (AT.NIL)
TOPLEVEL;* Entering here on litatoms
Branch[.+2, alu#0];
NextOpCode;* Both Car, Cdr of NIL = NIL
CallUFN;* Punt if arg is non-NIL litatom
SUBROUTINE;
.crnlist1:
Pd← T and (rhmask);
branch[.+2, alu#0], T← (LTEMP1);* Check for non-zero
BrHi← LTEMP0, branch[.carcdr1];* TT.*** bits
TOPLEVEL;
CallUFN;
*--------------------------------------------------------------------
opCAR:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, Call[TYPREV]; * returns with type in T
T← (Id) xor T, memBase← ScratchLZBR, Call[.CARCDR];
.car1:
T← (LTEMP0) and (lhmask);
branch[.+2, alu=0], LTEMP0← T← (LTEMP0) xor T, memBase← StackM2BR;
T← Md, TSP← (store← TSP) + 1, dbuf← T, Branch[REPSMT2];
LTEMP1← Md, pd← A0, memBase← ScratchLZBR, Call[.CARCDR];
Branch[.car1];* Cell is an indirection
regOP1[1, StackM2BR, opCAR, listType!];
*--------------------------------------------------------------------
opCDR:
*--------------------------------------------------------------------
T← (fetch← TSP) + 1, call[TYPREV]; * returns with type in T
Call[.CARCDR], pd← (Id) xor T, memBase← ScratchLZBR;
.cdr1:
LTEMP1← T;* LTEMP1← page base addr
branch[.cdrind, R>=0], LTEMP0, * Hi order bit of cell is
T← ldf[LTEMP0, 7, 10];* "not indirect" flg
T← T + T;* Assuming non-0 cdrcode, this lsh’s it by 1,
* while properly setting the alu branch conditions
branch[.+2, alu#0], T← T + (LTEMP1), memBase← StackM2BR;
* Ah, cdr code indicates CDR is NIL
TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.REPNIL2];
TSP← (TSP) + 1, branch[REPSMT2];* CDR is on same page
.cdrind:* Indirection
T← T + T;
branch[.cdr2, alu#0], T← (LTEMP1) + T;
Call[.CARCDR], LTEMP1← Md, pd← A0,* Ah, full indirection
memBase← ScratchLZBR; * so go around again.
Branch[.cdr1];
.cdr2:
T← (fetch← T) + 1;
* Only local indirect, so fetch from that cell
T← Md, fetch← T, Branch[REPTMD];
regOP1[2, StackM2BR, opCDR, listType!];
:if[Reduced];
UfnOps[30];UfnOps[31];UfnOps[32];* RPLACA, RPLACD, CONS
:else;
*--------------------------------------------------------------------
SUBROUTINE;.RPLFETCH:
*--------------------------------------------------------------------
* Enter with LTEMP0, 1 has address of cell to smash
* typeCode xor listTYpe on pd
* T has typeTable entry (needed only if # listpType)
* Exit with LScratchBR set up to point to cell to smash.
* LTEMP2← has contents of hi.word of that cell
*Q← LTEMP1 (for benefit to opRPLACD)
*T contains 1 (for benefit to opRPLACA)
branch[.rplc1, alu=0], LEFT← (LEFT) + 1, memBase← LScratchBR;
Pd← T and (rhmask);* Maybe typetable entry has
branch[.rplc2, alu=0], BrHi← LTEMP0, T← A0;* non-zero TT.*** bits
TOPLEVEL; CallUFN; SUBROUTINE;* Not a list, so punt out
.rplc1:
BrHi← LTEMP0;* LTEMP0,1 have address of
.rplc2:* cell to smash
BrLo← LTEMP1, T← A0;
PAGEFAULTOK;
T← (FETCH← T) + 1, Q← LTEMP1;* Fetch first word of that
:if[Debugging];* cell in to determine if
LTEMP2← MD;* it is an indirection
PAGEFAULTNOTOK, Return;
:else;
LTEMP2← MD, Return;
:endif;
*--------------------------------------------------------------------
.RPLCKVETCH:
*--------------------------------------------------------------------
* Similar to .rplfetch, except that LTEMP2 has hi.word of address of
* cell to smash; used only by the indirection case.
BrHi← LTEMP2, Branch[.rplc2];
TOPLEVEL;
*--------------------------------------------------------------------
opRPLACA:
*--------------------------------------------------------------------
T← (TSP) - (4c);
T← (fetch← T) + 1, call[TYPREV];
* Returns with memBase set to StackM2BR
.rplaca1:
Pd← T xor (listType), Call[.RPLFETCH];
pd← (LTEMP2) and (lhmask);
branch[.+2, alu=0];
LTEMP4← (2c), Branch[RPLPTR1];* Md still valid
fetch← T;* Full indirection cell
TL.RPLAC:* so re-fetch and then
LTEMP1← Md, Call[.rplckvetch];* carry on.
LTEMP4← (2c), Branch[RPLPTR1];* Md still valid
regOP1[30, StackBR, opRPLACA, NoNData];* RPLACA
*--------------------------------------------------------------------
opRPLACD:
*--------------------------------------------------------------------
T← (TSP) - (4c);
T← (fetch← T) + 1, call[TYPREV];
Pd← T xor (listType);
branch[.rplacd1, alu=0], memBase← LScratchBR,
LEFT← (LEFT) + 1;
Pd← T and (rhmask);* Maybe typetable entry has
branch[.rplacd2, alu=0], BrHi← LTEMP0,* some non-zero TT.*** bits
T← (LTEMP0) - (LTEMP0);
CallUFN;* Not a list, so punt out
.rplacd1:
BrHi← LTEMP0, T← (LTEMP0) - (LTEMP0);* Zero T, and set LScratchBR
.rplacd2:
BrLo← T;* to list cell’s segment
PAGEFAULTOK;
LTEMP1← (FETCH← LTEMP1) + 1, Q← LTEMP1;* Q saves lo.word of cell
LTEMP2← MD;* LTEMP2← hi.word of cell
PAGEFAULTNOTOK;
branch[.rplacdind, R>=0], LTEMP2, * Test hi bit of cell
T← (LTEMP2) and (77400c);
* 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;* Setup NIL test
branch[.rplacdnil, alu=0], pd← T - (LTEMP0);* Setup SameSegP
branch[.rplacdnewcell, alu#0], LTEMP1← Md, T← (Md) xor (LTEMP1);
pd← T and not (rhmask);* Setup SamePagep
branch[.+2, alu=0];
branch[.rplacdnewcell];
.rplacdonpage:* AH! on same page
T← LTEMP0, call[GCADDREF];* Addref new cell
memBase← LScratchBR;
LTEMP1← (fetch← Q) + 1;
LTEMP4← LSH[LTEMP4, 7];
T← Md, LTEMP4← (LTEMP4) or (100000c);
T← T and (77400c);
.rplacdlocal:
*pd has hibyte of former CDR pointer -- maybe Delref it?
branch[.rplacdl1, alu=0], T← RSH[T, 7];
LTEMP1← (LTEMP1) and (lhmask);
LTEMP1← T + (LTEMP1);
T← LTEMP0, Call[GCDELREF];
memBase← LScratchBR;
.rplacdl1:* store new cdrcode
fetch← Q;
T← (rhmask);
T← T and (Md);
T← T + (LTEMP4);
store← Q, dbuf← T, branch[GCOPTAIL];
.rplacdnil:* RPLACD of NIL is
LTEMP4← 100000c;* even easier than
T← (LTEMP2) and (77400c), Branch[.rplacdlocal];* of samepage ptr
.rplacdnewcell:
TSP← (TSP) + (2c);
CallUFN;
.rplacdind:* "local" bit off
branch[.rplacdlocalind, alu#0], T← RSH[T, 7];
* Full indirect, so fetch new cell and go around again
LTEMP0← Md, fetch← LTEMP1;
LTEMP1← Md, branch[.rplacd1];
.rplacdlocalind:* Use CDR code as
LTEMP1← (LTEMP1) and (lhmask);* offset on page
T← T + (LTEMP1);
BrLo← T;
LTEMP4← 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 will hold CDR value
* LScratchBR, LTEMP3 will hold new cons cell address
* LTEMP4 has CDR code
T← (fetch← TSP) + 1, call[TYPREV];
LTEMP2← (Id) xor T, memBase← LScratchBR;
Branch[.consnlist, alu#0], T← BrHi← LTEMP0;
.conslist:* Assume new cell on CDR’s page
T← ldf[LTEMP1, 7, 1];* [src, size, pos];
LTEMP4← T + (200c);* new cdr code
T← (LTEMP1) and (lhmask);* base of CDR’s page
.constail:
LTEMP1← BrLo← T;
PAGEFAULTOK;
FETCH← 0s;
LTEMP3← MD;* word 0 of page: [cnt, nxt]
PAGEFAULTNOTOK;
Branch[.+2, R even], T← LTEMP3← (LTEMP3) - (400c);
* Sub 1 from cnt
.cnsod1: uCodeCheck[badcons];
Branch[.+2, alu>=0], T← T and (rhmask);* T← "next"
branch[.consfail];* trap out if no cells left
Branch[.+2, alu#0], LTEMP1← (fetch← T) + (LTEMP1);
* fetch next
.cnszer: uCodeCheck[badcons];
T← Md, LTEMP3← RSH[LTEMP3, 10];* T← [nxt,x], LTEMP3← cnt
LTEMP3← RCY[LTEMP3, T, 10];* [cnt,nxt]
Branch[.+2, R even], store← 0s, * Store back the frlist ptr
dbuf← LTEMP3;
.cnsod2: uCodeCheck[badcons];
BRLo← LTEMP1;* Br now points to new cell
T← LTEMP0, Call[GCDELREF];* Create 0 cnt for new cell
memBase← ListpDTDBR;
fetch← DTD.COUNTERs;* Increment conscounter
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;* "pulls back" 1 on TSP
LTEMP0← Md, T← (store← T) + 1, dbuf← LTEMP0;
fetch← T; * Save new cell on stack
LTEMP1← Md, store← T, dbuf← LTEMP1;* and LTEMP1← new CAR
T← lsh[LTEMP4, 10];* shift cdrcode, and
T← (LTEMP0) or T, memBase← LScratchBR;* merge with new CAR
* BR has hiloc of new CDR when room available on that page
store← 0s, dbuf← T;* Smash the car/cdr value
store← 1s, dbuf← LTEMP1;* into the new cell
T← LTEMP0, Call[GCADDREF];* addref on new CAR
Case← T - T, memBase← StackBR,* addref on new CDR
Call[GCLOOKUP1];
* Since TSP has already been "pulled back" one cell, the setting
* of memBase to StackBR instead of StackM2BR causes us to read the
* cell just beyond the current TOS -- which was the 2nd arg to CONS,
* namely the CDR value.
LTEMP4← (3c), Branch[GCOPTAIL];
.consnlist:
* CDR is not a list -- test it first for being NIL
pd← T or (LTEMP1), memBase← ListpDTDBR;
branch[.consother, alu#0], LTEMP4← (200c);
.consnil:
fetch← DTD.NEXTPAGEs;
T← Md, memBase← LScratchBR;* T← nxtpage, where the new
LTEMP0← RSH[T, 10];* cons cell will come from
branch[.+2, alu#0], BRHi← LTEMP0;
branch[.consfail];* nxtpage = 0 ?
T← LSH[T, 10], branch[.constail];
.consother:
Pd← (LTEMP2) and (rhmask);* Maybe some non-zero TT.*** bits
branch[.+2, alu#0];* were in the type table?
memBase← LScratchBR,branch[.conslist];
.consfail:
CallUFN;
regOP1[32, StackM2BR, opCONS, listType!];* CONS
:endif;