{
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];
{ }
opcode[172'b],
{optionally hooked up}
{ TT ← uLispOptions, c1;
TT ← TT, ZeroBr, c2;
BRANCH[@RECLAIMCELL, ReclAbort], c3;
ReclAbort:
GOTO[ufnX2], c1;
}
{ Rx ← 172'b, GOTO[ufn2], c1;}
@RECLAIMCELL:
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;
L1 ← L1.DecOnly, 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}
{ PC ← PC - PC16, GOTO[ufnX2], c1;
LABEL: }
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, c2, at[L2.Recl2, 10, GcLookRet];
BRANCH[$, ReclLvtos2], c3;
TOS ← uGcLlo, c1;
TOSH ← uGcLhi, c2;
, c3;
ReclLvtos2:
, c1;
Rx ← uGcLov{set by GcLookup}, c2;
ReclX1:
Ybus ← Rx, NZeroBr, L3{ib's} ← 0, c3;
Rx ← AtomGCSCAN {371'b}, BRANCH[ReclNoOvXit, ReclOvXit], c1;
ReclNoOvXit:
L2 ← L2.0, IBDisp, GOTO[DNI.nop], c2;
ReclOvXit:
PC ← PC - PC16, 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:
Rx ← uGcLov{set by GcLookup}, GOTO[ReclX1], c2;
ReplNotListufn:
PC ← PC - PC16, GOTO[ufnX2], c1;
ReclIndufn:
PC ← PC - PC16, GOTO[ufnX2], c1;
ReclPgFullufn:
PC ← PC - PC16, GOTO[ufnX2], c1;
{ E N D }