{	<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 }