-- ScanZones.mesa
-- stolen from Russ Atkinson's CheckRT stuff of October 11, 1982 11:59 am
-- Last Modified By Paul Rovner On December 20, 1982 2:26 pm


DIRECTORY
FileIO USING [Open],
IO USING [STREAM, PutChar, Close, PutRope, Put, PutF],
PrintTV USING [PrintType, PutClosure, PutProc],
PriorityQueue USING [Ref, SortPred, Predict, Insert, Empty, Remove],
RTBasic USING [Type],
RTQuanta USING [QuantumSize],
Runs USING [Run],
RTZones USING
[FreeList, InusePNode,
MapQZf, MapSziSz, MapZiZn, ZoneFinger, mzVacant,
NodeLength, PFreeNode, PNode, sizeNd, SubZone, Zone];

ScanZones: MONITOR LOCKS zone.LOCK USING zone: Zone
IMPORTS FileIO, IO, PrintTV, PriorityQueue, RTZones
= BEGIN OPEN PrintTV, RTBasic, RTQuanta, RTZones, Runs;

-- Call this guy from the interpreter to do the work. The output will be put into Storage.log.
ShowStorage: PROC[wordsCutoff: INT ← 100,
-- Types in a ZONE having fewer than wordsCutoff allocated words
-- will not be listed
append: BOOL ← FALSE,
-- whether to append to Storage.log rather than replacing its contents
specifiedZone: ZONE ← NIL, --NIL means do it for all zones
printTypeNames: BOOL ← FALSE
] =
{ grandTotalZones, grandTotalQuanta, grandTotalFreeObjects,
grandTotalFreeWords, grandTotalAllocatedObjects,
grandTotalAllocatedWords: INT ← 0;

maxTypeIndex: NAT = 2048;
typeStatistics: REF ARRAY [0 .. maxTypeIndex] OF TSRec
← NEW[ARRAY [0 .. maxTypeIndex] OF TSRec];
TSRec: TYPE = RECORD[allocatedObjects, allocatedWords: INT];
otherAllocatedObjects: INT ← 0;
otherAllocatedWords: INT ← 0;

zoneInfo: ZoneInfo;
visitZone: PROC[zone: Zone] =
{ IF specifiedZone # NIL AND LOOPHOLE[zone, ZONE] # specifiedZone THEN RETURN;
initCounts[];
ObjectsThenRunsInZone[zone, visitObject, visitRun];
FOR i: [0 .. maxTypeIndex] IN [0 .. maxTypeIndex]
DO IF typeStatistics[i].allocatedWords > wordsCutoff
OR (typeStatistics[i].allocatedWords > 0
AND typeStatistics[i].allocatedObjects < 30) THEN
zoneInfo.zoneTypeInfo.Insert
[NEW[TypeEntryRec ←
[type: [i],
allocatedObjects: typeStatistics[i].allocatedObjects,
allocatedWords: typeStatistics[i].allocatedWords
]]];
ENDLOOP;
displayZoneInfo[zone];
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;
};
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: Zone, 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 {zoneInfo.zoneQuantaInfo.emptyQuanta
← zoneInfo.zoneQuantaInfo.emptyQuanta + 1;
zoneInfo.nFreeWords ← zoneInfo.nFreeWords + QuantumSize;
LOOP};
-- this quantum is not assigned to any subzone

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;
IF allocatedWords = QuantumSize
THEN zoneInfo.zoneQuantaInfo.filledQuanta
← zoneInfo.zoneQuantaInfo.filledQuanta + 1
ELSE IF allocatedWords = 0
THEN {zoneInfo.zoneQuantaInfo.emptyQuanta
← zoneInfo.zoneQuantaInfo.emptyQuanta + 1;
zoneInfo.nFreeWords ← zoneInfo.nFreeWords + fragmentSize;
}
ELSE { -- 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
+ 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;
IF wordsUsedInQuantum = QuantumSize
THEN zoneInfo.zoneQuantaInfo.filledQuanta
← zoneInfo.zoneQuantaInfo.filledQuanta + 1
ELSE IF wordsUsedInQuantum = 0
THEN zoneInfo.zoneQuantaInfo.emptyQuanta
← zoneInfo.zoneQuantaInfo.emptyQuanta + 1
ELSE
{-- 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 {IF ptr # LOOPHOLE[qOver * QuantumSize, PNode] THEN ERROR;
EXIT}; -- should be on the money
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: Zone] =
{ nq: CARDINAL ← 0;
fbs.PutRope["\n"];
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]]];

IF LONG[zoneInfo.zoneQuantaInfo.nextIndex
+ zoneInfo.zoneQuantaInfo.partiallyFilledQuanta
+ zoneInfo.zoneQuantaInfo.emptyQuanta
+ zoneInfo.zoneQuantaInfo.filledQuanta]*QuantumSize
- zoneInfo.nAllocatedWords # zoneInfo.nFreeWords
THEN ERROR;

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[]];
fbs.PutRope["\n Type: ("];
fbs.PutF[format: "%b", v1: [cardinal[LOOPHOLE[ent.type, CARDINAL]]]];
fbs.PutRope["B) "];
IF printTypeNames THEN PrintType[ent.type, put];
fbs.PutRope["\n words: "];
fbs.Put[[integer[ent.allocatedWords]]];
fbs.PutRope[", objects: "];
fbs.Put[[integer[ent.allocatedObjects]]];
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"];

};

-- START ShowStorage HERE
fbs: IO.STREAM ← FileIO.Open["Storage.Log", IF append THEN append ELSE overwrite];
putC: PutProc = TRUSTED {fbs.PutChar[c]};
put: PutClosure = [putC];

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

ZonesInWorld[visitZone]; -- gather statistics for each Zone, then print 'em

fbs.PutRope["\n\nGRAND TOTALS"];
fbs.PutRope["\n #Zones: "];
fbs.Put[[integer[grandTotalZones]]];
fbs.PutRope["\n #Quanta: "];
fbs.Put[[integer[grandTotalQuanta]]];
fbs.PutRope["\n #FreeObjects: "];
fbs.Put[[integer[grandTotalFreeObjects]]];
fbs.PutRope["\n #FreeWords: "];
fbs.Put[[integer[grandTotalFreeWords]]];
fbs.PutRope["\n #AllocatedObjects: "];
fbs.Put[[integer[grandTotalAllocatedObjects]]];
fbs.PutRope["\n #AllocatedWords: "];
fbs.Put[[integer[grandTotalAllocatedWords]]];
fbs.PutRope["\n\n %Free Words of Total Words: "];
{r: REAL = grandTotalFreeWords;
fbs.Put[[real[(r/(grandTotalAllocatedWords + grandTotalFreeWords))*100]]]};

IF grandTotalQuanta*QuantumSize
- grandTotalAllocatedWords # grandTotalFreeWords
THEN ERROR;

fbs.PutRope["\n"];

fbs.Close[];

}; -- end ShowStorage

ZonesInWorld: PROC[visit: PROC[Zone]] =
-- this proc visits each zone in the world
{FOR zi: CARDINAL IN [0..RTZones.MapZiZn.length)
DO zone: Zone ← RTZones.MapZiZn[zi];
IF zone # NIL THEN visit[zone];
ENDLOOP};

ObjectsThenRunsInZone: ENTRY PROC
[zone: Zone,
visitObject: PROC[addr: LONG POINTER, size: INT, type: Type, free: BOOL],
visitRun: PROC[Zone, 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: Zone = 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;
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]]};

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

END.