DIRECTORY
AMBridge USING [GFHFromTV],
AMTypes USING [TV, Type, TypeClass, TypeToName],
BBContext USING [GlobalFrameSearch],
FastBreak USING [ClearFastBreak, FastBreakId, FastBreakProc, SetFastBreak],
IO USING
[STREAM, card, PutChar, Close, int, PutRope, Put, PutF, CreateViewerStreams, CreateOutputStreamToRope, refAny, rope, type, GetOutputStreamRope],
Mopcodes USING [zRDB],
PrincOps USING [FrameHandle, GlobalFrameHandle],
PrintTV USING [PrintType, PutClosure, PutProc],
PriorityQueue USING [Ref, SortPred, Predict, Insert, Empty, Remove],
Rope USING [ROPE, Cat],
RefCounts USING [GetCount],
RTBasic USING [Type, TypeIndex],
RTBases USING [GetDQIS],
RTQuanta USING [QuantumSize, PagesPerQuantum],
RTReclaimerImpl, -- listed here so the loader will complain if RTReclaimerImpl changes.  If it changes, check the pc and offsets used in the reclaimer monitor.
RTStorageAccounting USING [nWordsRequested, nWordsAllocated, SUMnWordsAllocated],
RTTraceAndSweepImpl USING[FindCircularGarbage],
RTTypesBasicPrivate USING [MapRefs, MapTiRcmx],
Runs USING [Run],
RTZones USING
[FreeList, InusePNode, PZone, MapQZf, MapSziSz, MapZiZn, ZoneFinger, mzVacant, NodeLength, PFreeNode, PNode, sizeNd, SubZone, Zone],
SafeStorage USING [ReclaimCollectibleObjects],
SSExtra USING [PagesMappedToCedarVM],
UZoneTracker USING[Enumerate],
ZoneCleanupImpl USING [EnumerateAllObjects];

ScanZones: MONITOR LOCKS zone.LOCK USING zone: PZone
IMPORTS AMBridge, AMTypes, BBContext, FastBreak, IO, PrintTV, PriorityQueue, Rope, RefCounts, RTBases, RTStorageAccounting, RTTraceAndSweepImpl, RTTypesBasicPrivate, RTZones, SafeStorage, SSExtra, UZoneTracker, ZoneCleanupImpl
SHARES RTTraceAndSweepImpl, ZoneCleanupImpl = BEGIN 

OPEN PrintTV, Rope, RTBasic, RTQuanta, RTZones, Runs;

maxTypeIndex: NAT = 2048;
TypeStatArray: TYPE = ARRAY [0 .. maxTypeIndex] OF TSRec;
TSRec: TYPE = RECORD[objects, words: INT _ 0];
summaryTypeStatistics, last: REF TypeStatArray;

ShowAllStorage: PROC
[wordsCutoff: INT _ 200,  -- don't print types with < wordsCutoff words in a zone
printTypeNames: BOOL _ FALSE] = {
DoIt[wordsCutoff, NIL, NIL, printTypeNames];
};

PrintDifferences: PROC[label: Rope.ROPE] = {DoIt[printDifferences: TRUE, wordsCutoff: 0, 
printTypeNames: TRUE, printSummaryOnly: TRUE, label: label]}; 
DoIt: PROC
[wordsCutoff: INT _ 200,  -- don't print types with < wordsCutoff words in a zone
specifiedZone: ZONE _ NIL, -- NIL means do it for all zones
specifiedUZone: UNCOUNTED ZONE _ NIL, -- NIL means do it for all uzones
printDifferences: BOOL _ FALSE,
printTypeNames: BOOL _ FALSE,
printTypeTotals: BOOL _ FALSE,
printSummaryOnly: BOOL _ FALSE,
label: Rope.ROPE _ NIL] = {
grandTotalZones, grandTotalQuanta, grandTotalFreeObjects,
grandTotalFreeWords, grandTotalAllocatedObjects,
grandTotalAllocatedWords: INT _ 0;


typeStatistics: REF TypeStatArray _ NEW[TypeStatArray];
otherAllocatedObjects: INT _ 0;
otherAllocatedWords: INT _ 0;

zoneInfo: ZoneInfo;
visitUZone: PROC[uz: UNCOUNTED ZONE] = {
IF specifiedUZone # NIL AND uz # specifiedUZone THEN RETURN;
initCounts[];
ObjectsThenRunsInUZone[
LOOPHOLE[uz, LONG POINTER TO PZone]^,
visitUObject,
visitRun];
IF LONG[zoneInfo.zoneQuantaInfo.nextIndex
+ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.emptyQuanta
+ zoneInfo.zoneQuantaInfo.filledQuanta]*QuantumSize
- zoneInfo.nAllocatedWords # zoneInfo.nFreeWords
THEN ERROR;

IF NOT printSummaryOnly
THEN displayZoneInfo[LOOPHOLE[uz, LONG POINTER TO PZone]^, TRUE];
grandTotalZones _ grandTotalZones + 1;
grandTotalQuanta _ grandTotalQuanta
+ zoneInfo.zoneQuantaInfo.nextIndex
+ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.emptyQuanta
+ zoneInfo.zoneQuantaInfo.filledQuanta;
grandTotalFreeObjects _ grandTotalFreeObjects + zoneInfo.nFreeObjects;
grandTotalFreeWords _ grandTotalFreeWords + zoneInfo.nFreeWords;
grandTotalAllocatedObjects _ grandTotalAllocatedObjects + zoneInfo.nAllocatedObjects;
grandTotalAllocatedWords _ grandTotalAllocatedWords + zoneInfo.nAllocatedWords;
};
visitZone: PROC[zone: Zone] = {
IF specifiedZone # NIL AND LOOPHOLE[zone, ZONE] # specifiedZone THEN RETURN;
initCounts[];
ObjectsThenRunsInZone[LOOPHOLE[zone], visitObject, visitRun];
IF NOT printSummaryOnly
THEN
FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex] DO
IF typeStatistics[i].words > wordsCutoff THEN
zoneInfo.zoneTypeInfo.Insert
[NEW[TypeEntryRec _
[type: [i],
objects: typeStatistics[i].objects,
words: typeStatistics[i].words
]]];
ENDLOOP;
IF LONG[zoneInfo.zoneQuantaInfo.nextIndex
+ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.emptyQuanta
+ zoneInfo.zoneQuantaInfo.filledQuanta]*QuantumSize
- zoneInfo.nAllocatedWords # zoneInfo.nFreeWords
THEN ERROR;

IF NOT printSummaryOnly
THEN displayZoneInfo[LOOPHOLE[zone, PZone], FALSE];
FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex] WHILE summaryTypeStatistics # NIL
DO
summaryTypeStatistics[i].objects
_ summaryTypeStatistics[i].objects + typeStatistics[i].objects;
summaryTypeStatistics[i].words
_ summaryTypeStatistics[i].words + typeStatistics[i].words;
ENDLOOP;
grandTotalZones _ grandTotalZones + 1;
grandTotalQuanta _ grandTotalQuanta
+ zoneInfo.zoneQuantaInfo.nextIndex
+ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.emptyQuanta
+ zoneInfo.zoneQuantaInfo.filledQuanta;
grandTotalFreeObjects _ grandTotalFreeObjects + zoneInfo.nFreeObjects;
grandTotalFreeWords _ grandTotalFreeWords + zoneInfo.nFreeWords;
grandTotalAllocatedObjects _ grandTotalAllocatedObjects + zoneInfo.nAllocatedObjects;
grandTotalAllocatedWords _ grandTotalAllocatedWords + zoneInfo.nAllocatedWords;
};
visitUObject: PROC[addr: LONG POINTER, size: INT, free: BOOL] = {
IF free
THEN {
zoneInfo.nFreeObjects _ zoneInfo.nFreeObjects + 1;
zoneInfo.nFreeWords _ zoneInfo.nFreeWords + size}
ELSE {
zoneInfo.nAllocatedObjects _ zoneInfo.nAllocatedObjects + 1;
zoneInfo.nAllocatedWords _ zoneInfo.nAllocatedWords + size;
otherAllocatedObjects _ otherAllocatedObjects + 1;
otherAllocatedWords _ otherAllocatedWords + size;
};
};
visitObject: PROC[addr: LONG POINTER, size: INT, type: Type, free: BOOL] = {
i: NAT _ LOOPHOLE[type];
IF free
THEN {zoneInfo.nFreeObjects _ zoneInfo.nFreeObjects + 1;
zoneInfo.nFreeWords _ zoneInfo.nFreeWords + size}
ELSE {zoneInfo.nAllocatedObjects _ zoneInfo.nAllocatedObjects + 1;
zoneInfo.nAllocatedWords _ zoneInfo.nAllocatedWords + size;
IF i <= maxTypeIndex
THEN {typeStatistics[i].objects _ typeStatistics[i].objects + 1;
typeStatistics[i].words _ typeStatistics[i].words + size}
ELSE {otherAllocatedObjects _ otherAllocatedObjects + 1;
otherAllocatedWords _ otherAllocatedWords + size};
};
};
visitRun: PROC[zone: PZone, run: Run] = {
q: INT _ run.iFrom;
qOver: INT _run.iTo;
WITH z: zone SELECT FROM
quantized =>
FOR qx: CARDINAL IN [q..qOver) DO
mz: ZoneFinger = MapQZf[qx];
IF mz = mzVacant
THEN {
zoneInfo.zoneQuantaInfo.emptyQuanta
_ zoneInfo.zoneQuantaInfo.emptyQuanta + 1;
zoneInfo.nFreeWords _ zoneInfo.nFreeWords + QuantumSize;
LOOP};

WITH mz: mz SELECT FROM
sub => {
szr: SubZone _ MapSziSz[mz.szi];
lc: CARDINAL _ 0;
p: LONG POINTER _ LOOPHOLE[LONG[qx]*QuantumSize];
bits: PACKED ARRAY [0..QuantumSize) OF BOOL _ ALL[FALSE];
flr: FreeList _ szr.fl;
words: NAT _ 0;
fragmentSize: NAT _ QuantumSize MOD szr.size;

WHILE flr # NIL DO
offset: INT _ LOOPHOLE[flr, INT]-LOOPHOLE[p, INT];
IF offset >= 0 AND offset < QuantumSize THEN
bits[offset] _ TRUE;
flr _ flr^;
ENDLOOP;
WHILE lc+szr.size <= QuantumSize DO -- for each object in the quantum
pr: LONG POINTER _ LOOPHOLE[p+lc];
IF NOT bits[lc] THEN words _ words + szr.size;
lc _ lc + szr.size;
ENDLOOP;
SELECT words FROM
QuantumSize =>
zoneInfo.zoneQuantaInfo.filledQuanta
_ zoneInfo.zoneQuantaInfo.filledQuanta + 1;
0 => {
zoneInfo.zoneQuantaInfo.emptyQuanta
_ zoneInfo.zoneQuantaInfo.emptyQuanta + 1;
zoneInfo.nFreeWords _ zoneInfo.nFreeWords + fragmentSize;
};
ENDCASE => {
IF zoneInfo.zoneQuantaInfo.nextIndex = ZQALength
THEN {
zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
_ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta + 1;
zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta
_ zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta
+ words}
ELSE {
zoneInfo.zoneQuantaInfo.nextIndex
_ zoneInfo.zoneQuantaInfo.nextIndex + 1;
zoneInfo.zoneQuantaInfo.a[zoneInfo.zoneQuantaInfo.nextIndex-1]
_ [qx, words]};
zoneInfo.nFreeWords _ zoneInfo.nFreeWords + fragmentSize;
};
};
ENDCASE => ERROR;
ENDLOOP;

prefixed => {
ptr: PNode _ LOOPHOLE[q*QuantumSize, LONG POINTER];
wordsUsedInQuantum: NAT _ 0;
wordsFreeInQuantum: NAT _ 0;
DO -- visit each object in the run
size: INT _ NodeLength[ptr];
free: BOOL _ ptr.state = free;
ptr _ ptr + size; -- advance to the next object
IF LOOPHOLE[ptr, INT]/QuantumSize = q
THEN {IF free
THEN wordsFreeInQuantum _ wordsFreeInQuantum + size
ELSE wordsUsedInQuantum _ wordsUsedInQuantum + size
}
ELSE {
s: INT = QuantumSize - wordsUsedInQuantum - wordsFreeInQuantum;
IF free
THEN wordsFreeInQuantum _ wordsFreeInQuantum + s
ELSE wordsUsedInQuantum _ wordsUsedInQuantum + s;
SELECT wordsUsedInQuantum FROM
QuantumSize =>
zoneInfo.zoneQuantaInfo.filledQuanta
_ zoneInfo.zoneQuantaInfo.filledQuanta + 1;
0 =>
zoneInfo.zoneQuantaInfo.emptyQuanta
_ zoneInfo.zoneQuantaInfo.emptyQuanta + 1
ENDCASE => {
IF zoneInfo.zoneQuantaInfo.nextIndex = ZQALength
THEN {
zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
_ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta + 1;
zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta
_ zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta
+ wordsUsedInQuantum}
ELSE {
zoneInfo.zoneQuantaInfo.nextIndex
_ zoneInfo.zoneQuantaInfo.nextIndex + 1;
zoneInfo.zoneQuantaInfo.a[zoneInfo.zoneQuantaInfo.nextIndex-1]
_ [q, wordsUsedInQuantum]};
};
wordsUsedInQuantum _ 0;
wordsFreeInQuantum _ 0;
FOR i: INT IN [q+1 .. LOOPHOLE[ptr, INT]/QuantumSize) DO
IF free
THEN
zoneInfo.zoneQuantaInfo.emptyQuanta
_ zoneInfo.zoneQuantaInfo.emptyQuanta + 1
ELSE
zoneInfo.zoneQuantaInfo.filledQuanta
_ zoneInfo.zoneQuantaInfo.filledQuanta + 1;
ENDLOOP;
};
q _ LOOPHOLE[ptr, INT]/QuantumSize; -- advance to the next quantum
IF q = qOver THEN {
IF ptr # LOOPHOLE[qOver * QuantumSize, PNode] THEN ERROR;
EXIT};
IF q > qOver THEN ERROR;
ENDLOOP;
};
ENDCASE => ERROR;
};
initCounts: PROC = {
zoneInfo.nFreeObjects _ 0;
zoneInfo.nFreeWords _ 0;
zoneInfo.nAllocatedObjects _ 0;
zoneInfo.nAllocatedWords _ 0;
zoneInfo.zoneQuantaInfo.nextIndex _ 0;
zoneInfo.zoneQuantaInfo.emptyQuanta _ 0;
zoneInfo.zoneQuantaInfo.filledQuanta _ 0;
zoneInfo.zoneQuantaInfo.partiallyFilledQuanta _ 0;
zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta _ 0;
FOR i: [0 .. ZQALength) IN [0 .. ZQALength)
DO zoneInfo.zoneQuantaInfo.a[i] _ [0, 0] ENDLOOP;
FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex]
DO typeStatistics[i] _ [0, 0] ENDLOOP;
otherAllocatedObjects _ 0;
otherAllocatedWords _ 0;
};

displayZoneInfo: PROC[zone: PZone, uncounted: BOOL] = {
nq: CARDINAL _ 0;
first: BOOL _ TRUE;
fbs.PutRope["\n"];
IF uncounted THEN fbs.PutRope["UNCOUNTED"];
fbs.PutRope["Zone #"];
fbs.Put[[integer[zone.zi]]];
IF zone.sr = prefixed
THEN fbs.PutRope[" (prefixed), "]
ELSE fbs.PutRope[" (quantized), "];
fbs.Put[[integer[zoneInfo.zoneQuantaInfo.nextIndex
+ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.emptyQuanta
+ zoneInfo.zoneQuantaInfo.filledQuanta]]];
fbs.PutRope[" quanta"];

fbs.PutRope["\n  #FreeWords: "];
fbs.Put[[integer[zoneInfo.nFreeWords]]];
fbs.PutRope[",   #FreeObjects: "];
fbs.Put[[integer[zoneInfo.nFreeObjects]]];

fbs.PutRope["\n  #AllocatedWords: "];
fbs.Put[[integer[zoneInfo.nAllocatedWords]]];
fbs.PutRope[",   #AllocatedObjects: "];
fbs.Put[[integer[zoneInfo.nAllocatedObjects]]];
fbs.PutRope["\n"];

WHILE NOT zoneInfo.zoneTypeInfo.Empty[] DO
ent: TypeEntry _ NARROW[zoneInfo.zoneTypeInfo.Remove[]];
IF first THEN {
first _ FALSE;
fbs.PutRope["\n  #words _ #objects (type code): type name"];
};
fbs.PutRope["\n  "];
fbs.Put[[integer[ent.words]]];
fbs.PutRope[" _ "];
fbs.Put[[integer[ent.objects]]];
fbs.PutF[format: " (%bB)", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];
IF printTypeNames AND AMTypes.TypeClass[ent.type ! ANY => LOOP] = definition
THEN {
fbs.PutRope[": "];
PrintType[ent.type, put]};
ENDLOOP;
fbs.PutRope["\n"];

IF zoneInfo.zoneQuantaInfo.filledQuanta > 0 THEN {
fbs.PutRope["\n  #filled quanta (1024 allocated words): "];
fbs.Put[[integer[zoneInfo.zoneQuantaInfo.filledQuanta]]]};
IF zoneInfo.zoneQuantaInfo.emptyQuanta > 0 THEN {
fbs.PutRope["\n  #empty quanta (0 allocated words): "];
fbs.Put[[integer[zoneInfo.zoneQuantaInfo.emptyQuanta]]]};
IF zoneInfo.zoneQuantaInfo.partiallyFilledQuanta # 0
THEN {
fbs.PutRope["\n  There are "];
fbs.Put[[integer[
zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.nextIndex]]];
fbs.PutRope[" partially filled quanta."]}
ELSE
FOR i: NAT IN [0 .. zoneInfo.zoneQuantaInfo.nextIndex) DO
fbs.PutRope["\n  qi: "];
fbs.Put[[integer[zoneInfo.zoneQuantaInfo.a[i].qi]]];
fbs.PutRope[", #words: "];
fbs.Put[[integer[zoneInfo.zoneQuantaInfo.a[i].words]]];
ENDLOOP;
fbs.PutRope["\n"];

};  -- end displayZoneInfo

fbs: IO.STREAM;
putC: PutProc = TRUSTED {fbs.PutChar[c]};
put: PutClosure = [putC];

zoneInfo _ NEW[ZoneInfoRec];
zoneInfo.zoneQuantaInfo _ NEW[ZoneQuantaInfoRec];
zoneInfo.zoneTypeInfo _ PriorityQueue.Predict[256, EntryPred];


last _ IF printDifferences THEN summaryTypeStatistics ELSE NIL;
summaryTypeStatistics_ IF printTypeTotals OR printDifferences 
THEN NEW[TypeStatArray] ELSE NIL;
IF printDifferences AND last = NIL 
THEN printSummaryOnly _ TRUE 
ELSE fbs _ IO.CreateViewerStreams["Cedar Storage Log"].out;
IF fbs # NIL AND label # NIL THEN fbs.PutRope[label];
SafeStorage.ReclaimCollectibleObjects[];
ZonesInWorld[visitZone, visitUZone];  -- gather statistics for each Zone, then print 'em
IF printDifferences AND last = NIL THEN RETURN;

IF printTypeTotals THEN
{
fbs.PutRope["\n\nTYPE ALLOCATION TOTALS"];
fbs.PutRope["\n\n	#words	_	#objs	(type code):	type name\n"];
FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex] DO
IF summaryTypeStatistics[i].words > wordsCutoff THEN
zoneInfo.zoneTypeInfo.Insert
[NEW[TypeEntryRec _
[type: [i],
objects: summaryTypeStatistics[i].objects,
words: summaryTypeStatistics[i].words
]]];
ENDLOOP;
WHILE NOT zoneInfo.zoneTypeInfo.Empty[] DO
ent: TypeEntry _ NARROW[zoneInfo.zoneTypeInfo.Remove[]];
IF ent.words = 0 THEN LOOP;
fbs.PutRope["\n	"];
fbs.Put[[integer[ent.words]]];
fbs.PutRope["		_	"];
fbs.Put[[integer[ent.objects]]];
IF ent.objects < 100 THEN fbs.PutRope["	"];
fbs.PutF[format: "	(%bB)", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];
IF printTypeNames AND ent.words >= wordsCutoff
THEN {
fbs.PutRope[":	"];
IF ent.type < 100B THEN fbs.PutRope["	"];
PrintType[ent.type, put];
};
ENDLOOP;
};

IF printDifferences THEN
{
fbs.PutRope["\n\nTYPE DIFFERENCES"];
fbs.PutRope["\n\n	#words	_	#objs	(type code):	type name\n"];
FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex] DO
deltaWords, deltaObjects: INT _ 0;
deltaWords _ summaryTypeStatistics[i].words - last[i].words;
deltaObjects _ summaryTypeStatistics[i].objects - last[i].objects;
IF deltaWords > wordsCutoff THEN
zoneInfo.zoneTypeInfo.Insert
[NEW[TypeEntryRec _
[type: [i],
objects: deltaObjects,
words: deltaWords
]]];
ENDLOOP;
WHILE NOT zoneInfo.zoneTypeInfo.Empty[] DO
ent: TypeEntry _ NARROW[zoneInfo.zoneTypeInfo.Remove[]];
IF ent.words = 0 THEN LOOP;
fbs.PutRope["\n	"];
fbs.Put[[integer[ent.words]]];
fbs.PutRope["		_	"];
fbs.Put[[integer[ent.objects]]];
IF ent.objects < 100 THEN fbs.PutRope["	"];
fbs.PutF[format: "	(%bB)", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];
IF printTypeNames AND ent.words >= wordsCutoff
THEN {
fbs.PutRope[":	"];
IF ent.type < 100B THEN fbs.PutRope["	"];
PrintType[ent.type, put];
};
ENDLOOP;
};

last _ summaryTypeStatistics _ NIL;
fbs.PutRope["\n\nGRAND TOTALS"];
fbs.PutRope["\n    #Zones (including UNCOUNTED ones): "];
fbs.Put[[integer[grandTotalZones]]];

fbs.PutRope["\n\n    #Pages mapped to CedarVM: "];
fbs.Put[[integer[SSExtra.PagesMappedToCedarVM[]]]];

fbs.PutRope["\n\n    #Quanta (#Pages) assigned to Zones: "];
fbs.Put[[integer[grandTotalQuanta]]];
fbs.PutRope[" ("];
fbs.Put[[integer[grandTotalQuanta*PagesPerQuantum]]];
fbs.PutRope[" )"];
fbs.PutRope["\n    #Quanta (#Pages) held by the root Base: "];
fbs.Put[[integer[RTBases.GetDQIS[]]]];
fbs.PutRope[" ("];
fbs.Put[[integer[RTBases.GetDQIS[]*PagesPerQuantum]]];
fbs.PutRope[" )"];

fbs.PutRope["\n\n    #AllocatedWords: "];
fbs.Put[[integer[grandTotalAllocatedWords]]];
fbs.PutRope["\n    #FreeWords: "];
fbs.Put[[integer[grandTotalFreeWords]]];
fbs.PutRope["\n    %Free Words of Total Words: "];
{r: REAL = grandTotalFreeWords;
fbs.Put[[real[(r/(grandTotalAllocatedWords + grandTotalFreeWords))*100]]]};

fbs.PutRope["\n\n    #AllocatedObjects: "];
fbs.Put[[integer[grandTotalAllocatedObjects]]];
fbs.PutRope["\n    #FreeObjects: "];
fbs.Put[[integer[grandTotalFreeObjects]]];

fbs.PutRope["\n\n    Total#RequestedCollectibleWords: "];
fbs.Put[[integer[RTStorageAccounting.nWordsRequested]]];
fbs.PutRope["\n    Total#SuppliedCollectibleWords: "];
fbs.Put[[integer[RTStorageAccounting.nWordsAllocated
                  + RTStorageAccounting.SUMnWordsAllocated]]];
fbs.PutRope["\n    %Total Requested Words of Total Supplied Words: "];
{r: REAL = RTStorageAccounting.nWordsRequested;
fbs.Put[[real[(r/(RTStorageAccounting.nWordsAllocated
                  + RTStorageAccounting.SUMnWordsAllocated))*100]]]};

IF grandTotalQuanta*QuantumSize
- grandTotalAllocatedWords # grandTotalFreeWords
THEN ERROR;

fbs.PutRope["\n"];
fbs.Close[];

};  -- end DoIt

ZonesInWorld: PROC[visit: PROC[Zone], visitU: PROC[UNCOUNTED ZONE]] = {
proc: PROC[uz: UNCOUNTED ZONE] RETURNS[stop: BOOL _ FALSE] = {
visitU[uz]};
FOR zi: CARDINAL IN [0..RTZones.MapZiZn.length)
DO zone: Zone _ RTZones.MapZiZn[zi];
IF zone # NIL THEN visit[zone];
ENDLOOP;
[] _ UZoneTracker.Enumerate[proc];
};

ObjectsThenRunsInUZone: ENTRY PROC
[zone: PZone,
visitUObject: PROC[addr: LONG POINTER, size: INT, free: BOOL],
visitURun: PROC[PZone, Run]] = {
ENABLE UNWIND => NULL;
WITH z: zone SELECT FROM
quantized => 
{FOR r: 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;  -- this quantum is not assigned to any subzone
WITH mz: mz SELECT FROM
sub =>
{szr: SubZone _ MapSziSz[mz.szi];
flr: FreeList _ szr.fl;
sz: CARDINAL = szr.size;
lc: CARDINAL _ 0;
p: LONG POINTER _ LOOPHOLE[LONG[qx]*QuantumSize];
bits: PACKED ARRAY [0..QuantumSize) OF BOOL _ ALL[FALSE];
IF qx = zone.qFirst THEN ERROR;  -- lc _ BaseOverhead;
WHILE flr # NIL DO
offset: INT _ LOOPHOLE[flr, INT]-LOOPHOLE[p, INT];
IF offset >= 0 AND offset < QuantumSize
THEN bits[offset] _ TRUE;
flr _ flr^;
ENDLOOP;
WHILE lc+sz <= QuantumSize DO -- for each object in the quantum
pr: LONG POINTER _ LOOPHOLE[p+lc];
free: BOOL _ bits[lc];
visitUObject[pr, sz, free];
lc _ lc + sz;
ENDLOOP;
};
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
};
prefixed => { 
freeChainCount: LONG INTEGER _ 0;
p: PFreeNode _ z.pfn;
WHILE p # NIL DO
IF (p _ p.pfnNext) = z.pfn THEN EXIT;
freeChainCount _ freeChainCount + 1;
ENDLOOP;

FOR r: Run _ zone.runs, r.rnNext WHILE r # NIL DO
q: INT _ r.iFrom;
qOver: INT _ r.iTo;
ptr: PNode _ LOOPHOLE[q*QuantumSize, LONG POINTER];
IF q = zone.qFirst THEN ERROR;  -- BaseOverhead
DO -- visit each object in the run
size: INT _ NodeLength[ptr];
free: BOOL _ ptr.state = free;
uptr: LONG POINTER _ ptr + sizeNd;
IF size = 0 THEN ERROR;
IF free
THEN freeChainCount _ freeChainCount - 1;
visitUObject[uptr, size, free];
ptr _ ptr + size; -- advance to the next object
q _ LOOPHOLE[ptr, INT]/QuantumSize;
IF q = qOver THEN {
IF ptr # LOOPHOLE[qOver * QuantumSize, PNode] THEN ERROR;
EXIT};  -- should be on the money
IF q > qOver THEN ERROR;
ENDLOOP;
ENDLOOP;

IF freeChainCount # 0 THEN ERROR;
};
ENDCASE => ERROR;
FOR r: Run _ zone.runs, r.rnNext UNTIL r = NIL DO visitURun[zone, r] ENDLOOP;
};  -- end ObjectsThenRunsInUZone

ObjectsThenRunsInZone: ENTRY PROC
[zone: PZone,
visitObject: PROC[addr: LONG POINTER, size: INT, type: Type, free: BOOL],
visitRun: PROC[PZone, Run]] =
{ENABLE UNWIND => NULL;
WITH z: zone SELECT FROM
quantized => {
FOR r: 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;  -- this quantum is not assigned to any subzone
WITH mz: mz SELECT FROM
sub => {
szr: SubZone _ MapSziSz[mz.szi];
sz: CARDINAL = szr.size;
type: Type _ szr.type;
lc: CARDINAL _ 0;
rz: PZone = LOOPHOLE[MapZiZn[szr.zi]];
p: LONG POINTER _ LOOPHOLE[LONG[qx]*QuantumSize];
bits: PACKED ARRAY [0..QuantumSize) OF BOOL _ ALL[FALSE];
IF rz # zone OR sz > QuantumSize THEN ERROR;
IF qx = rz.qFirst THEN ERROR;  -- lc _ BaseOverhead;
{-- set free bits in this quantum
flr: FreeList _ szr.fl;
WHILE flr # NIL DO
offset: INT _ LOOPHOLE[flr, INT]-LOOPHOLE[p, INT];
IF offset >= 0 AND offset < QuantumSize THEN
bits[offset] _ TRUE;
flr _ flr^;
ENDLOOP;
};
WHILE lc+sz <= QuantumSize DO -- for each object in the quantum
pr: LONG POINTER _ LOOPHOLE[p+lc];
free: BOOL _ bits[lc];
visitObject[pr, sz, type, free];
lc _ lc + sz;
ENDLOOP;
};
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP};
prefixed => {
freeChainCount: LONG INTEGER _ 0;
p: PFreeNode _ z.pfn;
WHILE p # NIL DO
IF (p _ p.pfnNext) = z.pfn THEN EXIT;
freeChainCount _ freeChainCount + 1;
ENDLOOP;

FOR r: Run _ zone.runs, r.rnNext WHILE r # NIL DO
q: INT _ r.iFrom;
qOver: INT _ r.iTo;
ptr: PNode _ LOOPHOLE[q*QuantumSize, LONG POINTER];
IF q = zone.qFirst THEN ERROR;  -- BaseOverhead
DO -- visit each object in the run
size: INT _ NodeLength[ptr];
free: BOOL _ ptr.state = free;
uptr: LONG POINTER _ ptr + sizeNd+SIZE[Type];
type: Type _ LOOPHOLE[0];
IF size = 0 THEN ERROR;
IF free
THEN freeChainCount _ freeChainCount - 1
ELSE type _ LOOPHOLE[LOOPHOLE[ptr, RTZones.InusePNode].type];
visitObject[uptr, size, type, free];
ptr _ ptr + size; -- advance to the next object
q _ LOOPHOLE[ptr, INT]/QuantumSize;
IF q = qOver
THEN {IF ptr # LOOPHOLE[qOver * QuantumSize, PNode] THEN ERROR;
EXIT};  -- should be on the money
IF q > qOver THEN ERROR;
ENDLOOP;
ENDLOOP;

IF freeChainCount # 0 THEN ERROR;
};
ENDCASE => ERROR;
FOR r: Run _ zone.runs, r.rnNext UNTIL r = NIL DO visitRun[zone, r] ENDLOOP;
};  -- end ObjectsThenRunsInZone

EntryPred: PriorityQueue.SortPred = TRUSTED {
e1: TypeEntry _ NARROW[x];
w1: INT _ e1.words;
e2: TypeEntry _ NARROW[y];
w2: INT _ e2.words;
IF w1 # w2 THEN RETURN [w1 > w2];
IF e1.objects # e2.objects
THEN RETURN [e1.objects > e2.objects];
RETURN [LOOPHOLE[e1.type, CARDINAL] > LOOPHOLE[e2.type, CARDINAL]]};

Find5AllocatedObjects: PROC[zi: CARDINAL, type: Type, skip: CARDINAL _ 0]
RETURNS[pna: REF ARRAY[0..5) OF PNode _ NIL] = {
visitObject: PROC[addr: LONG POINTER, size: INT, type: Type, free: BOOL] = {
IF NOT free AND type = otype AND nextPX < 5
THEN {
IF skipCount < skip THEN {skipCount _ skipCount + 1; RETURN};
pna[nextPX] _ addr - sizeNd - SIZE[Type];
nextPX _ nextPX + 1;
};
RETURN};
visitRun: PROC[PZone, Run] = {};
otype: Type _ type;
nextPX: CARDINAL _ 0;
skipCount: CARDINAL _ 0;
pna _ NEW[ARRAY[0..5) OF PNode _ ALL[NIL]];
ObjectsThenRunsInZone[LOOPHOLE[MapZiZn[zi], PZone], visitObject, visitRun];
-- lock is held during calls
};

Mirror: PROC[ref: REF ANY] RETURNS[REF ANY] = {
RETURN[ref];
};

PNodeToRef: PROC[pNode: PNode] RETURNS[REF ANY] = {
RETURN[LOOPHOLE[pNode+2]];
};

RefToPNode: PROC[ref:REF ANY] RETURNS[pNode: PNode] = {
RETURN[LOOPHOLE[LOOPHOLE[ref, LONG CARDINAL]-2]];
};

PNodeToRope: PROC[pNode: PNode] RETURNS[ROPE] = {
out: IO.STREAM = IO.CreateOutputStreamToRope[];
out.Put[IO.refAny[LOOPHOLE[pNode+2]]];
RETURN[out.GetOutputStreamRope[]];
};

IOTypeToRope: PROC[type: Type] RETURNS[ROPE] = {
out: IO.STREAM = IO.CreateOutputStreamToRope[];
out.Put[IO.type[type]];
RETURN[out.GetOutputStreamRope[]];
};

AMTypeToRope: PROC[type: Type] RETURNS[ROPE] = {
moduleName: REF ROPE _ NEW[ROPE];
fileName: REF ROPE _ NEW[ROPE];
typeName: ROPE _ AMTypes.TypeToName[type, moduleName, fileName];
RETURN[Cat[typeName, ", module: ", moduleName^, ", file: ", fileName^]];
};

ZoneInfo: TYPE = REF ZoneInfoRec;
ZoneInfoRec: TYPE = RECORD
[ nFreeObjects: INT _ 0,
nFreeWords: INT _ 0,
nAllocatedObjects: INT _ 0,
nAllocatedWords: INT _ 0,
zoneQuantaInfo: ZoneQuantaInfo _ NIL,
zoneTypeInfo: PriorityQueue.Ref _ NIL
];

ZoneQuantaInfo: TYPE = REF ZoneQuantaInfoRec;
ZoneQuantaInfoRec: TYPE = RECORD
[ nextIndex: NAT _ 0,
emptyQuanta: NAT _ 0,
filledQuanta: NAT _ 0,
partiallyFilledQuanta: NAT _ 0, -- non-zero implies more than ZQALength such quanta
wordsInPartiallyFilledQuanta: INT _ 0,
a: ARRAY [0 .. ZQALength) OF RECORD[qi: NAT, words: NAT] _ ALL[[0, 0]]
];
ZQALength: NAT = 32;

TypeEntry: TYPE = REF TypeEntryRec;
TypeEntryRec: TYPE = RECORD[type: Type,
objects, words: INT];


garbage: REF TypeStatArray;
RTReclaimerImpl: PrincOps.GlobalFrameHandle _ NIL;
reclaimPC: CARDINAL _ 604B; -- found by doing a code listing
refTypeOffset: CARDINAL _ 7; -- found by doing a code listing (SL7)
break: FastBreak.FastBreakId _ NIL;
monitoring: BOOLEAN _ FALSE;

InitializeMonitor: PROC = BEGIN
gfTV: AMTypes.TV;
gfTV _ BBContext.GlobalFrameSearch[NIL, "RTReclaimerImpl", NIL].gf;
IF gfTV # NIL THEN RTReclaimerImpl _ AMBridge.GFHFromTV[gfTV];
END; 

StartReclaimerMonitor: PROC = BEGIN
IF monitoring THEN RETURN;
IF garbage = NIL 
THEN garbage _ NEW[TypeStatArray]
ELSE garbage^ _ ALL[];
IF RTReclaimerImpl = NIL THEN InitializeMonitor[];
break _ FastBreak.SetFastBreak[RTReclaimerImpl.code.longbase, [reclaimPC], ReclaimerMonitor];
monitoring _ TRUE;
END;

ReclaimerMonitor: FastBreak.FastBreakProc = BEGIN
FetchRef: PROC[frame: PrincOps.FrameHandle] RETURNS[LONG CARDINAL] = 
MACHINE CODE {Mopcodes.zRDB, 11B}; -- location of 'ref' in MapReclaimableObjects
pNode: RTZones.PNode;
refType: AMTypes.Type;
refType _ frame.local[refTypeOffset]; -- extract the local variable 'refType' 
pNode _ LOOPHOLE[FetchRef[frame] - 2]; -- extract 'ref'; convert it to a PNode
garbage[refType].objects _ garbage[refType].objects + 1;
garbage[refType].words _ garbage[refType].words + RTZones.NodeLength[pNode];
END;

PrintReclaimedTypes: PROC[wordsCutoff: INT _ 100, printTypeNames: BOOL _ TRUE] = BEGIN
fbs: IO.STREAM;
putC: PutProc = TRUSTED {fbs.PutChar[c]};
put: PutClosure = [putC];
priorityQueue: PriorityQueue.Ref;

IF monitoring THEN monitoring _ ~FastBreak.ClearFastBreak[break, ReclaimerMonitor];
priorityQueue _ PriorityQueue.Predict[256, EntryPred];
fbs _ IO.CreateViewerStreams["Garbage Collection Log"].out;
fbs.PutRope["\n\nTYPE COLLECTION TOTALS"];
fbs.PutRope["\n\n	#words	_	#objs	(type code):	type name\n"];

FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex] DO
IF garbage[i].words > wordsCutoff THEN
priorityQueue.Insert[NEW[TypeEntryRec _ 
[type: [i], objects: garbage[i].objects, words: garbage[i].words]]];
ENDLOOP;

WHILE NOT priorityQueue.Empty[] DO
ent: TypeEntry _ NARROW[priorityQueue.Remove[]];
IF ent.words = 0 AND ent.objects = 0 THEN LOOP;
fbs.PutRope["\n	"];
fbs.Put[[integer[ent.words]]];
fbs.PutRope["		_	"];
fbs.Put[[integer[ent.objects]]];
IF ent.objects < 100 THEN fbs.PutRope["	"];
fbs.PutF[format: "	(%bB)", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];
IF printTypeNames THEN {
fbs.PutRope[":	"];
IF ent.type < 100B THEN fbs.PutRope["	"];
PrintTV.PrintType[ent.type, put];
};
ENDLOOP;

IF ~monitoring THEN garbage _ NIL; 
END;



GarbageSequence: TYPE = RECORD[s: SEQUENCE index: NAT OF Garbage];
Garbage: TYPE = RECORD[
marked: BOOLEAN _ FALSE,
examined: BOOLEAN _ FALSE,
ref: REF _ NIL];
StackSequence: TYPE = RECORD[s: SEQUENCE index: NAT OF Frame];
Frame: TYPE = RECORD[
return: NAT _ 0, -- return frame
start, stop: NAT _ 0, -- children's frames
gi: NAT _ 0]; -- index into garbage
printLinks, skip: BOOLEAN _ FALSE;


PrintCircularGarbage: PROCEDURE = BEGIN
stream: IO.STREAM;
allocations, words: INT _ 0;
type: RTBasic.TypeIndex;
stack: REF StackSequence;
garbage: REF GarbageSequence;
si, pc, maxStack: NAT _ 0; -- for stack
gi, index, length: NAT _ 0; -- for garbage
CountGarbage: PROC[ref: REF] = {
pNode: PNode = RefToPNode[ref];
WITH p: pNode SELECT FROM
inuse => IF ~p.marked THEN length _ length + 1;
ENDCASE => RETURN};
FillSequence: PROC[ref: REF] = {
pNode: PNode = RefToPNode[ref];
IF ref = garbage THEN RETURN; 
IF index >= length THEN RETURN;
WITH p: pNode SELECT FROM
inuse => IF ~p.marked THEN {
words _ words + pNode.SizeLo;
garbage[index].ref _ ref; 
index _ index + 1};
ENDCASE};
AddRef: PROC[ref: REF ANY] = {
IF si = maxStack THEN { -- create a bigger stack
temp: REF StackSequence;
maxStack _ maxStack + 50;
temp _ NEW[StackSequence[maxStack]];
FOR i: NAT IN [0..si) DO temp[i] _ stack[i]; ENDLOOP;
stack _ temp};
stack[si].gi _ FindRefInGarbage[ref];
IF stack[si].gi = index THEN RETURN;
IF printLinks AND pc # 10000 THEN {
stream.Put[IO.int[stack[pc].gi], IO.rope[" => "], IO.int[stack[si].gi]];
stream.Put[IO.rope["\n"]]};
IF garbage[stack[si].gi].examined THEN RETURN;
stack[si].start _ stack[si].stop _ 0;
stack[si].return _ pc;
si _ si + 1};
FindRefInGarbage: PROC[ref: REF ANY] RETURNS[NAT]= INLINE {
FOR i: NAT IN [0..index) DO 
IF garbage[i].ref = ref THEN RETURN[i]; 
ENDLOOP;
RETURN[index]};
PrintCycle: PROC[pc, gi: NAT] RETURNS[depth: NAT _ 0] = {
IF stack[pc].gi # gi THEN depth _ PrintCycle[stack[pc].return, gi] + 1;
PrintRef[garbage[stack[pc].gi].ref, depth];
garbage[stack[pc].gi].examined _ TRUE};
PrintRef: PROC[ref: REF ANY, depth: NAT] = {
type: RTBasic.TypeIndex;
pNode: PNode = RefToPNode[ref];
WITH p: RefToPNode[ref] SELECT FROM
inuse => type _ p.type;
ENDCASE => RETURN; 
stream.Put[IO.rope["\n"]];
IF depth = 0 THEN stream.Put[IO.rope["\n"]];
FOR i: CARDINAL IN [0..depth) DO stream.Put[IO.rope["  "]]; ENDLOOP;
stream.Put[IO.rope[IOTypeToRope[LOOPHOLE[type]]]];
stream.Put[IO.rope[" ("], IO.card[LOOPHOLE[ref]], IO.rope[")"]]};
ClearMarks: PROC[ref: REF] = {
pNode: PNode = RefToPNode[ref];
WITH p: pNode SELECT FROM
inuse => p.marked _ FALSE;
ENDCASE => RETURN};

stack _ NEW[StackSequence[maxStack _ 200]];
RTTraceAndSweepImpl.FindCircularGarbage[];
ZoneCleanupImpl.EnumerateAllObjects[CountGarbage];
garbage _ NEW[GarbageSequence[length_ length + 30]];
ZoneCleanupImpl.EnumerateAllObjects[FillSequence];

stream _ IO.CreateViewerStreams["Garbage"].out;
allocations _ 30 - (length - index);
IF allocations # 0 THEN stream.Put[IO.int[allocations], IO.rope[" objects allocated while processing was in progress.\n"]];
stream.Put[IO.rope["total words in circular structures: "], IO.int[words], IO.rope["\n"]];
stream.Put[IO.rope["total objects processed: "], IO.int[index], IO.rope["\n\n"]];

FOR i: CARDINAL IN [0..index) DO
IF RefCounts.GetCount[LOOPHOLE[garbage[i].ref]].count # 127 THEN LOOP;
stream.Put[IO.rope["\n\n"], IO.refAny[garbage[i].ref], IO.rope[" (pinned)\n"]];
garbage[i].examined _ TRUE;
ENDLOOP;
FOR c: CARDINAL IN [0..index) DO
si _ 0; pc _ 10000;
AddRef[garbage[c].ref]; -- start the stack
pc _ 0;
WHILE pc # 10000 DO
gi _ stack[pc].gi;
IF stack[pc].start = 0 THEN {
IF garbage[gi].examined THEN {pc _ stack[pc].return; LOOP}; 
IF garbage[gi].marked THEN { -- we found a cycle!
depth: NAT _ PrintCycle[stack[pc].return, gi] + 1;
PrintRef[garbage[gi].ref, depth]; 
garbage[gi].examined _ TRUE;
pc _ stack[pc].return; LOOP};  -- return to parent
WITH p: RefToPNode[garbage[gi].ref] SELECT FROM
inuse => type _ p.type;
ENDCASE => ERROR;
garbage[gi].marked _ TRUE;
IF stack[pc].return # 10000 THEN -- trim the stack 
si _ stack[stack[pc].return].stop; 
stack[pc].start _ si; 
RTTypesBasicPrivate.MapRefs[
LOOPHOLE[garbage[gi].ref],  
RTTypesBasicPrivate.MapTiRcmx[type],
AddRef];
stack[pc].stop _ si};
IF stack[pc].start < stack[pc].stop THEN { -- call the next child
stack[pc].start _ stack[pc].start + 1;
pc _ stack[pc].start - 1; LOOP};
IF stack[pc].start = stack[pc].stop THEN { -- return to the parent
garbage[gi].marked _ FALSE;
IF ~skip THEN garbage[gi].examined _ TRUE; -- no need to process this one any more
pc _ stack[pc].return; LOOP};
ENDLOOP;
ENDLOOP;
ZoneCleanupImpl.EnumerateAllObjects[ClearMarks];
END;

END . . .


JScanZones.mesa
Changes by
John Maxwell, June 7, 1983 10:21 am
Russ Atkinson, January 27, 1983 9:48 am
Paul Rovner, February 17, 1983 3:54 pm
Just like DoIt, but always performs for all zones.

Call this guy from the interpreter to do the work.  Some useful idioms:
DoIt[printTypeTotals: TRUE, printSummaryOnly: TRUE, wordsCutoff: 1000, printTypeNames: TRUE]
for prefixed zones, addr = PNode + sizeNd
and size = NodeLength[addr].
NOTE zone lock is held 
for prefixed zones, addr = PNode + sizeNd + SIZE[Type]
and size = NodeLength[addr].
if free, type = 0
NOTE zone lock is held 
NOTE zone lock is held
visit each object in each quantum according to the subzone
this quantum is not assigned to any subzone
set free bits in this quantum
a completely full quantum
an empty quantum
a new partially filled quantum
a completely full quantum
an empty quantum
here with a new partially filled quantum
should be on the money
START DoIt HERE
this proc visits each zone in the world
ObjectsThenRunsInUZone visits all objects in the zone, then all Runs.
visitUObject: for prefixed zones, addr = PNode + sizeNd
and size = NodeLength[addr].
NOTE zone lock is held during calls on both visitUObject and visitURun
visit each object in each subzone
now set free bits in this quantum
first, count the free objects for the check
count the free objects (there is at least the bogus one in the zone!)
next, visit all of the objects, both allocated and freed
last, check the free chain count for consistency
ObjectsThenRunsInZone visits all objects in the zone, then all Runs.
visitObject: for prefixed zones, addr = PNode + sizeNd + SIZE[Type]
and size = NodeLength[addr].
if free, type = 0
NOTE zone lock is held during calls on both visitObject and visitRun
visit each object in each quantum according to the subzone
first, count the free objects for the check
count the free objects (there is at least the bogus one in the zone!)
next, visit all of the objects, both allocated and freed
last, check the free chain count for consistency
TYPEs

**************************************************************************
RECLAIMER MONITOR -- records the distribution of reclaimed garbage by type
general procedure: StartReclaimerMonitor[]; . . . (do whatever) . . . PrintReclaimedTypes[]
PrintReclaimedTypes will stop the monitor and deallocate the data structures.
**************************************************************************
-- set a break where MapReclaimableObjects calls Reclaim
-- data: FastBreakData, frame: PrincOps.FrameHandle, sv: PrincOps.SVPointer]
-- RETURNS [useOldBreak: BOOL _ FALSE]
-- records the size and type of garbage as it gets reclaimed
**************************************************************************
PrintCircularGarbage
**************************************************************************

-- non-recursive tree walk
add the children to the stack

�Ê&ĘJš
œ™š
œ
™
J™#Jš
œ'™'Jš
œ&™&—J˜š
Ïk	˜	Jšœ	�œ
˜Jšœ�œ�œ˜0Jšœ
�œ˜$Jšœ
�œ<˜Kš�œ
�˜Jšœ
�œ‰
˜�
—Jšœ	�œ˜Jšœ	�œ"˜0Jšœ�œ"˜/Jšœ�œ1˜DJšœ�œ�œ˜Jšœ
�œ˜Jšœ�œ˜ Jšœ�œ˜Jšœ	�œ ˜.JšœÏcŽ
˜Ÿ
Jšœ�œ8˜QJšœ�œ˜/Jšœ�œ˜/Jšœ�œ˜šœ�˜
J˜„
—Jšœ�œ˜.Jšœ�œ˜%Jšœ
�œ˜Jšœ�œ˜,—J˜Jš	œ�œ
�œ�œ
�œ˜4Jš�œ*�œ¯
˜â
Jš�œ(�œ
˜4J˜Jš�œ1˜5J˜Jšœ�œ˜Jšœ�œ�œ�œ˜9Jšœ�œ�œ�œ˜.Jšœ�œ˜/J˜Jš
œ2™2šÏnœ�˜šœ�œ	ž7˜QJšœ�œ�œ˜!—Jšœ�œ�œ˜,J˜J˜—šŸœ�œ
�œ�œ˜YJšœ�œ�œ˜>—J™š
œG™GJš
œ\™\—šÏbœ�˜
šœ�œ	ž7˜QJšœ�œ�œž ˜;Jšœ�	œ
�œ�œž!˜GJšœ�œ�œ
˜Jšœ�œ�˜Jšœ�œ�˜Jšœ�œ�˜Jšœ�œ�œ˜—J˜9J˜0Jšœ�œ˜"J˜J˜Jšœ�œ�œ˜7Jšœ�œ˜Jšœ�œ˜J˜J˜šœ�œ�	œ
�œ˜(Jš
�œ�œ
�œ�œ
�œ
˜<J˜
š
œ˜Jš�œ�œ
�œ
�œ	˜%J˜
J˜
—š�œ
�œ"˜)J˜/J˜%J˜3J˜0Jš�œ
�œ
˜J˜—š�œ
�œ˜Jš�œ�œ�œ
�œ
�œ
�œ˜A—J˜&˜#J˜#J˜/J˜%J˜'—J˜FJ˜@J˜UJ˜OJ˜—šœ�œ˜Jš�œ�œ
�œ
�œ�œ�œ
�œ
˜LJ˜
Jšœ�œ˜=š�œ
�œ˜š
�˜š�œ�œ�˜4š�œ'�˜-˜šœ
�œ˜˜J˜#J˜—J˜————Jš�œ
˜——š�œ
�œ"˜)J˜/J˜%J˜3J˜0Jš�œ
�œ
˜J˜—š�œ
�œ˜Jš�œ�œ�œ˜3—š�œ�œ�œ�˜Sš
�˜š
œ ˜ Jš
œ?˜?—š
œ˜Jš
œ;˜;——Jš�œ
˜—J˜&˜#J˜#J˜/J˜%J˜'—J˜FJ˜@J˜UJ˜OJ˜—šœ�œ�œ
�œ�œ�œ˜AJš
œ)™)Jš
œ™Jš
œ™š�œ˜š�œ˜Jš
œ2˜2J˜1—š�œ˜Jš
œ<˜<J˜;J˜2J˜1J˜——J˜—šœ
�œ�œ
�œ�œ�œ˜LJš
œ6™6Jš
œ™Jš
œ™Jš
œ™Jšœ�œ�œ˜š�œ˜š�œ4˜8J˜1—š�œ>˜BJ˜;š�œ˜š�œ<˜@J˜9—š�œ4˜8J˜2——J˜——J˜—šœ
�œ˜)Jš
œ™Jšœ�œ
˜Jšœ�œ
˜š�œ	�œ
�˜˜Jš
œ:™:š�œ�œ
�œ�˜!J˜š�œ˜š�œ˜Jš
œ+™+š
œ#˜#J˜*—J˜8Jš�œ˜J˜——š�œ�œ
�˜˜J˜ Jšœ�œ˜Jš	œ�œ
�œ�œ
�œ˜1Jš
œ�œ
�œ�œ
�œ�œ
�œ˜9Jš
œ™J˜Jšœ�œ˜Jšœ�œ�œ
˜-J˜š�œ�œ
�˜Jšœ�œ�œ�œ�œ�œ˜2š�œ
�œ�˜,Jšœ�œ
˜—J˜Jš�œ
˜—š�œ�œ
ž!˜EJšœ�œ
�œ�œ˜"Jš�œ
�œ
�œ˜.J˜Jš�œ
˜—š�œ�˜š
œ˜Jš
œ™š
œ$˜$J˜+——š
œ˜Jš
œ™š
œ#˜#J˜*—J˜9J˜—š�œ˜Jš
œ™š�œ.˜0š�œ˜˜-J˜4—˜4˜6J˜———š�œ˜˜!J˜(—˜>J˜———J˜9J˜——J˜—Jš�œ�œ
˜——Jš�œ
˜—J˜˜
Jšœ
�œ�œ
�œ˜3Jšœ�œ˜Jšœ�œ˜š�œ
ž˜"Jšœ�œ˜Jšœ�œ˜Jšœž˜/š�œ
�œ�œ˜%š�œ�œ˜
Jš�œ/˜3Jš�œ/˜3J˜
—š�œ˜Jšœ�œ9˜?š�œ˜Jš�œ,˜0Jš�œ-˜1—š�œ�˜š
œ˜Jš
œ™š
œ$˜$J˜+——š
œ˜Jš
œ™š
œ#˜#J˜)——š�œ˜Jš
œ(™(š�œ.˜0š�œ˜˜-J˜4—˜4˜6J˜———š�œ˜˜!J˜(—˜>J˜———J˜——J˜J˜š�œ�œ
�œ	�œ�œ�˜8š�œ˜š
�˜š
œ#˜#J˜)——š
�˜š
œ$˜$J˜+———Jš�œ
˜—J˜——Jšœ�œ�œž˜Bš�œ�œ˜Jš
œ™Jš�œ�œ�œ
�œ
˜9Jš�œ˜—Jš�œ�œ
�œ
˜Jš�œ
˜—J˜—Jš�œ�œ
˜—J˜—šœ�œ˜J˜J˜J˜J˜J˜&J˜(J˜)J˜2J˜9š�œ�œ˜+Jš�œ'�œ
˜1—š�œ�œ˜1Jš�œ�œ
˜&—J˜J˜J˜J˜—šœ�œ�œ˜7Jšœ�œ˜Jšœ�œ�œ
˜J˜Jš�œ�œ˜+J˜J˜š�œ˜Jš�œ˜!Jš�œ˜#—˜2J˜/J˜%J˜*—J˜J˜J˜ J˜(J˜"J˜*J˜J˜%J˜-J˜'J˜/J˜J˜š�œ
�œ�˜*Jšœ�œ!˜8š�œ�œ˜Jšœ�œ
˜J˜<J˜—J˜J˜J˜J˜ Jšœ)�œ�œ˜IJš�œ�œ�œ�œ˜Lš�œ˜J˜Jš
œ˜—Jš�œ
˜—J˜J˜š�œ*�œ˜2Jš
œ;˜;J˜:—š�œ)�œ˜1Jš
œ7˜7J˜9—š�œ2˜4š�œ˜J˜˜J˜-J˜'—J˜)—š
�˜š�œ�œ
�œ*�˜9J˜J˜4J˜J˜7Jš�œ
˜———J˜J˜Jšœž˜J˜—Jš
œ™Jšœ�œ
�œ
˜Jšœ�œ˜)J˜J˜Jšœ�œ˜Jšœ�œ˜1J˜>J˜J˜Jš	œ�œ�œ�œ
�œ
˜?šœ�œ�œ˜>Jš�œ
�œ�œ
�œ
˜!—š�œ�œ�œ
˜#Jš�œ�œ
˜Jš�œ�œ.˜;—Jš
�œ�œ
�œ	�œ
�œ˜5Jš
œ(˜(Jšœ&ž2˜XJš
�œ�œ�œ
�œ
�œ
˜/J˜š�œ�˜˜
J˜*J˜<š�œ�œ�˜4š�œ.�˜4˜šœ
�œ˜˜Jš
œ*˜*Jš
œ%˜%—J˜————Jš�œ
˜š�œ
�œ�˜*Jšœ�œ!˜8Jš�œ�œ
�œ
˜J˜J˜J˜J˜ Jš�œ�œ˜+Jšœ)�œ�œ˜Iš�œ�œ˜.š�œ˜Jš
œ˜Jš�œ�œ˜)Jš
œ˜Jš
œ˜——Jš
�˜—J˜—J˜š�œ�˜˜
J˜$J˜<š�œ�œ�˜4Jšœ�œ˜"Jš
œ<˜<Jš
œB˜Bš�œ�˜ ˜šœ
�œ˜˜Jš
œ˜Jš
œ˜—J˜————Jš�œ
˜š�œ
�œ�˜*Jšœ�œ!˜8Jš�œ�œ
�œ
˜J˜J˜J˜J˜ Jš�œ�œ˜+Jšœ)�œ�œ˜Iš�œ�œ˜.š�œ˜Jš
œ˜Jš�œ�œ˜)Jš
œ˜Jš
œ˜——Jš
�˜——Jš
œ˜——J˜Jšœ�œ
˜#J˜ J˜9J˜$J˜J˜2Jš
œ3˜3J˜J˜<J˜%J˜Jš
œ5˜5J˜J˜>Jš
œ&˜&J˜Jš
œ6˜6J˜J˜J˜)J˜-J˜"J˜(J˜2šœ�œ˜J˜KJ˜—J˜+J˜/J˜$J˜*J˜J˜9Jš
œ8˜8J˜6Jš
œs˜sJ˜Fšœ�œ'˜/Jš
œ{˜{J˜—š�œ˜J˜0Jš�œ
�œ
˜J˜—J˜J˜J˜Jšœž˜J˜—šŸœ�œ�œ�œ
�	œ
�œ˜GJš
œ'™'š
œ�œ�	œ
�œ�œ�œ�œ˜>J˜—š�œ�œ
�œ˜/š�œ"˜$Jš�œ�œ
�œ
˜—Jš�œ
˜—J˜"J˜J˜—šŸœ�œ
�˜"˜
Jšœ�œ�œ
�œ�œ�œ˜>Jšœ�œ˜ —š
œE™Eš
œ7™7Jš
œ™——Jš
œF™Fš�œ
�œ�œ
˜š�œ	�œ
�˜˜
Jš
œ!™!šœ
�œ�œ�œ
�˜2š�œ�œ
�œ�˜'J˜Jš�œ�œ
�œž.˜Kš�œ�œ
�˜˜˜!J˜Jšœ�œ˜Jšœ�œ˜Jš	œ�œ
�œ�œ
�œ˜1Jš
œ�œ
�œ�œ
�œ�œ
�œ˜9š�œ�œ
�œž˜6Jš
œ!™!—š�œ�œ
�˜Jšœ�œ�œ�œ�œ�œ˜2š�œ
�œ˜'Jš�œ�œ
˜—J˜Jš�œ
˜—š�œ�œ
ž!˜?Jšœ�œ
�œ�œ˜"Jšœ�œ˜J˜J˜
Jš�œ
˜—J˜——Jš�œ�œ
˜—Jš�œ
˜—Jš�œ
˜—J˜—˜Jš
œ+™+Jšœ�œ
�œ˜!J˜š�œ�œ
�˜Jš
œE™EJš�œ�œ
�œ
˜%J˜$Jš�œ
˜J˜—Jš
œ8™8š�œ�œ�œ
�˜1Jšœ�œ˜Jšœ�œ	˜Jšœ
�œ�œ
�œ˜3Jš�œ�œ
�œž˜/š�œ
ž˜"Jšœ�œ˜Jšœ�œ˜Jšœ�œ
�œ˜"Jš�œ
�œ
�œ
˜š�œ˜Jš�œ%˜)—J˜Jšœž˜/Jšœ�œ�œ˜#š�œ�œ˜Jš�œ�œ�œ
�œ
˜9Jš�œž˜!—Jš�œ�œ
�œ
˜Jš�œ
˜—Jš�œ
˜J˜—Jš
œ0™0Jš�œ�œ
�œ
˜!J˜—Jš�œ�œ
˜—Jš
�œ�œ�œ
�œ�œ
˜M—Jšœž˜!J˜—šŸœ�œ
�˜!˜
Jšœ
�œ�œ
�œ�œ�œ˜IJšœ
�œ˜—š
œD™Dš
œC™CJš
œ™Jš
œ™——Jš
œD™Dšœ
�œ
�œ�œ
˜š�œ	�œ
�˜˜Jš
œ:™:š�œ�œ�œ
�˜1š�œ�œ
�œ�˜'J˜Jš�œ�œ
�œž.˜Kš�œ�œ
�˜˜J˜ Jšœ�œ˜J˜Jšœ�œ˜Jšœ�œ˜&Jš	œ�œ
�œ�œ
�œ˜1Jš
œ�œ
�œ�œ
�œ�œ
�œ˜9Jš�œ�œ�œ
�œ
˜,Jš�œ�œ
�œž˜4šœ
ž ˜!J˜š�œ�œ
�˜Jšœ�œ�œ�œ�œ�œ˜2š�œ
�œ�˜,Jšœ�œ
˜—J˜Jš�œ
˜—J˜—š�œ�œ
ž!˜?Jšœ�œ
�œ�œ˜"Jšœ�œ˜J˜ J˜
Jš�œ
˜—J˜—Jš�œ�œ
˜—Jš�œ
˜—Jš�œ˜	——˜
Jš
œ+™+Jšœ�œ
�œ˜!J˜š�œ�œ
�˜Jš
œE™EJš�œ�œ
�œ
˜%J˜$Jš�œ
˜J˜—Jš
œ8™8š�œ�œ�œ
�˜1Jšœ�œ˜Jšœ�œ	˜Jšœ
�œ�œ
�œ˜3Jš�œ�œ
�œž˜/š�œ
ž˜"Jšœ�œ˜Jšœ�œ˜Jšœ�œ
�œ�œ˜-Jšœ
�œ˜Jš�œ
�œ
�œ
˜š�œ˜Jš�œ$˜(Jš�œ�œ
�œ ˜=—J˜$Jšœž˜/Jšœ�œ�œ˜#š�œ
˜š
�œ�œ�œ�œ
�œ
˜?Jš�œž˜!——Jš�œ�œ
�œ
˜Jš�œ
˜—Jš�œ
˜J˜Jš
œ0™0Jš�œ�œ
�œ
˜!—J˜—Jš�œ�œ
˜—Jš
�œ�œ�œ
�œ�œ
˜L—Jšœž˜ J˜—šœ$�	˜-Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jš�œ	�œ
�œ˜!š�œ˜Jš�œ
�œ˜&—Jš
�œ�œ
�œ�œ
�œ˜DJ˜—šŸœ�œ�œ�œ˜IJš
�œ�œ
�œ�œ	�œ˜0šœ
�œ�œ
�œ�œ�œ˜LJš�œ
�œ�œ�œ˜+š�œ˜Jš�œ�œ�œ˜=Jšœ�œ˜)Jš
œ˜Jš
œ˜—Jš�œ˜—Jšœ
�œ˜ Jš
œ˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ
�œ�œ	�œ
�œ˜+š
œK˜KJš
ž˜—Jš
œ˜—J˜šŸœ�œ�œ
�œ�œ
�œ
�œ˜/Jš�œ˜Jš
œ˜J˜—š
Ÿ
œ�œ�œ
�œ
�œ˜3Jš�œ
�œ˜Jš
œ˜J˜—š
Ÿ
œ�œ�œ
�œ�œ˜7Jš
�œ
�œ
�œ�œ
�œ˜1Jš
œ˜J˜—šŸœ�œ�œ
�œ˜1Jšœ�œ
�œ�œ˜/Jšœ�œ�œ˜&Jš�œ˜"Jš
œ˜J˜—šŸœ�œ
�œ
�œ˜0Jšœ�œ
�œ�œ˜/Jšœ�œ
˜Jš�œ˜"Jš
œ˜J˜—šŸœ�œ
�œ
�œ˜0Jš	œ�œ
�œ�œ
�œ˜!Jš	œ
�œ
�œ�œ
�œ˜Jšœ
�œ2˜@Jš�œB˜HJš
œ˜—J˜š
œ™J™—Jšœ
�œ�œ
˜!šœ
�œ�˜šœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ!�œ
˜%Jšœ"�˜%—J˜J˜—Jšœ�œ�œ˜-šœ�œ�˜ šœ
�œ˜Jšœ
�œ˜Jšœ�œ˜Jšœ�œž3˜SJšœ�œ˜&Jš
œ�œ�œ
�œ�œ	�œ�œ˜F—J˜—Jšœ�œ˜J˜Jšœ�œ�œ˜#šœ�œ�œ˜'Jšœ�œ˜—J˜Jš
œJ™JJš
œJ™JJš
œ[™[Jš
œM™MJš
œJ™JJ˜J˜Jšœ.�œ
˜2Jšœ�œ	ž ˜<Jšœ�œž&˜CJšœ�œ
˜#Jšœ�œ�œ
˜J˜šŸœ�œ�˜Jšœ�œ
˜Jšœ#�œ�œ˜CJš�œ�œ
�œ,˜>Jš�œ˜J˜—šŸœ�œ�˜#Jš�œ�œ
�œ
˜š�œ�œ
˜Jš�œ�œ˜!Jš�œ�œ˜—Jš�œ�œ
�œ˜2Jš
ž8™8J˜]Jšœ
�œ
˜Jš�œ
˜J˜—š œ�˜1Jš
œL™LJš�
œ�œ�œ
™&J™<š
Ÿœ�œ�œ
�œ
�œ˜EJš�œ
�œž-˜P—J˜J˜Jšœ&ž(˜NJšœ�œž'˜NJ˜8J˜LJš�œ
˜J˜—šŸœ�œ�œ�œ�œ�˜VJšœ�œ
�œ
˜Jšœ œ�œ˜)Jš
œ˜Jš
œ!˜!J˜Jš�œ�œA˜SJš
œ6˜6Jšœ�œ3˜;J˜*J˜<J˜š�œ�œ�˜4š�œ �˜&šœ�œ˜(Jš
œD˜D——Jš�œ
˜J˜—š�œ
�œ�˜"Jšœ�œ˜0Jš�œ�œ�œ
�œ
˜/J˜J˜J˜J˜ Jš�œ�œ˜+Jšœ)�œ�œ˜Iš�œ�œ˜š
œ˜Jš�œ�œ˜)Jš
œ!˜!Jš
œ˜——Jš
�˜J˜—Jš�œ
�œ�œ˜#Jš�œ
˜—˜J˜—Jš
œJ™JJ™Jš
œJ™JJ˜Jšœ�œ�œ�œ�œ
�œ
˜Bšœ	�œ�œ
˜Jšœ�œ�œ
˜Jšœ
�œ�œ
˜Jšœ�œ�œ˜—Jšœ�œ�œ�œ�œ
�œ˜>šœ�œ�œ
˜Jšœ�œž˜ Jšœ
�œž˜*Jšœ�œž˜#—šœ�œ�œ
˜"J˜—J˜šŸœ�	œ�˜'Jšœ�œ
�œ
˜Jšœ�œ˜J˜Jšœ�œ˜Jšœ	�œ˜Jšœ�œž˜'Jšœ�œž˜*šŸœ�œ�œ˜ Jš
œ˜š�œ
�œ
�˜Jšœ	�œ�œ˜/Jš�œ�œ˜——šŸœ�œ�œ˜ Jš
œ˜Jš�œ�œ
�œ˜Jš�œ�œ
�œ
˜š�œ
�œ
�˜šœ	�œ�œ˜J˜Jš
œ˜Jš
œ˜—Jš�œ˜	——šŸœ�œ�œ
�œ˜š�œ�œž˜0Jšœ�œ˜Jš
œ˜Jšœ�œ˜$Jš
�œ�œ
�œ	�œ�œ
˜5J˜—Jš
œ%˜%Jš�œ�œ
�œ
˜$š�œ�œ�œ˜#Jšœ�œ�œ�œ˜HJšœ�œ˜—Jš�œ �œ
�œ
˜.J˜%J˜J˜
—šŸœ�œ�œ
�œ�œ
�œ�œ˜;š�œ�œ
�œ�œ
˜Jš�œ�œ
�œ˜(Jš
�˜—Jš�œ	˜—š
Ÿ
œ�œ	�œ�œ�œ	˜9Jš�œ�œ.˜GJ˜+Jšœ!�œ˜'—š
Ÿœ�œ�œ
�œ	�œ˜,J˜Jš
œ˜š�œ�œ
�˜#J˜Jš�œ�œ˜—Jšœ�œ
˜Jš�œ�œ�œ
˜,Jš�œ�œ
�œ�œ�œ�œ
˜DJšœ�œ�œ
˜2Jš	œ�œ
�œ�œ�œ
˜A—šŸ
œ�œ�œ˜Jš
œ˜š�œ
�œ
�˜Jšœ�œ
˜Jš�œ�œ˜——J˜Jšœ�œ ˜+Jš
œ*˜*Jš
œ2˜2Jšœ
�œ'˜4Jš
œ2˜2J˜Jšœ	�œ$˜/J˜$Jš�œ�œ�œ�œA˜{Jšœ�œ/�œ
�œ
˜ZJšœ�œ$�œ
�œ˜QJ˜š�œ�œ
�œ�˜ Jš�œ�œ�œ
�œ
˜FJšœ�œ�œ�œ˜OJšœ�œ
˜Jš�œ
˜—J™Jš
ž™š�œ�œ
�œ�˜ Jšœ�
œ˜Jšœž˜*J˜š�œ�˜Jš
œ˜š�œ�œ˜Jš�œ�œ�œ˜<š�œ�œž˜1Jšœ�œ(˜2Jš
œ"˜"Jšœ�œ
˜Jšœ�œž˜2—š�œ �œ
�˜/J˜Jš�œ�œ
˜—Jšœ�œ
˜Jš
œ™š�œ�œ
ž˜3Jš
œ#˜#—Jš
œ˜š
œ˜Jš�œ˜Jš
œ$˜$Jš
œ˜—J˜—š�œ"�œž˜AJš
œ&˜&Jšœ�œ˜ —š�œ"�œž˜BJšœ�œ
˜Jš�œ�œ�œž'˜RJšœ�œ˜—Jš�œ
˜—Jš�œ
˜—J™Jš
œ0˜0Jš�œ
˜—J˜Jš�œ˜	J˜J˜—…—|ä®ò