:Title[LGC.mc];
*
* Edit History
* February 28, 1986  1:15 PM, Masinter, new GC overflow algorithm
* 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];

* constants:

mc[HT1CNT, 4000];
mc[HTSTKBIT,1000];
mc[HTCNTMASK,176000];
mc[HTMAINSIZE,100000];
mc[HTCOLLSIZE,177770];
mc[HTENDFREE,1];
mc[HTFREEPTR,0];
mc[htStkCnt, add[htstkbit!, htcntmask!]];

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], BDispatch_ Case;
		Branch[.htpunt];
	T_ ENTRY, Branch[.htprobe]; 					*  size about to be exceeded

.htprobe:   DispTable[3],
	T_ T + (ht1cnt), branch[.htaddref];			* case 0: addref
	T_ T - (ht1cnt), branch[.htdelref];			* case 1: delref
	T_ T or (htstkbit), Branch[.htstore];		* case 2: stkref

.htaddref:
	LTEMP3_ T and (htStkCnt), branch[.+2, carry'];
		branch[.htpunt];
	pd_ (LTEMP3) xor (ht1cnt), Branch[.htxit];

.htdelref:
	LTEMP3_ T and (htStkCnt), branch[.+2, carry];
		branch[.htpunt];
	pd_ (LTEMP3) xor (ht1cnt), Branch[.htxit];

.htstore:
	LTEMP3_ T and (htStkCnt);
	pd_ (LTEMP3) xor (ht1cnt), Branch[.htxit];

* 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
(635)\f8 1093f0 6f8 9f0 121f8 692g