-- RTReclaimerImpl.Mesa
-- last edited On 15-Oct-81 12:57:29 by Willie-Sue Haugeland
-- last edited On October 19, 1982 5:05 pm by Paul Rovner

DIRECTORY
Inline USING[BITAND, LongNumber, BITOR, LowHalf],
PrincOps USING[StateVector],
Process USING[Yield],
RCMap USING[Index, Base],
RCMapOps USING[GetBase],
RTBasic USING[Pointer],
RTFlags USING[clearing, checking, useMicrocode],
RTMicrocode USING
[RECLAIMEDREF, ALTERCOUNT, ISPIRECLAIMABLE, GETREFERENTTYPE,
FREEOBJECT, PPALTERCOUNT, FREEPREFIXEDNODE, FREEQUANTIZEDNODE,
LONGZERO],
RTOS USING[MyLocalFrame],
RTRefCounts USING
[rcoState, RefCt, rcAbsent, rcoFinalizedRef, ReclaimedRef,
rcoDeleteRef, useUCodedGC, AlterCountEntry,
nObjectsReclaimed, nWordsReclaimed, ProbeIndex, IsPiReclaimable,
nRCEntry, GCState, MapRcePiRef, rcFinalize, --IsOiCushion,--
DisableRC, GCMicrocodeExists],
RTStorageOps USING[OutOfOverflowTable],
RTTypesBasic USING[Type, GetReferentType],
RTTypesBasicPrivate USING
[NPackageRefs, MapTiRcmx, PutForFinalization, DoFREEify,
useCanonicalTypeMicroCode],
RTZones USING
[PZone, SubZone, PFreeNode, PQuantizedZone,
FromCollectibleZone, MapPtrZf, NodeLength, sizeNd, PNode,
MapSziSz, ZoneFinger, MapZiZn, GetSzZi, FreeList, PPrefixedZone],
Runtime USING[CallDebugger],
TrapSupport USING[BumpPC, GetTrapParam];

RTReclaimerImpl: MONITOR -- protects zones
LOCKS zn.LOCK USING zn: PZone
IMPORTS Inline, Process, RCMapOps, RTMicrocode, RTOS,
RTRefCounts, RTStorageOps, RTTypesBasic, RTTypesBasicPrivate,
RTZones, Runtime, TrapSupport
EXPORTS RTRefCounts, RTZones

= BEGIN OPEN RTBasic, RTFlags, RTMicrocode, RTRefCounts, RTStorageOps,
RTTypesBasic, RTTypesBasicPrivate, RTZones;

-- GLOBAL VARIABLES
rcmb: RCMap.Base = RCMapOps.GetBase[].base;
useFreeUCode: BOOLEAN ← RTFlags.useMicrocode;

-- PROCS

-- *** The reclaimer

MapReclaimableObjects: PUBLIC PROC = -- process finalizable and reclaimable objects
{ pi: ProbeIndex ← 0;

DO
npi: CARDINAL;
noneReclaimed: BOOLEAN ← TRUE;
[pi, npi]← (IF useUCodedGC THEN ISPIRECLAIMABLE[pi] ELSE IsPiReclaimable[pi]);

FOR i: CARDINAL IN [0..npi) DO
rce: nRCEntry ← GCState.rceToReclaim[i];
ref: REF ANY ← MapRcePiRef[rce, pi];
rc: RefCt← rce.rc;
refType: Type;
rco: rcoState;

IF checking AND rc = 0
THEN {Runtime.CallDebugger["BadRCEntry"];
WHILE TRUE DO Process.Yield[]; ENDLOOP};

refType ← GetRefType[ref];
IF rc = (rcFinalize - NPackageRefs[refType]) THEN -- reclaim it
{ rco ← [rcChange: rcAbsent - rc, onStack: false];
-- use ALTERCOUNT to change the RefCt to absent, so entry will be taken out of the table
IF useUCodedGC
THEN PPALTERCOUNT[rco, ref] -- can fail if error in table
ELSE AlterCountEntry[rco, ref ! OutOfOverflowTable => GOTO disableRC];

Reclaim[ref, refType ! OutOfOverflowTable => GOTO disableRC]; -- can fail
noneReclaimed ← FALSE;
}
ELSE IF rc = rcFinalize
AND FinalizeIt[ref, refType ! OutOfOverflowTable => GOTO disableRC]
THEN noneReclaimed ← FALSE;
ENDLOOP;
IF noneReclaimed THEN IF pi = LAST[ProbeIndex] THEN RETURN ELSE pi ← pi + 1;
ENDLOOP;
EXITS disableRC => DisableRC[]
};

FinalizeIt: PROC[ref: REF ANY, refType: Type] RETURNS[BOOLEAN] =
{ IF PutForFinalization[refType, ref]
THEN -- PutForFinalization does no RC operations
{IF useUCodedGC
THEN PPALTERCOUNT[rcoFinalizedRef, ref] -- can fail
ELSE AlterCountEntry[rcoFinalizedRef, ref];
RETURN[TRUE]}
ELSE RETURN[FALSE]};

Reclaim: PROC[ref: REF ANY, refType: Type] =
INLINE
{ PAPtr: TYPE = LONG POINTER TO ARRAY OF LONG UNSPECIFIED;
BackPointerMarkBit: CARDINAL = 100000B;
BackPointerUnmarkMask: CARDINAL = 77777B;
IsBackPointer: PROC[ptr: Inline.LongNumber] RETURNS[BOOLEAN] =
INLINE {RETURN[Inline.BITAND[ptr.highbits, BackPointerMarkBit] # 0]};
MarkBackPointer: PROC[ptr: Inline.LongNumber] RETURNS[Inline.LongNumber] =
INLINE {ptr.highbits ← Inline.BITOR[ptr.highbits, BackPointerMarkBit]; RETURN[ptr]};
UnmarkBackPointer: PROC[ptr: Inline.LongNumber] RETURNS[Inline.LongNumber] =
INLINE {ptr.highbits ← Inline.BITAND[ptr.highbits, BackPointerUnmarkMask];
RETURN[ptr]};
prev: LONG POINTER TO REF ← NIL;

DO -- outer loop
UNTIL ref = NIL DO -- inner loop 1
nextx: CARDINAL ← 0;
first: REF ANY ← NIL;

FreeRef: PROC[ref: REF ANY] = {DoFreeRef[ref]};

DoFreeRef: PROC[ref: REF ANY] =
INLINE
{ refToFree: REF ANY;
IF ref = NIL THEN RETURN;
IF checking AND NOT FromCollectibleZone[ref] THEN ERROR;
refToFree ← (IF useUCodedGC THEN RECLAIMEDREF[ref] ELSE ReclaimedRef[ref]);
IF refToFree # NIL
THEN
-- got another. refToFree is NOT in the table, but would have an rc=rcFinalize
{ type: Type = GetRefType[refToFree];
IF NPackageRefs[type] # 0
THEN {IF NOT PutForFinalization[type, refToFree]
THEN
{IF useUCodedGC
THEN ALTERCOUNT[rcoDeleteRef, refToFree]
ELSE AlterCountEntry[rcoDeleteRef,refToFree]}}
ELSE {IF first = NIL THEN first ← refToFree ELSE Push[refToFree]}}};

Push: PROC[r: REF ANY] =
INLINE {IF nextx = 0
THEN {LOOPHOLE[ref, PAPtr][nextx]
← LOOPHOLE[MarkBackPointer[LOOPHOLE[prev]]];
nextx ← 1};
LOOPHOLE[ref, PAPtr][nextx] ← r;
nextx ← nextx + 1};

FREEify: PROC[ptr: Pointer, rcmx: RCMap.Index] =
-- low index to high. DoFreeRef for ea. inner ref
INLINE {WITH rcmr: rcmb[rcmx] SELECT FROM
simple =>
FOR i: CARDINAL IN [0..rcmr.length) DO
IF rcmr.refs[i]
  THEN {DoFreeRef[LOOPHOLE[ptr+i, LONG POINTER TO REF ANY]^]};
ENDLOOP;
oneRef =>
DoFreeRef[LOOPHOLE[ptr+rcmr.offset, LONG POINTER TO REF ANY]^];
ref =>
DoFreeRef[LOOPHOLE[ptr, LONG POINTER TO REF ANY]^];
null => NULL;
ENDCASE => DoFREEify[ptr, rcmx, FreeRef]};

-- ***Start this iteration of inner loop 1 Here***
FREEify[LOOPHOLE[ref], MapTiRcmx[LOOPHOLE[refType]]];

IF nextx = 0
THEN INLFreeObject[LOOPHOLE[ref]]
ELSE prev ← LOOPHOLE[@LOOPHOLE[ref, PAPtr][nextx - 1]];
ref ← first;
refType ← GetRefType[ref];
ENDLOOP; -- inner loop 1

DO -- inner loop 2
IF prev = NIL THEN RETURN;
ref ← prev^;
IF IsBackPointer[LOOPHOLE[ref]]
THEN -- it's a back pointer; container is empty
{ref ← LOOPHOLE[UnmarkBackPointer[LOOPHOLE[ref]]];
INLFreeObject[prev];
prev ← LOOPHOLE[ref]}
ELSE {prev ← prev - SIZE[REF ANY]; EXIT}
ENDLOOP; -- inner loop 2

refType ← GetRefType[ref];

ENDLOOP; -- outer loop
}; -- end Reclaim

GetRefType: PROC[ref: REF ANY] RETURNS[type: Type] =
INLINE { RETURN[IF useCanonicalTypeMicroCode
THEN GETREFERENTTYPE[ref]
ELSE GetReferentType[ref]]};

-- *** The reclaimer (end)

-- NOTE copied in RTTraceAndSweepImpl
INLFreeObject: PROC[ptr: Pointer] =
INLINE
{mz: ZoneFinger = MapPtrZf[ptr];
IF checking
THEN {IF ptr = NIL THEN ERROR;
IF NOT FromCollectibleZone[LOOPHOLE[ptr, REF ANY]]
THEN ERROR};
nObjectsReclaimed ← nObjectsReclaimed + 1;
WITH mz: mz SELECT FROM
sub => {size: CARDINAL = MapSziSz[mz.szi].size;
nWordsReclaimed ← nWordsReclaimed + size;
IF clearing THEN [] ← LONGZERO[ptr, size]};
prefixed =>
{size: CARDINAL = Inline.LowHalf[NodeLength[LOOPHOLE[ptr-sizeNd, PNode]]];
nWordsReclaimed ← nWordsReclaimed + size;
IF clearing THEN [] ← LONGZERO[ptr, size-sizeNd]};
ENDCASE => ERROR;
IF useFreeUCode THEN FREEOBJECT[ptr] ELSE DoFreeObject[ptr]};

-- if FREEOBJECT is not implemented
FreeObjectTrap: PUBLIC PROC[ptr: Pointer] =
{ state: PrincOps.StateVector;
param: CARDINAL;
state← STATE; -- incantation

param ← IF useFreeUCode THEN TrapSupport.GetTrapParam[] ELSE 0;

IF param = 0 THEN useFreeUCode ← FALSE;

DoFreeObject[ptr];

TrapSupport.BumpPC[2];
state.dest← LOOPHOLE[RTOS.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
};

-- NOTE copied in RTTraceAndSweepImpl
DoFreeObject: PROC[ptr: Pointer] =
INLINE
{ mz: ZoneFinger;
IF checking THEN
{ IF ptr = NIL THEN ERROR;
IF NOT FromCollectibleZone[LOOPHOLE[ptr, REF ANY]] THEN ERROR};
mz ← MapPtrZf[ptr];
WITH mz: mz SELECT FROM
sub => FreeQuantizedNode[ptr, LOOPHOLE[MapZiZn[GetSzZi[mz.szi]]], MapSziSz[mz.szi]];
prefixed => FreePrefixedNode[ptr, LOOPHOLE[MapZiZn[mz.zi]]];
ENDCASE};

-- OBJECT FREEING

-- *** The Quantum Object Free-er
FreeQuantizedHeapObject: PUBLIC PROC[self: LONG POINTER TO PQuantizedZone,
object: LONG POINTER] =
{ IF checking
THEN {IF object = NIL
THEN {Runtime.CallDebugger["Attempt to FREE NIL; Proceed at your peril"];
RETURN};
IF FromCollectibleZone[LOOPHOLE[object, REF ANY]]
THEN DO Runtime.CallDebugger
["Attempt to treat a REF as if from an uncounted zone"];
ENDLOOP};
IF useFreeUCode
THEN FREEQUANTIZEDNODE[object, self^]
ELSE FreeQuantizedNode[object,
self^,
MapSziSz[LOOPHOLE[MapPtrZf[object], sub ZoneFinger].szi]]};

-- NOTE copied in RTTraceAndSweepImpl
FreeQuantizedNode: ENTRY PROC[ptr: Pointer, zn: PZone, sz: SubZone] =
INLINE
{LOOPHOLE[ptr, FreeList]^ ← sz.fl; sz.fl ← ptr};

-- if FREEQUANTIZEDNODE is not implemented
FreeQuantizedNodeTrap: PUBLIC PROC[ptr: Pointer, zn: PZone] =
{ state: PrincOps.StateVector;
param: CARDINAL;
state← STATE; -- incantation

param ← IF useFreeUCode THEN TrapSupport.GetTrapParam[] ELSE 0;

IF param = 0 THEN useFreeUCode ← FALSE;

FreeQuantizedNode[ptr, zn, MapSziSz[LOOPHOLE[MapPtrZf[ptr], sub ZoneFinger].szi]];

TrapSupport.BumpPC[2];
state.dest← LOOPHOLE[RTOS.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
};

-- *** The Quantum Object Free-er (end)

-- *** The Prefixed Object Free-er
FreePrefixedHeapObject: PUBLIC PROC[self: LONG POINTER TO PPrefixedZone, object: LONG POINTER] =
{ IF checking THEN
{ IF object = NIL THEN ERROR;
IF FromCollectibleZone[LOOPHOLE[object, REF ANY]] THEN ERROR;
WITH self.linkage SELECT FROM
heap => IF typeRepresentation THEN ERROR;
ENDCASE => ERROR};
IF useFreeUCode
THEN FREEPREFIXEDNODE[object, self^]
ELSE FreePrefixedNode[object, self^]};

-- if FREEPREFIXEDNODE is not implemented
FreePrefixedNodeTrap: PUBLIC PROC[ptr: Pointer, zn: PZone] =
{ state: PrincOps.StateVector;
param: CARDINAL;
state ← STATE; -- incantation

param ← IF useFreeUCode THEN TrapSupport.GetTrapParam[] ELSE 0;

IF param = 0 THEN useFreeUCode ← FALSE;

FreePrefixedNode[ptr, zn];

TrapSupport.BumpPC[2];
state.dest← LOOPHOLE[RTOS.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
};

-- NOTE copied in RTTraceAndSweepImpl
FreePrefixedNode: ENTRY PROC[ptr: Pointer, zn: PZone] =
INLINE {LinkHeapNode[ptr-sizeNd, @LOOPHOLE[zn, PPrefixedZone].fnd]};

-- NOTE copied in RTPrefAllocImpl, RTTraceAndSweepImpl
LinkHeapNode: PROC[pfn, pfnPrev: PFreeNode] =
INLINE
{pfnNext: PFreeNode = pfnPrev.pfnNext;
pfn.body ← free[pfnPrev: pfnPrev, pfnNext: pfnNext];
pfnNext.pfnPrev ← pfn;
pfnPrev.pfnNext ← pfn};

-- *** The Prefixed Object Free-er (end)


-- START HERE

useFreeUCode ← useFreeUCode AND RTRefCounts.GCMicrocodeExists;

END.