:Title[LGC.mc];
*
* Edit History
* March 13, 1985 9:46 AM, Masinter, remove call to SAVEUCODESTATE
* January 19, 1985 2:38 PM, Masinter, add nop before repNIL to break ring
* February 9, 1984 3:28 AM, JonL, added a "cancel BDispatch" at .htpunt
* February 9, 1984 12:20 AM, JonL, remove A← Id from GCOPTAIL;
* January 26, 1984 10:31 PM, JonL, Globalize GCLOOKUP; change .htprobe
*DispTable size from 5 to 3.
* January 13, 1984 9:25 PM, JonL, moved in REPNIL from lstack
* January 3, 1984 9:00 PM, JonL, .gcscanfail tails to REPNIL
* December 27, 1983 5:55 PM, JonL, Replaced GCLOOKT1 with
*GCADDREF and GCDELREF
* December 27, 1983 11:42 AM, JonL, changed A0 to (Case) - (Case),
* re-arranged GCLOOKT1 exit code
* December 21, 1983 9:21 AM, JonL, removed one inst from RPLPTR
*opGCSCAN from LOW
* December 20, 1983 9:02 AM, JonL, AT.GCMAPTABLE and AT.HANDLEOVERFLOW
*given correct meanings, and tail GCREF into REPNIL
* December 6, 1982 1:44 PM, Masinter
*
KnowRBase[LTEMP0];
TOP LEVEL;
InsSet[LispInsSet, 1];
:if[Reduced];
UfnOps[25];UfnOps[24];* GCREF and RPLPTR
:else;
*--------------------------------------------------------------------
opGCREF:
*--------------------------------------------------------------------
* Modify refcnt of argument, according to Case (obtained from id)
* Returns argument iff resultant refcnt is 0
Case← (Id) + (100000c);
T← (fetch← TSP) + 1, call[GCLOOKUP];
pd← T, memBase← StackM2BR;
Branch[.+2, alu#0], pd← T and (htstkcnt);* Null entry means a
Branch[REPNIL];* refcnt of 1
Branch[.+2, alu#0];
NextOpCode;
nop;
REPNIL:GLOBAL,* Smashes a NIL onto top of stack
TSP← (store← TSP) + 1, dbuf← (AtomHiVal), Branch[TL.REPNIL2];
TL.REPNIL2:
* Assumes TSP is correct and StackM2BR is memBase
TSP← (store← TSP) - 1, dbuf← AT.NIL, NextOpCode;
regOP2[25, StackM2BR, opGCREF, noNData];
*--------------------------------------------------------------------
opRPLPTR:* takes (PTR VAL) on stack, alpha byte is offset
*--------------------------------------------------------------------
* Replace pointer at PTR+offset with VAL, doing two reference counts
T← (TSP) - (4c);
LTEMP4← T← (fetch← T) + 1;
LTEMP0← Md, fetch← T;* segno of PTR address
T← Md, LEFT← (LEFT) + 1, memBase← LScratchBR;
T← (Id) + (T);
Branch[.+2, carry’], BrLo← T;
LTEMP0← (LTEMP0) + 1;* Crossed a segment boundary
BrHi← LTEMP0;* Setup BR to point to cell
PAGEFAULTOK;
T← (fetch← 0s) + 1, Branch[RPLPTR1];* Start fetch of cell
regOP2[24, StackBR, opRPLPTR, noNData];
* Note that we are still under the influence of an :else "NotReduced"
*--------------------------------------------------------------------
RPLPTR1:
*--------------------------------------------------------------------
* Tail into here with LScratchBR pointing to cell to smash
* T← (fetch← 0s) + 1 just done
* TSP contains value to put into cell
Case← 1c, Call[GCLOOKUP];* deleteref old pointer
TSP ← (TSP) - (2c);
memBase← StackBR;
*--------------------------------------------------------------------
RPLPTRTAIL:
*--------------------------------------------------------------------
* Tail into here with LScratchBR pointing to cell to smash
* TSP contains value to put into cell
Case← T - T;
T← (fetch← TSP) + 1, Call[GCLOOKUP];* addref new value
memBase← LScratchBR;
fetch← 0s;
T← Md;
T← T and (lhmask);
T← T + (LTEMP0);* put high bits back
store← 0s, dbuf← T;* store new value
store← 1s, dbuf← LTEMP1;
*--------------------------------------------------------------------
GCOPTAIL:
*--------------------------------------------------------------------
* Final check, after an instruction has munged around with GCREF stuff,
* as to whether there are collision entries in the overflow table,
* or some space’s cons counter has exceeded its maximum. Note that
* the latter condition has priority, since its associated function
* does both kinds of actions.
* A lot of instructions branch to here, but it needn’t be global since
* these instructions often can use a full branch
pd← (PSTATE) and (or[PS.HTCNTFULL!, PS.HTOVERFLOW!]c);
Branch[.+2, alu#0], PSTATE← (PSTATE) and not (PS.HTOVERFLOW);
NextOpCode;* Neither bit is set
Branch[.+2, alu#0], PSTATE← (PSTATE) and not (PS.HTCNTFULL);
DEFLO← AT.HANDLEOVERFLOW, Branch[.gcoptl1];* PS.HTOVERFLOW set
DEFLO← AT.GCMAPTABLE; * else PS.HTCNTFULL
.gcoptl1:
NARGS← (1c), Branch[DOCALLPUNT];
* Note that we are still under the influence of an :else "NotReduced"
SUBROUTINE;
*--------------------------------------------------------------------
GCADDREF:
*--------------------------------------------------------------------
* Enter with LTEMP0, LTEMP1 containing pointer to be "counted",
* and with T← LTEMP0.
memBase← tyBaseBR, Case← T - T,Goto[.gclkup2];
*--------------------------------------------------------------------
GCDELREF:
*--------------------------------------------------------------------
* Enter with LTEMP0, LTEMP1 containing pointer to be "counted".
* and with T← LTEMP0.
memBase← tyBaseBR, Case← T - T;
Case← (Case) + 1,Goto[.gclkup2];
*--------------------------------------------------------------------
GCLOOKUP: GLOBAL,
*--------------------------------------------------------------------
* Enter with Case = 0 => add 1 to refcnt
* 1 => sub 1 from refcnt
* 2 => turn on stkref bit
* T← (fetch← hi.word) + 1 done
* Do the refcnt operation on the contents of the cell whose lo.word
*is currently being pointed to by T (modulo memBase)
* Exit with LTEMP0, LTEMP1 containing pointer (which was "counted")
* T has entry in htable
T← MD, fetch← T, Goto[.gclkup1];* Could fault
*--------------------------------------------------------------------
GCLOOKUP1:
*--------------------------------------------------------------------
* Do the refcnt operation on the contents of the cell whose lo.word
*is currently being pointed to by TSP (modulo memBase); otherwise,
* this is the same as GCLOOKUP
T← (fetch← TSP) + 1;* Could fault, so callers
T← MD, fetch← T;* should have set PSTATE
.gclkup1:
PAGEFAULTNOTOK;
T← T and (rhmask), LTEMP1← Md;* Lo.word of cell shouldn’t
memBase← tyBaseBR, LTEMP0← T;* fault, since hi.word won
.gclkup2:* Here, both T and LTEMP0 must contain the hiword of the ptr
T← rcy[T, LTEMP1, 11];* Each typetable entry is
fetch← T;* for a double page
PROBE← Md, memBase← htMainBR;
Branch[.+2, R>=0], pd← (PROBE) and (TT.LISPREF);
T← A0, Return;* TT.NOREF bit was set
Branch[.+2, alu=0], T← (LTEMP1) rsh 1;
* Punt, if type is such that datum must be refcnt’d by Lisp code.
LTEMP2← Link, Branch[.htpunt];
PROBE ← fetch ← T;* fetch GC main table entry
ENTRY ← Md, T← (LTEMP0) + (LTEMP0);* T← (LTEMP0) lsh 1
Branch[.+2, R even], pd← ENTRY;* Bit 15 is "linkp" bit
LTEMP2← Link, Branch[.htpunt];* Punt when entry is chain
DblBranch[.htempty, .htnotempty, alu=0],* link to collision table
LTEMP2← Link;* Save Link before dispatch
TOP LEVEL;
.htempty:
BDispatch← Case;
T← T or (ht1cnt), Branch[.htprobe];
.htnotempty:
T← ldf[ENTRY, 10, 1];* get hi addr bits of entry
pd← T xor (LTEMP0);* compare hi bits of pointer
Branch[.+2, alu=0], pd← (ENTRY) + (add[ht1cnt!, ht1cnt!]c);
Branch[.htpunt];* Punt when pointer in table
Branch[.+2, carry’], BDispatch← Case;* is not same as argument
Branch[.htpunt];* Also, punt if cnt field
T← ENTRY, Branch[.htprobe]; * size about to be exceeded
.htprobe: DispTable[3],
T← T + (ht1cnt), Branch[.htstore];* case 0: addref
T← T - (ht1cnt), Branch[.htstore];* case 1: delref
T← T or (htstkbit), Branch[.htstore];* case 2: stkref
.htstore:
LTEMP3← T and (htStkCnt);
pd← (LTEMP3) xor (ht1cnt), Branch[.htxit];
* Grumble, the following DispTable is effectively a "Cancel BDispatch"
* for the BDispatch generated in the conditional branch above.
.htpunt:DispTable[1,3,3],
Branch[.+2, R>=0], Case, T← A0, MemBase← htOfloBR;
CallUFN;
* When Case negative, do UFN immediately (this should only be used by
* the GCREF opcode)
* Otherwise, enter the puntout address in the "overflow" table
* for future processing by \GC.HANDLEOVERFLOW
.htpuntloop:
T← (fetch← T) + 1;
pd← Md;
Branch[.+2, alu=0], PSTATE← (PSTATE) or (PS.HTOVERFLOW);
T← T + 1, Branch[.htpuntloop];
LTEMP3← (store← T) - 1, dbuf← LTEMP1;
T← LSH[Case, 10];
T← T + (LTEMP0);
store← LTEMP3, dbuf← T;
SUBROUTINE;
Link← LTEMP2;
Return;
.htxit:
Branch[.+2, alu=0], Link← LTEMP2;
store← PROBE, dbuf← T, Return;* Normal return -- table entry
store← PROBE, T← (dbuf← 0c), Return;* but return 0 when count is 1
TOPLEVEL;
:endif;* Reduced
*--------------------------------------------------------------------
* scan GC tables
*--------------------------------------------------------------------
:if[Reduced];
UfnOps[173];UfnOps[174];* GCSCAN1 and GCSCAN2
:else;
*--------------------------------------------------------------------
opGCSCAN1:
*--------------------------------------------------------------------
T← (TSP) - 1;
fetch← T, LTEMP0← (-2c), branch[.gcscan];
*--------------------------------------------------------------------
opGCSCAN2:
*--------------------------------------------------------------------
T← (TSP) - 1;
fetch← T, LTEMP0← (HTSTKBIT), branch[.gcscan];
.gcscan:
LTEMP1← Md, memBase← htMainBR;
LTEMP1← (LTEMP1) - 1, Q← LTEMP1;
.gcscanlp:
branch[.gcscanfail, R<0], LTEMP1;
LTEMP1← (fetch← LTEMP1) - 1, Q← LTEMP1;
LTEMP2← Md, T← LTEMP0;
branch[.+2, R even], pd← (LTEMP2) and T;
memBase← StackBR, TSP← (TSP) - 1, branch[.gcfoundret];
branch[.gcscanlp, alu=0], pd← T;
dblbranch[.gcfound1, .gcfound2, alu<0], pd← (LTEMP2) and (HTSTKCNT);
.gcfound1:
branch[.gcfoundret, alu=0], memBase← StackBR, TSP← (TSP) - 1;
memBase← htMainBR, TSP← (TSP) + 1, branch[.gcscanlp];
.gcfound2:
LTEMP2← (LTEMP2) and not T, memBase←htMainBR;* Turn off stkbit
T← (LTEMP2) and (HTSTKCNT);
T← T - (HT1CNT);
branch[.+2, alu#0];
store← Q, dbuf← T, branch[.gcscanlp];* Refcnt went to 1
store← Q, dbuf← LTEMP2, branch[.gcscanlp];* Restore word
.gcfoundret:
TSP← (store← TSP) + 1, dbuf← Q, NextOpCode;
.gcscanfail:
memBase← StackM2BR, branch[REPNIL];
regOP1[173, StackBR, opGCSCAN1, NoNData];
regOP1[174, StackBR, opGCSCAN2, NoNData];
:endif; * reduced