{	<tajo>LispRecl.mc
Last edit:      9-Mar-84 12:30:37 by don
}

{- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
172      RECLAIMCELL 0        0                  \GCRECLAIMCELL

\CDR.NIL= 200q

LISTPDTD is the DTD for type LISTP, i.e., at DTDbase + (LLSH ListType 4)


Cons pages start with two word header:
	word 0: [cnt, nxtcell]	(two 8-bit fields: count of available cells
				on this page, and word# of next free cell
				on this page)
	word 1: nextpage	(page# of next cons page) {negative if not on free chain}

If not LISTP then punt
Reclaim list:
	code←PTR:cdrcode
	if (code and 200q) = 0 then punt	[or optional: if code = 0 then punt]
	FreeListCell(PTR)
	val← deleteref(PTR:carfield)		* deleteref CAR
	if code # \CDR.NIL
	  then PTR←PTR:pagebase + (code lsh 1) * point to cdr or lvcdr
		{ if (code and 200q) = 0		* optional
		    then FreeListCell(PTR)		* cdr indirect--free cell
		    PTR← GetBasePtr(PTR)] }
	if deleteref(PTR)			* deleteref CDR
	  then val←PTR
	return val

FreeListCell(PTR):

	PAGE ← address of PTR's page
	if PAGE:Nextpage < 0 then punt	* only when page was full
	PTR:cdrcode ← PAGE:nextcell
	PAGE:nextcell ← word# of PTR
	PAGE:count ← PAGE:count + 1


How to reclaim other types, roughly (needs type table change):
	if Type bit "ok to reclaim" is off, call UFN
	store DTD:FREELST in first two words of DATUM
	store DATUM in DTD:FREELST

[not required; implemented for Listp on D0, Dorado?]

- - - - - - - - - - - - - - - - - - - - - - - - - -}

	SetTask[0];

@RECLAIMCELL:	opcode[172'b],
	TT ← 172'b, L2 ← L2.Recl,	c1;
	{Xbus ← TOSH LRot12, XDisp, }GOTO[NewTypC3],	c2;
{	
	NewTyp will call ufn[TT] if tos is not a valid LISP pointer (i.e. if it is larger than a 22 bit number).
	ELSE: typ increments PC by a byte, returns Q:0FF; Rx: real address of type table entry. 
}

	{fetch Type}
	MAR ← [rhRx, Rx], Rx ← ListType + 0,	c1, at[L2.Recl,10, NewTypRet];
	rhTT ← TOSH LRot0,	c2;
	Q ← MD{Type} xor Rx,	c3;

	{map PTR -- last place for fault}
	Map ← TT ← [rhTT, TOS], L0 ← L0.RedoRecl	c1;
	PC ← PC - PC16, L1 ← L1.NoFixes,	c2;
	rhRx ← Rx ← MD, XwdDisp,	c3;

	MAR ← [rhRx, TOS + 0], DISP2[ReclMap],	c1, at[L0.RedoRecl, 10, WMapFixCaller];
	Ybus ← Q - 1, PgCarryBr,	c2, at[1, 4, ReclMap];{test Type=ListP?}
	TT ← MD{CDR,,CARhi}, BRANCH[$, ReplNotListufn],	c3;{get hi cell contents}

	MAR ← [rhRx, TOS + 1],	c1;
	uCARhi ← TT, NegBr, CANCELBR[$, 2],	c2;{test if cdrcode and 200 = 0}
	Q ← MD{CARlo}, BRANCH[ReclIndufn, $],	c3;{get lo cell contents}


{SUBROUTINE?: FLC  --  FreeListCell(PTR):

	PAGE ← address of PTR's page
	if PAGE:Nextpage < 0 then punt	* only when page was full
	PTR:cdrcode ← PAGE:nextcell
	PAGE:nextcell ← word# of PTR
	PAGE:count ← PAGE:count + 1
}

{	assume real addr of PTR in rhRx  Rx TOS }
	MAR ← [rhRx, 1 + 0],	c1;
	uCARlo ← Q,	c2;
	TT ← MD{nextpage},	c3;{get wd 1 of page = nextpage}

	MAR ← [rhRx, 0 + 0],	c1;
	Ybus ← TT, NegBr,	c2;{test if nextpage < 0 : if so ufn}
	Q ← MD{cnt,,nxtcell}, BRANCH[$, ReclPgFullufn],	c3;{get wd 0 of page}

	uNxtCell ← Q,	c1;{save old nxtcell}
	TT ← TOS and 0FF,	c2;{TT ← new nxtcell}
	Q ← Q and ~0FF,	c3;{Q ← old cnt in Hi}

	Q ← TT{new nxtcell  Lo} or Q{old cnt  Hi},	c1;{merge cnt and new nxtcell}
	Q ← Q + 0FF + 1,	c2;{add 1 to old cnt}
	TT ← uNxtCell,	c3;{TT ← old nxtcell}

	MAR ← [rhRx, 0 + 0],	c1;{rewrite  cnt,,nxtcell}
	MDR ← Q,	c2;{ = cnt + 1,,new nxtcell}
	TT ← TT LRot8,	c3;{TT ← old nxtcell,,garbage}

	MAR ← [rhRx, TOS + 0],	c1;{PTR:cdrcode ← PAGE:nextcell}
	MDR ← TT, L2 ← L2.Recl1,	c2;
	uTOS ← TOS,	c3;{set tos to NIL}

	uTOSH ← TOSH,	c1;
	TOS ← uGcLov ← 0,	c2;
	TOSH ← uGcZero ← 0,	c3;

	{delref to CAR}
	{use PTR for all 24 bits}
	Rx ← uCARhi,	c1;
	TT ← uCARlo,	c2;
	Rx ← Rx and 0FF,	c3;

	Q ← Q.DelRef, CALL[GcLookup],	c1;

	Ybus ← uGcZero, ZeroBr,	c2, at[L2.Recl1, 10, GcLookRet];
	BRANCH[$, ReclLvtos1],	c3;

	TOS ← uGcLlo,	c1;
	TOSH ← uGcLhi,	c2;
	uGcZero ← 0,	c3;

ReclLvtos1:
	{delref to CDR}
	{use @PTR: for high 16 bits, cdrcode for low 8}
	{verify that not cdrnil}
	TT ← uTOS, L2 ← L2.Recl2,	c1;
	TT ← TT and ~0FF,	c2;
	Rx ← uCARhi,	c3;

	Rx ← Rx LRot8,	c1;
	Rx ← LShift1 (Rx and 07F), SE ← 0,	c2;
	Ybus ← Rx, ZeroBr,	c3;{test if cdrNIL}

	TT ← TT or Rx, BRANCH[$, ReclCdrNil]	c1;
	Rx ← uTOSH,	c2;
	Rx ← Rx and 0FF,	c3;

	Q ← Q.DelRef, CALL[GcLookup],	c1;

	Ybus ← uGcZero, ZeroBr, L3{ib's} ← 0,	c2, at[L2.Recl2, 10, GcLookRet];
	Ybus ← uGcLov{set by GcLookup}, NZeroBr,  BRANCH[ReclFixtos, $],	c3;

	Rx ← AtomGCSCAN {371'b}, BRANCH[ReclNoOvXit, ReclOvXit],	c1;

ReclFixtos:
	TOS ← uGcLlo, CANCELBR[$],	c1;
	TOSH ← uGcLhi,	c2;
ReclX1:
	Ybus ← uGcLov{set by GcLookup}, NZeroBr, L3{ib's} ← 0,	c3;

ReclX2:
	Rx ← AtomGCSCAN {371'b}, BRANCH[ReclNoOvXit, ReclOvXit],	c1;

ReclNoOvXit:
	L2 ← L2.0, IBDisp, GOTO[DNI.pc1],	c2;

ReclOvXit:
	GOTO[RplFNXIT],	c2;

{	IB ← Rx LRot0,	c3;

	MAR ← Q ← [rhS, S + 1], IBPtr ← 0, GOTO[FN1Ext],	c1;}

	GOTO[WLMapFix],	c2, at[0, 4, ReclMap];
	GOTO[WLMapFix],	c2, at[2, 4, ReclMap];
	GOTO[WLMapFix],	c2, at[3, 4, ReclMap];

ReclCdrNil:
	GOTO[ReclX1],	c2;

ReplNotListufn:
	GOTO[ufnX2],	c1;

ReclIndufn:
	GOTO[ufnX2],	c1;

ReclPgFullufn:
	GOTO[ufnX2],	c1;

	{ E N D }