Copyright (C) 1994, Digital Equipment Corp.
UNSAFE MODULE--------------------------------------------------------------- sorting ---; IMPORT RTHeapRep, RTType, RTTypeSRC, RTIO, RT0, RTAllocStats; TYPE TypeDesc = RECORD total : Stat; sites : StatList := NIL; END; Stat = RECORD count : INTEGER := 0; size : INTEGER := 0; END; TYPE R = REF ARRAY OF TypeDesc; Map = REF ARRAY OF INTEGER; StatList = REF ARRAY OF Stat; Visitor = RTHeapRep.RefVisitor OBJECT r : R; countSum := 0; sizeSum := 0 OVERRIDES visit := Walk END; VAR v := NewVisitor (); PROCEDURE RTutils NewVisitor (): Visitor = BEGIN RETURN NEW (Visitor, r := NEW (R, RTType.MaxTypecode() + 1)); END NewVisitor; PROCEDUREHeap (suppressZeros := FALSE; presentation := HeapPresentation.ByTypecode; byTypeHierarchy := FALSE; window := LAST(INTEGER)) = BEGIN Compute (); Report (v, suppressZeros, presentation, byTypeHierarchy, window) END Heap; PROCEDURENewHeap (suppressZeros := FALSE; presentation := HeapPresentation.ByTypecode; byTypeHierarchy := FALSE; window := LAST(INTEGER)) = VAR oldv := v; BEGIN Compute (); Report (Delta (v, oldv), suppressZeros, presentation, byTypeHierarchy, window) END NewHeap; PROCEDURECompute () = BEGIN v := NewVisitor (); RTHeapRep.VisitAllRefs (v) END Compute; PROCEDUREDelta (v1, v2: Visitor): Visitor = VAR v := NewVisitor (); BEGIN v.countSum := v1.countSum - v2.countSum; v.sizeSum := v1.sizeSum - v2.sizeSum; FOR i := 0 TO LAST (v.r^) DO WITH a = v.r[i], b = v2.r[i] DO DEC (a.total.count, b.total.count); DEC (a.total.size, b.total.size); END; END; RETURN v END Delta; PROCEDUREReport (v: Visitor; suppressZeros: BOOLEAN; presentation: HeapPresentation; byTypeHierarchy := FALSE; window: INTEGER) = VAR nPrinted := 0; map := NEW (Map, NUMBER (v.r^)); sums: R; defn, root: RT0.TypeDefn; BEGIN (* report an entry for each distinct type *) FOR i := 0 TO LAST (map^) DO map[i] := i; END; CASE presentation OF | HeapPresentation.ByTypecode => (*SKIP*) | HeapPresentation.ByNumber => Sort (map, v.r, CompareCount) | HeapPresentation.ByByteCount => Sort (map, v.r, CompareSize) END; RTIO.PutText ( (* 012345678901234567890123456789012345678901234567890 *) "Code Count TotalSize AvgSize Name\n" & "---- --------- --------- --------- --------------------------\n"); FOR i := 0 TO LAST (v.r^) DO IF (nPrinted >= window) THEN EXIT; END; WITH tc = map[i], zz = v.r[tc] DO IF (zz.total.count > 0) OR (NOT suppressZeros) THEN RTIO.PutInt (tc, 4); RTIO.PutInt (zz.total.count, 10); RTIO.PutInt (zz.total.size, 10); IF (zz.total.count = 0) THEN RTIO.PutText (" 0"); ELSE RTIO.PutInt (zz.total.size DIV zz.total.count, 10); END; RTIO.PutChar (' '); RTIO.PutText (RTTypeSRC.TypecodeName (tc)); RTIO.PutChar ('\n'); INC(nPrinted); IF (zz.sites # NIL) THEN PrintSites (tc, zz, presentation, window); END; END END; END; RTIO.PutText (" --------- ---------\n "); RTIO.PutInt (v.countSum, 10); RTIO.PutInt (v.sizeSum, 10); RTIO.PutChar ('\n'); RTIO.PutChar ('\n'); (* report an entry for each tree of object types *) IF byTypeHierarchy THEN root := RTType.Get (TYPECODE (ROOT)); sums := NEW (R, NUMBER (v.r^)); SumTrees (sums, v.r); FOR i := 0 TO LAST (map^) DO map[i] := i; END; CASE presentation OF | HeapPresentation.ByTypecode => (*SKIP*) | HeapPresentation.ByNumber => Sort (map, sums, CompareCount) | HeapPresentation.ByByteCount => Sort (map, sums, CompareSize) END; RTIO.PutText ("---- object types (full subtrees) ----\n"); RTIO.PutText ( (* 012345678901234567890123456789012345678901234567890 *) "Code Count TotalSize AvgSize Name\n" & "---- --------- --------- --------- --------------------------\n"); nPrinted := 0; FOR i := 0 TO LAST (sums^) DO IF (nPrinted >= window) THEN EXIT; END; WITH tc = map[i], zz = sums[tc] DO IF (zz.total.count > 0) OR (NOT suppressZeros) THEN defn := RTType.Get (tc); IF defn.parent = root THEN EVAL PrintTree (sums, 0, tc, suppressZeros); RTIO.PutChar ('\n'); END; INC(nPrinted); END END; END; RTIO.PutChar ('\n'); END; RTIO.Flush (); map := NIL; END Report; PROCEDUREPrintSites (tc : INTEGER; READONLY t : TypeDesc; presentation: HeapPresentation; window: INTEGER) = VAR n_sites := NUMBER (t.sites^); map := NEW (Map, n_sites); site: INTEGER; tag: TEXT; BEGIN FOR k := 0 TO LAST (map^) DO map[k] := k END; CASE presentation OF | HeapPresentation.ByTypecode, HeapPresentation.ByByteCount => Sort0 (map, t.sites, CompareSize0) | HeapPresentation.ByNumber => Sort0 (map, t.sites, CompareCount0) END (* CASE *); FOR j := 0 TO MIN (n_sites, window)-1 DO site := map[j]; WITH zz = t.sites[site] DO IF (zz.count # 0) THEN RTIO.PutText(" "); RTIO.PutInt(zz.count, 10); RTIO.PutInt(zz.size, 10); RTIO.PutInt(zz.size DIV zz.count, 10); RTIO.PutText(" "); FOR k := 0 TO RTAllocStats.siteDepth-1 DO tag := RTAllocStats.GetSiteText (tc, site, k); IF (tag = NIL) THEN EXIT; END; IF (k # 0) THEN RTIO.PutText(" "); RTIO.PutText(" ") END; RTIO.PutText (tag); RTIO.PutChar ('\n'); END; END; END; END; IF (n_sites > 1) AND (window > 1) THEN RTIO.PutChar ('\n'); END; END PrintSites; PROCEDURESumTrees (sums, cnts: R) = VAR defn: RT0.TypeDefn; BEGIN FOR i := 0 TO LAST (sums^) DO defn := RTType.Get (i); FOR j := defn.typecode TO defn.lastSubTypeTC DO IF (0 <= j) AND (j <= LAST (cnts^)) THEN INC (sums[i].total.count, cnts[j].total.count); INC (sums[i].total.size, cnts[j].total.size); END; END; END; END SumTrees; PROCEDUREPrintTree (sums: R; indent, tc: INTEGER; suppressZeros: BOOLEAN): INTEGER = VAR maxChild := RTType.Get(tc).lastSubTypeTC; BEGIN PrintNode (sums, indent, tc, suppressZeros); INC (tc); WHILE (tc <= maxChild) DO tc := PrintTree (sums, indent+1, tc, suppressZeros); END; RETURN tc; END PrintTree; PROCEDUREPrintNode (sums: R; indent, tc: INTEGER; suppressZeros: BOOLEAN) = BEGIN WITH zz = sums[tc] DO IF (zz.total.count > 0) OR (NOT suppressZeros) THEN RTIO.PutInt (tc, 4); RTIO.PutInt (zz.total.count, 10); RTIO.PutInt (zz.total.size, 10); IF (zz.total.count = 0) THEN RTIO.PutText (" 0"); ELSE RTIO.PutInt (zz.total.size DIV zz.total.count, 10); END; RTIO.PutChar (' '); WHILE (indent > 0) DO RTIO.PutChar (' '); RTIO.PutChar (' '); DEC (indent); END; RTIO.PutText (RTTypeSRC.TypecodeName (tc)); RTIO.PutChar ('\n'); END; END; END PrintNode; PROCEDUREWalk (v : Visitor; tc : RTType.Typecode; ref : REFANY; size : CARDINAL): BOOLEAN = VAR n_sites, site: INTEGER; addr: ADDRESS; hdr: RTHeapRep.RefHeader; BEGIN (* total heap *) INC (v.countSum); INC (v.sizeSum, size); WITH zz = v.r[tc] DO (* totals for this type *) INC (zz.total.count); INC (zz.total.size, size); (* totals for this type on a per-site basis *) n_sites := RTAllocStats.NSites (tc); IF (n_sites >= 0) THEN IF (zz.sites = NIL) THEN zz.sites := NEW (StatList, n_sites+1); END; addr := LOOPHOLE (ref, ADDRESS); hdr := LOOPHOLE (addr - BYTESIZE(RT0.RefHeader), RTHeapRep.RefHeader); site := hdr.spare; INC (zz.sites[site].count); INC (zz.sites[site].size, size); END; END; RETURN TRUE END Walk;
PROCEDURESort (map: Map; r: R; cmp := CompareCount) = (* insertion sort such that: i <= j => cmp (r[map[i]], r[map[j]]) <= 0 *) VAR n := NUMBER (map^); j: INTEGER; BEGIN FOR i := 1 TO n-1 DO WITH key = r[map[i]] DO j := i-1; WHILE (j >= 0) AND cmp (key, r[map[j]]) < 0 DO map[j+1] := map[j]; DEC (j); END; map[j+1] := i; END; END; END Sort; PROCEDURECompareCount (READONLY x, y: TypeDesc): INTEGER = BEGIN RETURN y.total.count - x.total.count; END CompareCount; PROCEDURECompareSize (READONLY x, y: TypeDesc): INTEGER = BEGIN RETURN y.total.size - x.total.size; END CompareSize; PROCEDURESort0 (map: Map; r: StatList; cmp := CompareCount0) = (* insertion sort such that: i <= j => cmp (r[map[i]], r[map[j]]) <= 0 *) VAR n := NUMBER (map^); j: INTEGER; BEGIN FOR i := 1 TO n-1 DO WITH key = r[map[i]] DO j := i-1; WHILE (j >= 0) AND cmp (key, r[map[j]]) < 0 DO map[j+1] := map[j]; DEC (j); END; map[j+1] := i; END; END; END Sort0; PROCEDURECompareCount0 (READONLY x, y: Stat): INTEGER = BEGIN RETURN y.count - x.count; END CompareCount0; PROCEDURECompareSize0 (READONLY x, y: Stat): INTEGER = BEGIN RETURN y.size - x.size; END CompareSize0; BEGIN END RTutils.