m3core/src/runtime/common/RTutils.m3


 Copyright (C) 1994, Digital Equipment Corporation                         
 All rights reserved.                                                      
 See the file COPYRIGHT for a full description.                            
                                                                           
 Last modified on Mon Jul 24 10:21:50 PDT 1995 by detlefs                  
      modified on Thu May  4 15:23:07 PDT 1995 by kalsow                   
      modified on Tue Jun 16 10:41:32 PDT 1992 by muller                   
      modified on Sun Mar  1 16:06:32 PST 1992 by meehan                   

UNSAFE MODULE RTutils;

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;

  Link = RECORD
    children : INTEGER;
    next     : INTEGER;
  END;

TYPE
  R = REF ARRAY OF TypeDesc;
  Map = REF ARRAY OF INTEGER;
  StatList = REF ARRAY OF Stat;
  LinkList = REF ARRAY OF Link;

  Visitor = RTHeapRep.RefVisitor OBJECT
              r         : R;
              countSum  := 0;
              sizeSum   := 0
            OVERRIDES
              visit := Walk
            END;

CONST NO_LINK = RTType.NoSuchType;  (* an impossible typecode *)

VAR v := NewVisitor ();

PROCEDURE NewVisitor (): Visitor =
  BEGIN
    RETURN NEW (Visitor, r := NEW (R, RTType.MaxTypecode() + 1));
  END NewVisitor;

PROCEDURE Heap (suppressZeros := FALSE;
                presentation := HeapPresentation.ByTypecode;
                byTypeHierarchy := FALSE;
                window := LAST(INTEGER)) =
  BEGIN
    Compute ();
    Report (v, suppressZeros, presentation, byTypeHierarchy, window)
  END Heap;

PROCEDURE NewHeap (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;

PROCEDURE Compute () =
  BEGIN
    v := NewVisitor ();
    RTHeapRep.VisitAllRefs (v)
  END Compute;

PROCEDURE Delta (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 x = v.r[i].total, a = v1.r[i].total, b = v2.r[i].total DO
        x.count := a.count - b.count;
        x.size  := a.size  - b.size;
      END;
    END;
    RETURN v
  END Delta;

PROCEDURE Report (v: Visitor;
                  suppressZeros: BOOLEAN;
                  presentation: HeapPresentation;
                  byTypeHierarchy := FALSE;
                  window: INTEGER) =
  VAR
    nPrinted := 0;
    map := NEW (Map, NUMBER (v.r^));
    sums: R;
    links: LinkList := NIL;
    root: RT0.Typecode;
  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 := TYPECODE (ROOT);
      links := FindChildLinks ();
      sums := NEW (R, NUMBER (v.r^));
      SumTrees (sums, v.r, links);
      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
            IF RTType.Supertype (tc) = root THEN
	      PrintTree (sums, links, 0, tc, suppressZeros);
	      RTIO.PutChar ('\n');
	    END;
	    INC(nPrinted);
	  END
	END;
      END;
      RTIO.PutChar ('\n');
    END;

    RTIO.Flush ();
    map := NIL;
  END Report;

PROCEDURE PrintSites (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;

PROCEDURE FindChildLinks (): LinkList =
  VAR
    n := RTType.MaxTypecode () + 1;
    links := NEW (LinkList, n);
    tc: RT0.Typecode;
  BEGIN
    FOR i := 0 TO n-1 DO
      WITH z = links[i] DO z.children := NO_LINK; z.next := NO_LINK; END;
    END;
    FOR i := 0 TO n-1 DO
      tc := RTType.Supertype (i);
      IF (tc # RTType.NoSuchType) AND (0 <= tc) AND (tc < n) THEN
        WITH parent = links[tc] DO
          links[i].next := parent.children;
          parent.children := i;
        END;
      END;
    END;
    RETURN links;
  END FindChildLinks;

PROCEDURE SumTrees (sums, cnts: R;  links: LinkList) =
  VAR x: INTEGER;
  BEGIN
    FOR i := 0 TO LAST (sums^) DO
      x := links[i].children;
      WHILE (x # NO_LINK) DO
        IF (0 <= x) AND (x <= LAST (cnts^)) THEN
          INC (sums[i].total.count, cnts[x].total.count);
          INC (sums[i].total.size, cnts[x].total.size);
        END;
        x := links[x].next;
      END;
    END;
  END SumTrees;

PROCEDURE PrintTree (sums: R;  links: LinkList;  indent, tc: INTEGER;
                     suppressZeros: BOOLEAN) =
  VAR x: INTEGER;
  BEGIN
    PrintNode (sums, indent, tc, suppressZeros);
    x := links[tc].children;
    WHILE (x # NO_LINK) DO
      PrintTree (sums, links, indent+1, x, suppressZeros);
      x := links[x].next;
    END;
  END PrintTree;

PROCEDURE PrintNode (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;

PROCEDURE Walk (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;
--------------------------------------------------------------- sorting ---

PROCEDURE Sort (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;

PROCEDURE CompareCount (READONLY x, y: TypeDesc): INTEGER =
  BEGIN
    RETURN y.total.count - x.total.count;
  END CompareCount;

PROCEDURE CompareSize (READONLY x, y: TypeDesc): INTEGER =
  BEGIN
    RETURN y.total.size - x.total.size;
  END CompareSize;

PROCEDURE Sort0 (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;

PROCEDURE CompareCount0 (READONLY x, y: Stat): INTEGER =
  BEGIN
    RETURN y.count - x.count;
  END CompareCount0;

PROCEDURE CompareSize0 (READONLY x, y: Stat): INTEGER =
  BEGIN
    RETURN y.size - x.size;
  END CompareSize0;

BEGIN
END RTutils.