[Indigo]<Cedar>ScanZones>ScanZones.mesa!4

ScanZones.mesa

Changes by

John Maxwell, March 24, 1983 10:46 am

Russ Atkinson, January 27, 1983 9:48 am

Paul Rovner, February 17, 1983 3:54 pm

DIRECTORY

AMTypes USING [TypeClass, TypeToName],

IO USING

[STREAM, card, PutChar, Close, int, PutRope, Put, PutF, CreateViewerStreams, CreateOutputStreamToRope, refAny, rope, type, GetOutputStreamRope],

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],

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 AMTypes, 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[allocatedObjects, allocatedWords: INT ← 0];

summaryTypeStatistics, last: REF TypeStatArray;

Just like DoIt, but always performs for all zones.

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]};

Call this guy from the interpreter to do the work. Some useful idioms:

DoIt[printTypeTotals: TRUE, printSummaryOnly: TRUE, wordsCutoff: 1000, printTypeNames: TRUE]

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].allocatedWords > wordsCutoff THEN

zoneInfo.zoneTypeInfo.Insert

[NEW[TypeEntryRec ←

[type: [i],

allocatedObjects: typeStatistics[i].allocatedObjects,

allocatedWords: typeStatistics[i].allocatedWords

]]];

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

summaryTypeStatistics[i].allocatedObjects

← summaryTypeStatistics[i].allocatedObjects + typeStatistics[i].allocatedObjects;

summaryTypeStatistics[i].allocatedWords

← summaryTypeStatistics[i].allocatedWords + typeStatistics[i].allocatedWords;

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] = {

for prefixed zones, addr = PNode + sizeNd

and size = NodeLength[addr].

NOTE zone lock is held

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] = {

for prefixed zones, addr = PNode + sizeNd + SIZE[Type]

and size = NodeLength[addr].

if free, type = 0

NOTE zone lock is held

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].allocatedObjects ← typeStatistics[i].allocatedObjects + 1;

typeStatistics[i].allocatedWords ← typeStatistics[i].allocatedWords + size}

ELSE {otherAllocatedObjects ← otherAllocatedObjects + 1;

otherAllocatedWords ← otherAllocatedWords + size};

};

visitRun: PROC[zone: PZone, run: Run] = {

NOTE zone lock is held

q: INT ← run.iFrom;

qOver: INT ←run.iTo;

WITH z: zone SELECT FROM

quantized =>

visit each object in each quantum according to the subzone

FOR qx: CARDINAL IN [q..qOver) DO

mz: ZoneFinger = MapQZf[qx];

IF mz = mzVacant

THEN {

this quantum is not assigned to any subzone

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];

set free bits in this quantum

flr: FreeList ← szr.fl;

allocatedWords: 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 allocatedWords ← allocatedWords + szr.size;

lc ← lc + szr.size;

ENDLOOP;

SELECT allocatedWords FROM

QuantumSize =>

a completely full quantum

zoneInfo.zoneQuantaInfo.filledQuanta

← zoneInfo.zoneQuantaInfo.filledQuanta + 1;

0 => {

an empty quantum

zoneInfo.zoneQuantaInfo.emptyQuanta

← zoneInfo.zoneQuantaInfo.emptyQuanta + 1;

zoneInfo.nFreeWords ← zoneInfo.nFreeWords + fragmentSize;

};

ENDCASE => {

a new partially filled quantum

IF zoneInfo.zoneQuantaInfo.nextIndex = ZQALength

THEN {

zoneInfo.zoneQuantaInfo.partiallyFilledQuanta

← zoneInfo.zoneQuantaInfo.partiallyFilledQuanta + 1;

zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta

← zoneInfo.zoneQuantaInfo.wordsInPartiallyFilledQuanta

+ allocatedWords}

ELSE {

zoneInfo.zoneQuantaInfo.nextIndex

← zoneInfo.zoneQuantaInfo.nextIndex + 1;

zoneInfo.zoneQuantaInfo.a[zoneInfo.zoneQuantaInfo.nextIndex-1]

← [qx, allocatedWords]};

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 =>

a completely full quantum

zoneInfo.zoneQuantaInfo.filledQuanta

← zoneInfo.zoneQuantaInfo.filledQuanta + 1;

0 =>

an empty quantum

zoneInfo.zoneQuantaInfo.emptyQuanta

← zoneInfo.zoneQuantaInfo.emptyQuanta + 1

ENDCASE => {

here with a new partially filled quantum

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 {

should be on the money

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.allocatedWords]]];

fbs.PutRope[" ← "];

fbs.Put[[integer[ent.allocatedObjects]]];

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[", #allocatedWords: "];

fbs.Put[[integer[zoneInfo.zoneQuantaInfo.a[i].allocatedWords]]];

ENDLOOP;

fbs.PutRope["\n"];

}; -- end displayZoneInfo

START DoIt HERE

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].allocatedWords > wordsCutoff THEN

zoneInfo.zoneTypeInfo.Insert

[NEW[TypeEntryRec ←

[type: [i],

allocatedObjects: summaryTypeStatistics[i].allocatedObjects,

allocatedWords: summaryTypeStatistics[i].allocatedWords

]]];

ENDLOOP;

WHILE NOT zoneInfo.zoneTypeInfo.Empty[] DO

ent: TypeEntry ← NARROW[zoneInfo.zoneTypeInfo.Remove[]];

IF ent.allocatedWords = 0 THEN LOOP;

fbs.PutRope["\n "];

fbs.Put[[integer[ent.allocatedWords]]];

fbs.PutRope[" ← "];

fbs.Put[[integer[ent.allocatedObjects]]];

IF ent.allocatedObjects < 100 THEN fbs.PutRope[" "];

fbs.PutF[format: " (%bB)", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];

IF printTypeNames AND ent.allocatedWords >= 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].allocatedWords - last[i].allocatedWords;

deltaObjects ← summaryTypeStatistics[i].allocatedObjects - last[i].allocatedObjects;

IF deltaWords > wordsCutoff THEN

zoneInfo.zoneTypeInfo.Insert

[NEW[TypeEntryRec ←

[type: [i],

allocatedObjects: deltaObjects,

allocatedWords: deltaWords

]]];

ENDLOOP;

WHILE NOT zoneInfo.zoneTypeInfo.Empty[] DO

ent: TypeEntry ← NARROW[zoneInfo.zoneTypeInfo.Remove[]];

IF ent.allocatedWords = 0 THEN LOOP;

fbs.PutRope["\n "];

fbs.Put[[integer[ent.allocatedWords]]];

fbs.PutRope[" ← "];

fbs.Put[[integer[ent.allocatedObjects]]];

IF ent.allocatedObjects < 100 THEN fbs.PutRope[" "];

fbs.PutF[format: " (%bB)", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];

IF printTypeNames AND ent.allocatedWords >= 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]] = {

this proc visits each zone in the world

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]] = {

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

ENABLE UNWIND => NULL;

WITH z: zone SELECT FROM

quantized =>

visit each object in each subzone

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

now set free bits in this quantum

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;

};

prefixed => {

first, count the free objects for the check

freeChainCount: LONG INTEGER ← 0;

p: PFreeNode ← z.pfn;

WHILE p # NIL DO

count the free objects (there is at least the bogus one in the zone!)

IF (p ← p.pfnNext) = z.pfn THEN EXIT;

freeChainCount ← freeChainCount + 1;

ENDLOOP;

next, visit all of the objects, both allocated and freed

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;

last, check the free chain count for consistency

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]] =

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

{ENABLE UNWIND => NULL;

WITH z: zone SELECT FROM

quantized => {

visit each object in each quantum according to the subzone

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

first, count the free objects for the check

freeChainCount: LONG INTEGER ← 0;

p: PFreeNode ← z.pfn;

WHILE p # NIL DO

count the free objects (there is at least the bogus one in the zone!)

IF (p ← p.pfnNext) = z.pfn THEN EXIT;

freeChainCount ← freeChainCount + 1;

ENDLOOP;

next, visit all of the objects, both allocated and freed

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;

last, check the free chain count for consistency

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.allocatedWords;

e2: TypeEntry ← NARROW[y];

w2: INT ← e2.allocatedWords;

IF w1 # w2 THEN RETURN [w1 > w2];

IF e1.allocatedObjects # e2.allocatedObjects

THEN RETURN [e1.allocatedObjects > e2.allocatedObjects];

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^]];

};

TYPEs

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, allocatedWords: NAT] ← ALL[[0, 0]]

];

ZQALength: NAT = 32;

TypeEntry: TYPE = REF TypeEntryRec;

TypeEntryRec: TYPE = RECORD[type: Type,

allocatedObjects, allocatedWords: INT];

**************************************************************************

procedures that work with RTTraceAndSweepImpl

**************************************************************************

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;

-- non-recursive tree walk

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;

add the children to the stack

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;

ZoneCleanupImpl.EnumerateAllObjects[ClearMarks];

END;

END . . .