-- RTTraceAndSweepImpl.mesa
-- last change by Russ Atkinson, 17-Jul-81 12:23:33
-- last change by Willie-Sue Haugeland, 31-Jul-81 13:40:47
-- last change by Paul Rovner, November 29, 1982 5:42 pm

-- This module implements a trace-and-sweep garbage collector for
-- Cedar ("DoTraceAndSweepCollection"). It uses auxilliary storage for bit tables
-- and reference stacks. To allow subsequent incremental collection,
-- DoTraceAndSweepCollection restores reference counts to correct values.
-- No collectible storage is allocated while DoTraceAndSweepCollection
-- is active, nor are any REFs change in counted storage during
-- that time. Client processes that attempt to do so are suspended
-- until after DoTraceAndSweepCollection finishes.

DIRECTORY
Environment: TYPE USING [wordsPerPage],
Inline: TYPE USING [LowHalf, LongNumber],
Mopcodes: TYPE USING [zAND, zLIB],
PilotLoadStateOps: TYPE USING [InputLoadState, ReleaseLoadState],
PrincOps: TYPE USING
[CSegPrefix, GlobalFrame, GlobalFrameHandle, MainBodyIndex],
Process: TYPE USING [Yield],
ProcessOperations: TYPE USING [LongEnter, LongExit],
RCMap: TYPE USING [nullIndex],
RTBases: TYPE USING [BaseOverhead],
RTBasic: TYPE USING [Address, Pointer, nullType],
RTCommon: TYPE USING [ShortenLongCardinal],
RTFlags: TYPE USING [checking, clearing, takingStatistics],
RTLoader: TYPE USING [GetGFRCType],
RTMicrocode: TYPE USING [RTMOVESTATUS, LONGZERO],
RTOS: TYPE USING
[EnumerateGlobalFrames, MapRCFrameBodies, SnapshotTheFrameHeap,
FreeableSpaceZone, GetDataPagesFromNewSpace, GetCurrent, FrameCopySpaceTooSmall,
AllocateFrameBodyBuffer],
RTQuanta: TYPE USING [QuantumIndex, QuantumSize, PtrToQtmIndex, LASTAddress],
RTRefCounts: TYPE USING [ClearRCTable, DecrementReferenceCount, nWordsReclaimed,
IncrementReferenceCount, GCState, gcStopped, gcRunning,
nObjectsReclaimed, frameBodyBufferPages],
RTStorageOps: TYPE USING [OutOfOverflowTable],
RTTypesBasic: TYPE USING [Type, GetReferentType],
RTTypesBasicPrivate: TYPE USING [MapTiRcmx, MapRefs, NPackageRefs],
Runs: TYPE USING [Run],
RTZones: TYPE USING
[GetSzSize, GetSzZi, PZone, SubZone, PFreeNode, FromCollectibleZone,
ZoneFinger, MapQZf, MapPtrZf, mzVacant, PNode, MapSziSz, PPrefixedZone,
MapZiZn, InusePNode, NodeLength,
Zone, SubZoneArray, FreeList, sizeNd, ZoneIndex];

RTTraceAndSweepImpl: MONITOR
IMPORTS Inline, PilotLoadStateOps, Process, ProcessOperations, RTCommon,
RTLoader, RTMicrocode, RTOS, RTQuanta, RTRefCounts, RTStorageOps,
RTTypesBasic, RTTypesBasicPrivate, RTZones
EXPORTS RTRefCounts
= BEGIN OPEN Environment, RTZones, RTMicrocode;

-- Variables
traceAndSweepEnabled: BOOLEAN ← TRUE;
countingOn: BOOLEAN ← TRUE;
quantizedCellsInitiallyFreed: LONG CARDINAL;
quantizedObjectsInitiallyFreed: LONG CARDINAL ← 0;
refStackChain: RefStack ← NIL;
refStackFree: RefStack ← NIL;

-- interesting statistics
prefixedObjectsMarkedFree: LONG CARDINAL ← 0;
prefixedObjectsReclaimed: LONG CARDINAL ← 0;
prefixedObjectsKept: LONG CARDINAL ← 0;
quantizedObjectsReclaimed: LONG CARDINAL ← 0;
quantizedObjectsKept: LONG CARDINAL ← 0;
nGlobalFrames: LONG CARDINAL ← 0;
nLocalFrames: LONG CARDINAL ← 0;
quantizedObjectsSeen: LONG CARDINAL ← 0;
prefixedObjectsSeen: LONG CARDINAL ← 0;

BankTableArray: TYPE = ARRAY [0..MaxBank] OF BankTablePtr;
bankTableArray: LONG POINTER TO BankTableArray
← RTOS.FreeableSpaceZone.NEW[BankTableArray ← ALL[NIL]];

-- debugging aids
SuspectSeen: SIGNAL = CODE;
suspect: LONG POINTER TO UNSPECIFIED ← LOOPHOLE[LONG[-1]];
BadObjectStart: ERROR = CODE;

checkMarkRef: BOOLEAN ← FALSE;
checkTraceObject: BOOLEAN ← FALSE;

bugRefs: CARDINAL ← 0;
bugRefArray: ARRAY [0..8) OF ParsedRef
← ALL[ParsedRef[word: 1, prefixed: TRUE, pad: 0, bank: 0]];
BugRefFound: SIGNAL = CODE;
SignalBugRefFound: PROC = { SIGNAL BugRefFound};
CheckBugRef: PROC [pr: ParsedRef] = {
FOR i: CARDINAL IN [0..bugRefs) DO
npr: ParsedRef ← bugRefArray[i];
IF pr.word = npr.word AND pr.bank = npr.bank THEN
SignalBugRefFound[ ! UNWIND => CONTINUE ];
ENDLOOP};

-- TYPEs and constants
ParsedNil: ParsedRef = [word: 0, prefixed: FALSE, pad: 0, bank: 0];

BankTableSize: CARDINAL = 4096; -- words (2^bitsPerWord / bitsPerWord)
BankTablePages: CARDINAL = BankTableSize / wordsPerPage; -- 16
MaxBank: CARDINAL = LOOPHOLE[RTQuanta.LASTAddress/(LONG[LAST[CARDINAL]] + 1),
Inline.LongNumber].lowbits; --63

ParsedRef: TYPE = MACHINE DEPENDENT RECORD
[word (0): CARDINAL,
prefixed (1: 0..0): BOOLEAN,
pad (1: 1..7): [0..63],
bank (1: 8..15): [0..255]];

BankTable: TYPE = PACKED ARRAY CARDINAL OF BOOLEAN;
BankTablePtr: TYPE = LONG POINTER TO BankTable;
Pair: TYPE = MACHINE DEPENDENT RECORD [low, high: CARDINAL];
PhonyTable: TYPE = ARRAY INTEGER [0..BankTableSize) OF CARDINAL;
PhonyTablePtr: TYPE = LONG POINTER TO PhonyTable;
RefStackRep: TYPE = RECORD [next: RefStack,
size, max: CARDINAL,
refs: SEQUENCE COMPUTED CARDINAL OF ParsedRef];
RefStack: TYPE = LONG POINTER TO RefStackRep;

BadAddress: ERROR = CODE;

-- PROCS
IncRC: PROC [ref: REF ANY] =
INLINE
{IF countingOn
THEN RTRefCounts.IncrementReferenceCount
[ref ! RTStorageOps.OutOfOverflowTable => {countingOn ← FALSE; CONTINUE}]};

DecRC: PROC [ref: REF ANY] =
INLINE
{IF countingOn
THEN RTRefCounts.DecrementReferenceCount
[ref ! RTStorageOps.OutOfOverflowTable => {countingOn ← FALSE; CONTINUE}]};

-- local space management

NewPages: PROC [pages: CARDINAL] RETURNS [LONG POINTER] = {
RETURN [RTOS.GetDataPagesFromNewSpace[pages]]};

FreePages: PROC [ptr: LONG POINTER] = {
RTOS.FreeableSpaceZone.FREE[@ptr]};

IsTraceAndSweepEnabled: PUBLIC PROC RETURNS [BOOLEAN] = {
RETURN[traceAndSweepEnabled]};

StuffZi: PUBLIC ENTRY PROC[zi: ZoneIndex, zone: ZONE] =
{ENABLE UNWIND => NULL;
z: REF ANY ← LOOPHOLE[zone];
MapZiZn[zi] ← NARROW[z]};

SuspendClientRCActivity: PROC =
{-- set the microcode to trap on any RC activity in any process other than this one
RTRefCounts.GCState.GCStateBasic.collector ← LOOPHOLE[RTOS.GetCurrent[]];
RTRefCounts.GCState.GCStateBasic.reclaimState ← RTRefCounts.gcStopped;
[] ← RTMOVESTATUS[toMemory, 0];
};

ResumeClientRCActivity: PROC[countingOn: BOOL] =
{IF countingOn -- else reference counting will be disabled
THEN RTRefCounts.GCState.GCStateBasic.reclaimState ← RTRefCounts.gcRunning;

RTRefCounts.GCState.GCStateBasic.collector ← NIL;
[] ← RTMOVESTATUS[toMemory, 0];
};

-- this is really an INTERNAL procedure of the collector's monitor (RTRefCountsImpl)
DoTraceAndSweepCollection: PUBLIC ENTRY PROC =
{ ENABLE UNWIND => NULL;

-- acquire the lock on the runtime loader (REFs in GF's are counted)
[] ← PilotLoadStateOps.InputLoadState[];

-- Acquire all ZONE locks. New ZONE creation is not a problem because the first
-- ZONE lock acquired is for the system ZONE, and NewZone won't stuff MapZiZn
-- while the TandS is active.

FOR zi: CARDINAL IN [0..MapZiZn.length)
DO zone: Zone ← MapZiZn[zi];
IF zone = NIL THEN LOOP;
IF zone.linkage.tag # collectible THEN LOOP;
UNTIL ProcessOperations.LongEnter[@zone.LOCK]
DO Process.Yield[]; ENDLOOP;
ENDLOOP;

SuspendClientRCActivity[];

RTRefCounts.ClearRCTable[];

-- set start bits for prefixed objects and clear quantized free lists
quantizedCellsInitiallyFreed ← quantizedObjectsInitiallyFreed ← 0;

FOR zi: CARDINAL IN [0..MapZiZn.length) DO
zone: Zone ← MapZiZn[zi];
IF zone = NIL THEN LOOP;
IF zone.linkage.tag # collectible THEN LOOP;
WITH z: zone SELECT FROM
quantized =>
{sza: SubZoneArray ← z.pAsz;
FOR i: CARDINAL IN [0..LENGTH[sza]) DO
size: CARDINAL = sza[i].size;
fl: FreeList ← sza[i].fl;
WHILE fl # NIL DO
next: FreeList ← fl^;
IF RTFlags.checking AND NOT ObjectStart[LOOPHOLE[fl]] THEN ERROR;
[] ← LONGZERO[fl, SIZE[FreeList]];
quantizedObjectsInitiallyFreed ← quantizedObjectsInitiallyFreed + 1;
quantizedCellsInitiallyFreed ← quantizedCellsInitiallyFreed + size;
fl ← next;
ENDLOOP;
sza[i].fl ← NIL;
ENDLOOP};
prefixed =>
-- parse the prefixed zone, set object (start) bit for non-free object
{InitPrefixedObject: PROC [pref: ParsedRef] = {SetObjectBit[ParsedRefToPointer[pref]]};
ObjectsInPrefixedZone[zone, InitPrefixedObject]};
ENDCASE => ERROR
ENDLOOP;

-- trace from all local and global frames in the world
IF RTFlags.takingStatistics THEN nGlobalFrames ← nLocalFrames ← 0;

DO
{ RTOS.SnapshotTheFrameHeap[ ! RTOS.FrameCopySpaceTooSmall => GOTO expandFCS];
EXIT;
EXITS expandFCS =>
RTOS.AllocateFrameBodyBuffer[RTRefCounts.frameBodyBufferPages ← RTRefCounts.frameBodyBufferPages+1];
} ENDLOOP;

RTOS.MapRCFrameBodies[TraceLocalFrame];
[] ← RTOS.EnumerateGlobalFrames[TraceGlobalFrame];

-- continue marking from the ref stack and from objects
UNTIL EmptyRefStack[] DO
TraceRefsInObject[PopRef[]]
ENDLOOP;

-- free the space for ref stacks
FreeRefStacks[];

-- free the objects

-- initialize consistency counters
IF RTFlags.takingStatistics
THEN
prefixedObjectsMarkedFree ←
prefixedObjectsSeen ←
prefixedObjectsKept ←
prefixedObjectsReclaimed ←
quantizedObjectsSeen ←
quantizedObjectsKept ←
quantizedObjectsReclaimed ← 0;

FOR zi: CARDINAL IN [0..MapZiZn.length) DO
zone: Zone ← MapZiZn[zi];
IF zone = NIL THEN LOOP;
IF zone.linkage.tag # collectible THEN LOOP;
WITH z: zone SELECT FROM
quantized => ObjectsInQuantizedZone[zone, VisitOneObject];
prefixed => ObjectsInPrefixedZone [zone, VisitOneObject];
ENDCASE => ERROR
ENDLOOP;

RTRefCounts.nObjectsReclaimed ← RTRefCounts.nObjectsReclaimed
- quantizedObjectsInitiallyFreed;
RTRefCounts.nWordsReclaimed ← RTRefCounts.nWordsReclaimed - quantizedCellsInitiallyFreed;

-- check for consistency
IF RTFlags.takingStatistics AND RTFlags.checking THEN
{IF prefixedObjectsMarkedFree
+ prefixedObjectsReclaimed
+ prefixedObjectsKept
# prefixedObjectsSeen
OR quantizedObjectsKept
+ quantizedObjectsReclaimed
# quantizedObjectsSeen
THEN ERROR};

FreeAllObjectBits[];

ResumeClientRCActivity[countingOn];

-- release all the ZONE locks
FOR zi: CARDINAL IN [0..MapZiZn.length)
DO zone: Zone ← MapZiZn[zi];
IF zone = NIL THEN LOOP;
ProcessOperations.LongExit[@zone.LOCK]
ENDLOOP;

-- release the loader's lock
PilotLoadStateOps.ReleaseLoadState[];

RETURN; -- exiting the collector's monitor will unwedge reference-counting clients
};

-- this is called once for each valid REF found in counted storage
-- (this includes reconstructing the RC for the object)
MarkRef: PROC [pref: ParsedRef] = INLINE {
ref: REF ANY = UnParseRef[pref];
IF Marked[pref] THEN {IncRC[ref]; RETURN};

-- here if this REF is valid and not seen before
-- finalization: get the type, the package count, and
-- establish the correct initial RC (+1!)
FOR i: CARDINAL IN [1..RTTypesBasicPrivate.NPackageRefs[RTTypesBasic.GetReferentType[ref]]] DO DecRC[ref] ENDLOOP;
SetMark[pref];
IF checkMarkRef THEN CheckBugRef[pref];
IF NOT RefContaining[pref] THEN RETURN;
PushRef[pref]};

-- the following proc will clear the mark bit for a ref
-- and free the object if it was unmarked
VisitOneObject: PROC [pref: ParsedRef] = {
IF NOT ObjectStart[ParsedRefToPointer[pref]] THEN ERROR;
IF Marked[pref]
THEN {IF pref.prefixed
THEN {IF RTFlags.takingStatistics THEN prefixedObjectsKept ← prefixedObjectsKept + 1;
ClearMark[pref]}
ELSE IF RTFlags.takingStatistics THEN quantizedObjectsKept ← quantizedObjectsKept + 1}
ELSE {IF RTFlags.takingStatistics THEN
IF pref.prefixed
THEN prefixedObjectsReclaimed ← prefixedObjectsReclaimed + 1
ELSE quantizedObjectsReclaimed ← quantizedObjectsReclaimed + 1;
TAndSFreeObject[LOOPHOLE[UnParseRef[pref]]]}};

-- *******this stuff copied and slightly altered from RTReclaimerImpl
TAndSFreeObject: PROC[ptr: RTBasic.Pointer] =
{mz: ZoneFinger = MapPtrZf[ptr];

IF RTFlags.checking THEN
{ IF ptr = NIL THEN ERROR;
IF NOT FromCollectibleZone[LOOPHOLE[ptr, REF ANY]]
THEN ERROR};

RTRefCounts.nObjectsReclaimed ← RTRefCounts.nObjectsReclaimed + 1;

WITH mz: mz SELECT FROM
sub => {sz: SubZone = MapSziSz[mz.szi];
size: CARDINAL ← sz.size;
RTRefCounts.nWordsReclaimed ← RTRefCounts.nWordsReclaimed + size;
IF RTFlags.clearing THEN [] ← LONGZERO[ptr, size];
TAndSFreeQuantizedNode[ptr, LOOPHOLE[MapZiZn[sz.zi]], sz]};

prefixed => {size: CARDINAL = RTCommon.ShortenLongCardinal[NodeLength[LOOPHOLE[ptr-sizeNd, PNode]]];
IF RTFlags.checking AND size = 0 THEN ERROR;
RTRefCounts.nWordsReclaimed ← RTRefCounts.nWordsReclaimed + size;
IF RTFlags.clearing THEN [] ← LONGZERO[ptr, size-sizeNd];
TAndSFreePrefixedNode[ptr, LOOPHOLE[MapZiZn[mz.zi]]]};

ENDCASE => ERROR};


TAndSFreeQuantizedNode: PROC[ptr: RTBasic.Pointer, zn: PZone, sz: SubZone] =
{LOOPHOLE[ptr, FreeList]^ ← sz.fl;
sz.fl ← ptr;
IF RTFlags.takingStatistics THEN
{ zn.cellsInService ← zn.cellsInService - sz.size;
zn.objectsInService ← zn.objectsInService - 1}};

TAndSFreePrefixedNode: PROC[ptr: RTBasic.Pointer, zn: PZone] =
{ IF RTFlags.takingStatistics THEN
{ pn: PNode = LOOPHOLE[ptr, PNode] - sizeNd;
zn.cellsInService ← zn.cellsInService - NodeLength[pn];
zn.overheadCells ← zn.overheadCells - sizeNd;
zn.objectsInService ← zn.objectsInService - 1};
LinkHeapNode[ptr-sizeNd, @LOOPHOLE[zn, PPrefixedZone].fnd]};

-- NOTE copied in RTPrefAllocImpl
LinkHeapNode: PROC[pfn, pfnPrev: PFreeNode] =
{pfnNext: PFreeNode = pfnPrev.pfnNext;
pfn.body ← free[pfnPrev: pfnPrev, pfnNext: pfnNext];
pfnNext.pfnPrev ← pfn;
pfnPrev.pfnNext ← pfn};
-- *******end of stuff copied and slightly altered from RTReclaimerImpl

GlobalFrameSize: PROC [gf: PrincOps.GlobalFrameHandle] RETURNS [CARDINAL] = {
-- return the size in words of the given global frame
-- 0 is returned for frames not yet started
IF gf = NIL OR NOT gf.started THEN RETURN [0];
{cp: LONG POINTER TO PrincOps.CSegPrefix ← LOOPHOLE[gf.code];
pbody: LONG POINTER TO CARDINAL ←
LOOPHOLE[cp + CARDINAL[cp.entry[PrincOps.MainBodyIndex].initialpc]];
RETURN [(pbody - 1)^]
}};

TraceLocalFrame: PROC [pa: LONG POINTER TO RTBasic.Address, nWords: CARDINAL] = {
-- this procedure is used to mark refs in a local frame
-- RCs must be decremented on first encounter
IF RTFlags.takingStatistics THEN nLocalFrames ← nLocalFrames + 1;
IF nWords >= (SIZE[REF]) THEN
FOR i: CARDINAL IN [0..nWords - (SIZE[REF])] DO
addr: RTBasic.Address = (pa + i)^;
IF ObjectStart[LOOPHOLE[addr]] THEN -- if this REF is valid
{ref: REF ANY = LOOPHOLE[addr];
pref: ParsedRef ← ParseRef[ref];
IF Marked[pref] THEN LOOP;

-- here if this REF is valid and not seen before
-- finalization: get the type, the package count, and
-- establish the correct initial RC (0)
FOR i: CARDINAL IN [0..RTTypesBasicPrivate.NPackageRefs[RTTypesBasic.GetReferentType[ref]]] DO DecRC[ref] ENDLOOP;
SetMark[pref];
IF NOT RefContaining[pref] THEN LOOP;
PushRef[pref]};
ENDLOOP};

procRef: PROC [ref: REF] = {
IF RTFlags.checking AND NOT ObjectStart[LOOPHOLE[ref]] THEN ERROR;
MarkRef[ParseRef[ref]]};

TraceGlobalFrame: PROC [gfh: PrincOps.GlobalFrameHandle] RETURNS [BOOLEAN] = {
-- this procedure is used to mark refs from a global frame
-- the algorithm is essentially the same as for regular objects
type: RTTypesBasic.Type = RTLoader.GetGFRCType[gfh.gfi];
IF type # RTBasic.nullType
THEN RTTypesBasicPrivate.MapRefs
[LONG[gfh], RTTypesBasicPrivate.MapTiRcmx[type], procRef];
RETURN[FALSE]};


-- size ← GlobalFrameSize[gf];
-- p: POINTER TO RTBasic.Address ← LOOPHOLE[gf];
-- IF RTFlags.takingStatistics THEN nGlobalFrames ← nGlobalFrames + 1;
-- IF size >= SIZE[REF] THEN
-- FOR i: CARDINAL IN [SIZE[PrincOps.GlobalFrame]..size - (SIZE[REF])] DO
-- addr: RTBasic.Address = (p + i)^;
-- IF ObjectStart[LOOPHOLE[addr]] THEN
-- MarkRef[ParseRef[LOOPHOLE[addr]]]
-- ENDLOOP;
-- RETURN [FALSE]};

TraceRefsInObject: PROC [pref: ParsedRef] = {
-- applies P to each reference in the indicated object (ref)
ref: REF ANY = UnParseRef[pref];
type: RTTypesBasic.Type ← RTTypesBasic.GetReferentType[ref];

IF checkTraceObject THEN CheckBugRef[pref];
RTTypesBasicPrivate.MapRefs
[LOOPHOLE[ref], RTTypesBasicPrivate.MapTiRcmx[type], procRef]};

ObjectsInPrefixedZone: PROC [zone: Zone, visit: PROC [ParsedRef]] = {
-- this proc visits all non-free objects in a prefixed zone
WITH z: zone SELECT FROM
prefixed =>
-- look at all of the objects, both allocated and freed
FOR r: Runs.Run ← z.runs, r.rnNext UNTIL r = NIL DO
lim: PNode = LOOPHOLE[LONG[r.iTo] * RTQuanta.QuantumSize]; -- iTo not included
ptr: PNode ← LOOPHOLE[LONG[r.iFrom] * RTQuanta.QuantumSize];
WHILE ptr # lim DO -- look at each object in the run
size: LONG CARDINAL = NodeLength[ptr];
pr: ParsedRef ← LOOPHOLE[ptr + sizeNd];

IF RTFlags.checking AND size = 0 THEN ERROR;

IF RTFlags.takingStatistics THEN prefixedObjectsSeen ← prefixedObjectsSeen + 1;

IF pr.pad # 0
OR pr.prefixed
OR size < sizeNd
OR LOOPHOLE[pr, LONG CARDINAL] > LOOPHOLE[lim, LONG CARDINAL]
THEN ERROR;

pr.prefixed ← TRUE;
IF ptr.state = free
THEN {IF RTFlags.takingStatistics
THEN prefixedObjectsMarkedFree ← prefixedObjectsMarkedFree + 1}
ELSE visit[pr];
IF RTFlags.checking AND size # NodeLength[ptr]
THEN ERROR; -- oops, something changed!
ptr ← ptr + size;
ENDLOOP
ENDLOOP;
ENDCASE => ERROR};

ObjectsInQuantizedZone: PROC [zone: Zone, visit: PROC [ParsedRef]] = {
-- this proc visits all objects in a quantized zone
-- the visitation is in order of increasing address
FOR r: Runs.Run ← zone.runs, r.rnNext WHILE r # NIL DO
FOR qx: CARDINAL IN [r.iFrom..r.iTo) DO
mz: ZoneFinger = MapQZf[qx];
IF mz = mzVacant THEN LOOP; -- unused quantum
WITH mz: mz SELECT FROM
sub =>
{size: CARDINAL = GetSzSize[mz.szi];
rz: Zone = MapZiZn[GetSzZi[mz.szi]];
lc: LONG CARDINAL ← 0;
p: LONG POINTER ← LOOPHOLE[LONG[qx]*RTQuanta.QuantumSize];

IF rz # zone OR size > RTQuanta.QuantumSize THEN ERROR;

IF qx = rz.qFirst THEN lc ← RTBases.BaseOverhead;
DO -- for each object in the quantum
pr: ParsedRef ← LOOPHOLE[p+lc];
lc ← lc + size;
IF lc > RTQuanta.QuantumSize THEN EXIT;
IF RTFlags.takingStatistics THEN quantizedObjectsSeen ← quantizedObjectsSeen + 1;
visit[pr];
ENDLOOP;
};
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
};

ParsedRefToPointer: PROC [p: ParsedRef] RETURNS [RTBasic.Pointer] = MACHINE CODE
{Mopcodes.zLIB, 377B; Mopcodes.zAND};

ParsedRefToPNode: PROC [p: ParsedRef] RETURNS [InusePNode] = INLINE {
IF p.prefixed THEN RETURN [LOOPHOLE[ParsedRefToPointer[p] - sizeNd]];
ERROR};

ObjectStart: PROC [p: RTBasic.Pointer] RETURNS [BOOLEAN] = INLINE {
-- returns TRUE if the pointer really refers to the start of an object
-- it is OK to hand this thing pure garbage!

-- A ref to someplace in a prefixed zone points at the start of
-- a non-free object if ObjectBit[ref] is TRUE. We assume that the
-- object start bits have been set for prefixed objects

-- A ref to someplace in a quantized zone points at the start of
-- an object if the ref has the correct modulus with respect to
-- the size of the objects in the appropriate sub-zone. This must
-- be adjusted for BaseOverhead if the quantum is the one indicated
-- by zone.qFirst.

IF p = NIL
OR (LOOPHOLE[p, Pair].low MOD 2 = 1)
OR (LOOPHOLE[p, Pair].high > MaxBank)
THEN RETURN [FALSE];

{qx: RTQuanta.QuantumIndex = RTQuanta.PtrToQtmIndex[p];
mz: ZoneFinger = MapQZf[qx];
IF mz = mzVacant THEN RETURN [FALSE];
WITH mz: mz SELECT FROM
sub => {sz: CARDINAL = GetSzSize[mz.szi];
rz: Zone = MapZiZn[GetSzZi[mz.szi]];
lc: CARDINAL ← CARDINAL[Inline.LowHalf[p]] MOD RTQuanta.QuantumSize;

IF rz = NIL THEN RETURN[FALSE];
IF RTFlags.checking AND rz.linkage.tag # collectible THEN ERROR;
IF qx = rz.qFirst THEN
{IF lc < RTBases.BaseOverhead THEN RETURN [FALSE];
lc ← lc - RTBases.BaseOverhead};
IF sz > RTQuanta.QuantumSize THEN ERROR; -- can't allow this!
RETURN [lc MOD sz = 0]};
prefixed => IF MapZiZn[mz.zi] = NIL
THEN RETURN[FALSE]
ELSE RETURN[ObjectBit[p]];
ENDCASE => ERROR}};

Marked: PROC [pref: ParsedRef] RETURNS [BOOLEAN] = INLINE {
-- determines whether ref has been seen
ptr: RTBasic.Pointer = ParsedRefToPointer[pref];
IF NOT pref.prefixed
THEN RETURN [ObjectBit[ptr]] -- for quantized zones, the ObjectBit is used as the mark!
ELSE RETURN [ParsedRefToPNode[pref].marked]};

SetMark: PROC [pref: ParsedRef] = INLINE {
-- marks object as being seen
ptr: RTBasic.Pointer = ParsedRefToPointer[pref];
IF NOT pref.prefixed
THEN SetObjectBit[ptr] -- for quantized zones, the ObjectBit is used as the mark!
ELSE ParsedRefToPNode[pref].marked ← TRUE};

ClearMark: PROC [pref: ParsedRef] = INLINE {
-- clears object mark to ground state
ptr: RTBasic.Pointer = ParsedRefToPointer[pref];
IF NOT pref.prefixed
THEN ClearObjectBit[ptr] -- for quantized zones, the ObjectBit is used as the mark!
ELSE ParsedRefToPNode[pref].marked ← FALSE};

-- One bit per address in virtual memory.
-- For prefixed zones, the "object" bit indicates that the object is allocated.
-- For quantized zones, it is used as the mark bit.
ObjectBit: PROC [ptr: RTBasic.Pointer] RETURNS [BOOLEAN] = INLINE {
-- returns TRUE iff object bit is set for the reference
bank: CARDINAL ← LOOPHOLE[ptr, Pair].high;
word: CARDINAL ← LOOPHOLE[ptr, Pair].low;
IF bank > MaxBank THEN RETURN [FALSE];
IF suspect = ptr THEN SIGNAL SuspectSeen;
{table: BankTablePtr ← bankTableArray[bank];
IF table = NIL THEN RETURN [FALSE];
RETURN [table[word]]}};

SetObjectBit: PROC [ptr: RTBasic.Pointer] = INLINE {
-- sets the object bit for the reference
bank: CARDINAL ← LOOPHOLE[ptr, Pair].high;
word: CARDINAL ← LOOPHOLE[ptr, Pair].low;
IF bank > MaxBank THEN ERROR BadObjectStart;
IF suspect = ptr THEN SIGNAL SuspectSeen;
{table: BankTablePtr ← bankTableArray[bank];
IF table = NIL THEN
-- create new bank table (and initialize it to ALL[FALSE] efficiently)
{table ← LOOPHOLE[NewPages[BankTablePages]];
bankTableArray[bank] ← table;
LOOPHOLE[table, PhonyTablePtr]^ ← ALL[0]};
table[word] ← TRUE}};

ClearObjectBit: PROC [ptr: RTBasic.Pointer] = INLINE {
-- clears the object bit for the reference
bank: CARDINAL ← LOOPHOLE[ptr, Pair].high;
word: CARDINAL ← LOOPHOLE[ptr, Pair].low;
IF bank > MaxBank THEN ERROR BadObjectStart;
IF suspect = ptr THEN SIGNAL SuspectSeen;
{table: BankTablePtr ← bankTableArray[bank];
IF table = NIL THEN ERROR BadAddress;
table[word] ← FALSE}};

FreeAllObjectBits: PROC = {
-- free all of the object bit tables
FOR bank: CARDINAL IN [0..MaxBank] DO
table: BankTablePtr ← bankTableArray[bank];
IF table = NIL THEN LOOP;
FreePages[table];
bankTableArray[bank] ← NIL
ENDLOOP};

PushRef: PROC [pref: ParsedRef] = {
-- pushes ref to object onto the reference stack
stack: RefStack ← refStackChain;
IF stack = NIL OR stack.size = stack.max THEN
-- time to get a new stack node
{IF refStackFree = NIL
-- oh well, nothing comes for free
THEN {stack ← NewPages[8];
stack.next ← NIL;
stack.size ← 0;
stack.max ← (8 * wordsPerPage - (SIZE[RefStackRep])) / (SIZE[ParsedRef])}
ELSE {stack ← refStackFree;
refStackFree ← stack.next};
stack.next ← refStackChain;
refStackChain ← stack};
stack[stack.size] ← pref;
stack.size ← stack.size + 1};

PopRef: PROC RETURNS [pref: ParsedRef] = {
-- pops ref to object from the reference stack
stack: RefStack ← refStackChain;
IF stack # NIL THEN
{size: CARDINAL ← stack.size;
IF size = 0 THEN
{refStackChain ← stack.next;
stack.next ← refStackFree;
refStackFree ← stack;
IF (stack ← refStackChain) = NIL THEN RETURN [ParsedNil];
IF (size ← stack.size) = 0 THEN ERROR};
size ← size - 1;
stack.size ← size;
RETURN [stack[size]]};
RETURN [ParsedNil]};

EmptyRefStack: PROC RETURNS [BOOLEAN] = INLINE {
-- tests reference stack for emptiness
RETURN [refStackChain = NIL]};

FreeRefStacks: PROC = {
IF refStackChain # NIL THEN ERROR; -- should never happen, but check anyway
WHILE refStackFree # NIL DO
stack: RefStack ← refStackFree.next;
FreePages[refStackFree];
refStackFree ← stack
ENDLOOP};

ParseRef: PROC [ref: REF ANY] RETURNS [ParsedRef] = {
-- parses reference into more efficient representation
IF LOOPHOLE[ref, Pair].high > MaxBank THEN RETURN [ParsedNil];
{pr: ParsedRef ← LOOPHOLE[ref];
mz: ZoneFinger = MapPtrZf[LOOPHOLE[ref]];
rz: Zone;
WITH mz: mz SELECT FROM
sub => rz ← MapZiZn[GetSzZi[mz.szi]];
prefixed => rz ← MapZiZn[mz.zi];
ENDCASE => ERROR;
IF rz.linkage.tag # collectible THEN RETURN [ParsedNil];
IF rz.sr = prefixed THEN pr.prefixed ← TRUE;
RETURN[pr]}};

UnParseRef: PROC [pref: ParsedRef] RETURNS [REF ANY] = INLINE {
-- returns user-style reference from parsed ref
RETURN [LOOPHOLE[ParsedRefToPointer[pref]]]};

RefContaining: PROC [pref: ParsedRef] RETURNS [BOOLEAN] = INLINE {
-- tests for object being ref-containing (assume that ObjectStart is TRUE)
IF pref = ParsedNil THEN RETURN [FALSE];
{type: RTTypesBasic.Type = RTTypesBasic.GetReferentType[UnParseRef[pref]];
RETURN [RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]}};

END.