(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last 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 Fmt, M3toC, RTHeapRep, RTType, RT0, RT0u, SmallIO;
FROM SmallIO IMPORT stderr;

TYPE
  R = REF ARRAY OF
            RECORD
              count := 0;
              size  := 0
            END;
  Visitor = RTHeapRep.RefVisitor OBJECT
              r       : R;
              countSum      := 0;
              sizeSum       := 0
            OVERRIDES
              visit := Walk
            END;

VAR v: Visitor;

PROCEDURE Heap (suppressZeros := FALSE) =
  BEGIN
    Compute ();
    Report (v, suppressZeros)
  END Heap;
  
PROCEDURE NewHeap (suppressZeros := TRUE) =
  VAR oldv := v;
  BEGIN
    Compute ();
    Report (Delta (v, oldv), suppressZeros)
  END NewHeap;

PROCEDURE Compute () =
  BEGIN
    v := NEW (Visitor, r := NEW (R, RT0u.nTypes));
    RTHeapRep.VisitAllRefs (v)
  END Compute;

PROCEDURE Delta (v1, v2: Visitor): Visitor =
  VAR
    v := NEW (Visitor, r := NEW (R, RT0u.nTypes));
  BEGIN
    v.countSum := v1.countSum - v2.countSum;
    v.sizeSum := v1.sizeSum - v2.sizeSum;
    FOR i := 0 TO RT0u.nTypes - 1 DO
      v.r [i].count := v1.r [i].count - v2.r [i].count;
      v.r [i].size := v1.r [i].size - v2.r [i].size
    END;
    RETURN v
  END Delta;
    
PROCEDURE Report (v: Visitor; suppressZeros: BOOLEAN) =
  BEGIN
    SmallIO.PutText (
      stderr,
      (* 012345678901234567890123456789012345678901234567890 *)
      "Code   Count   TotalSize  AvgSize  Name\n"
        & "---- --------- --------- --------- --------------------------\n");
    FOR i := 0 TO RT0u.nTypes - 1 DO
      WITH count = v.r [i].count, size = v.r [i].size DO
        IF count = 0 AND suppressZeros THEN (* skip *)
        ELSE
          SmallIO.PutText (stderr, Fmt.F ("%4s %9s %9s ", Fmt.Int (i),
                                          Fmt.Int (count), Fmt.Int (size)));
          IF count = 0 THEN
            SmallIO.PutText (stderr, "        0")
          ELSE
            SmallIO.PutText (stderr, Fmt.Pad (Fmt.Int (size DIV count), 9))
          END;
          SmallIO.PutText (stderr, Fmt.F (" %s\n", TypecodeName (i)))
        END
      END;
    END;
    SmallIO.PutText (
      stderr, Fmt.F ("     --------- ---------\n     %9s %9s\n",
                     Fmt.Int (v.countSum), Fmt.Int (v.sizeSum)))
  END Report;

PROCEDURE Walk (v : Visitor;
                tc: RTType.Typecode;
                <* UNUSED *> r   : REFANY;
                size: CARDINAL): BOOLEAN =
  BEGIN
    INC (v.r [tc].count);
    INC (v.r [tc].size, size);
    INC (v.countSum);
    INC (v.sizeSum, size);
    RETURN TRUE
  END Walk;

PROCEDURE TypeName (ref: REFANY): TEXT =
  BEGIN
    RETURN TypecodeName (TYPECODE (ref))
  END TypeName;

PROCEDURE TypecodeName (tc: CARDINAL): TEXT =
  BEGIN
    RETURN TypeDefinitionToName (RT0u.types [tc])
  END TypecodeName;

PROCEDURE TypeDefinitionToName (definition: RT0.TypeDefinition): TEXT =
  BEGIN
    WITH
      typecell = definition^,
      name = typecell.name,
      brand = typecell.brand DO
      IF name # NIL THEN
        RETURN M3toC.StoT (name)
      ELSIF brand # NIL THEN
        RETURN "<Brand> " & M3toC.StoT (brand)
      ELSIF typecell.nDimensions > 0 OR typecell.elementSize # 0 THEN
        RETURN "<array>"
      ELSIF typecell.parent # NIL THEN
        RETURN
          "<subtype of " & TypeDefinitionToName (typecell.parent) & ">"
      ELSIF typecell.children # NIL OR typecell.sibling # NIL THEN
        RETURN "<object>"
      ELSIF typecell.methodOffset > 0 THEN
        RETURN "<procedure>"
      ELSE
        RETURN "<?>"
      END
    END
  END TypeDefinitionToName;


BEGIN 
  v := NEW (Visitor, r := NEW (R, RT0u.nTypes))
END RTutils.