<> <> <> <> <> 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[]; <<-- set a break where MapReclaimableObjects calls Reclaim>> break _ FastBreak.SetFastBreak[RTReclaimerImpl.code.longbase, [reclaimPC], ReclaimerMonitor]; monitoring _ TRUE; END; ReclaimerMonitor: FastBreak.FastBreakProc = BEGIN <<-- data: FastBreakData, frame: PrincOps.FrameHandle, sv: PrincOps.SVPointer]>> <<-- RETURNS [useOldBreak: BOOL _ FALSE]>> <<-- records the size and type of garbage as it gets reclaimed>> 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; <<>> <<-- 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; <> 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 . . .