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