showheap/src/ShowHeap.m3


 Copyright (C) 1992, Digital Equipment Corporation       
 All rights reserved.                                    
 See the file COPYRIGHT for a full description.          
                                                         
 Last modified on Tue Jan 31 10:34:50 PST 1995 by kalsow 
      modified on Fri Jan 29 19:07:08 PST 1993 by jdd    
      modified on Fri Jan 15 12:20:22 PST 1993 by mhb    
      modified on Thu Apr 23 18:57:36 PDT 1992 by muller 

UNSAFE MODULE ShowHeap EXPORTS Main;

IMPORT Axis, ButtonVBT, ColorName, Color, Fmt, HVSplit, PaintOp, Point;
IMPORT Process, Rd, Rect, Region, Split, Stdio, Text, TextVBT, Trestle;
IMPORT VBT, Wr;

IMPORT RTHeapEvent, RTHeapRep;

FROM RTHeapRep IMPORT Generation, Note, Page, Space;

TYPE
  Desc = RECORD
           space     : BITS 2 FOR Space;
           generation: BITS 1 FOR Generation;
           pure      : BITS 1 FOR BOOLEAN;
           note      : BITS 3 FOR Note;
           gray      : BITS 1 FOR BOOLEAN;
           clean     : BITS 1 FOR BOOLEAN;
           continued : BITS 1 FOR BOOLEAN := FALSE;
  END;

<*FATAL ANY*>
------------------------------------------------------------ heap state ---

VAR
  collections: INTEGER := 0;
  firstPage  : Page    := 1;
  lastPage   : Page    := 0;
  desc                 := NEW(UNTRACED REF ARRAY OF Desc, 0);

TYPE Counter = {None, New, Copied, Immobile, Older};

VAR
  count := ARRAY Counter OF CARDINAL{0, ..};
  countVBT, countTextVBT: ARRAY Counter OF VBT.T;

PROCEDURE CounterOf (d: Desc): Counter =
  BEGIN
    RETURN counterOf[
             d.space, d.generation, d.pure, d.note, d.gray, d.clean];
  END CounterOf;
---------------------------------------------------------------- colors ---

Each interesting page state has a bright color and a somber color. If the page state can be gray or not (in the GC sense), the bright color is used for the gray state and the somber for the normal, non-gray. The somber color is generated by averaging the bright color with a gray of the same intensity.

      state       color   intensity  bright RGB         somber RGB
      
      free        white    1.0       1.000 1.000 1.000
      new         blue     0.75      0.730 0.730 0.730
      immobile    green    0.55      0.000 0.812 0.000  0.275 0.676 0.275
      copied      red      0.5       1.000 0.343 0.343  0.750 0.421 0.421
      older       magenta  0.45      1.000 0.198 1.000  0.725 0.324 0.725
      previous    gray     0.25      0.250 0.250 0.250
      unallocated black    0.0       0.000 0.000 0.000

VAR
  rgb: ARRAY Space, Generation, BOOLEAN (* pure *), Note,
         BOOLEAN (* gray *), BOOLEAN (* clean *) OF
         Color.T;
  tint: ARRAY Space, Generation, BOOLEAN (* pure *), Note,
          BOOLEAN (* gray *), BOOLEAN (* clean *) OF
          PaintOp.T;
  counterOf: ARRAY Space, Generation, BOOLEAN (* pure *), Note,
          BOOLEAN (* gray *), BOOLEAN (* clean *) OF
          Counter;
  mapBackGround := ComputeColor("LightLightGray");
  red           := ComputeColor("Red");
  black         := ComputeColor("Black");
  white         := ComputeColor("White");

  gcOnQuad  := PaintOp.MakeColorQuad(black, red);
  gcOffQuad := PaintOp.MakeColorQuad(white, black);

PROCEDURE ComputeColor (name: Text.T): PaintOp.T =
  VAR t: Color.T;
  BEGIN
    t := ColorName.ToRGB(name);
    RETURN PaintOp.FromRGB(t.r, t.g, t.b);
  END ComputeColor;

PROCEDURE InitColors () =
  BEGIN
    FOR space := FIRST(Space) TO LAST(Space) DO
      FOR generation := FIRST(Generation) TO LAST(Generation) DO
        FOR pure := FIRST(BOOLEAN) TO LAST(BOOLEAN) DO
          FOR note := FIRST(Note) TO LAST(Note) DO
            FOR gray := FIRST(BOOLEAN) TO LAST(BOOLEAN) DO
              FOR clean := FIRST(BOOLEAN) TO LAST(BOOLEAN) DO
                CASE space OF
                | Space.Unallocated =>
                    rgb[space, generation, pure, note, gray, clean] :=
                      Color.T{0.0, 0.0, 0.0};
                    counterOf[
                      space, generation, pure, note, gray, clean] :=
                      Counter.None;
                | Space.Free =>
                    rgb[space, generation, pure, note, gray, clean] :=
                      Color.T{1.0, 1.0, 1.0};
                    counterOf[
                      space, generation, pure, note, gray, clean] :=
                      Counter.None;
                | Space.Previous =>
                    rgb[space, generation, pure, note, gray, clean] :=
                      Color.T{0.25, 0.25, 0.25};
                    counterOf[
                      space, generation, pure, note, gray, clean] :=
                      Counter.None;
                | Space.Current =>
                    CASE note OF
                    | Note.Allocated =>
                        rgb[space, generation, pure, note, gray, clean] :=
                          Color.T{0.730, 0.730, 1.0};
                        counterOf[
                          space, generation, pure, note, gray, clean] :=
                          Counter.New;
                    | Note.Copied, Note.Large =>
                        IF gray THEN
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{1.0, 0.343, 0.343};
                        ELSE
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{0.75, 0.421, 0.421};
                        END;
                        counterOf[
                          space, generation, pure, note, gray, clean] :=
                          Counter.Copied;
                    | Note.AmbiguousRoot =>
                        IF gray THEN
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{0.0, 0.812, 0.0};
                        ELSE
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{0.275, 0.676, 0.275};
                        END;
                        counterOf[
                          space, generation, pure, note, gray, clean] :=
                          Counter.Immobile;
                    | Note.Frozen =>
                        IF gray THEN
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{0.0, 0.812, 0.0};
                        ELSE
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{0.275, 0.676, 0.275};
                        END;
                        counterOf[
                          space, generation, pure, note, gray, clean] :=
                          Counter.Immobile;
                    | Note.OlderGeneration =>
                        IF gray THEN
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{1.0, 0.198, 1.0};
                        ELSE
                          rgb[
                            space, generation, pure, note, gray, clean] :=
                            Color.T{0.725, 0.225, 0.725};
                        END;
                        counterOf[
                          space, generation, pure, note, gray, clean] :=
                          Counter.Older;
                    END;
                END;
                WITH rgb = rgb[space, generation, pure, note, gray, clean] DO
                  tint[space, generation, pure, note, gray, clean] :=
                    PaintOp.FromRGB(rgb.r, rgb.g, rgb.b);
                END;
              END;
            END;
          END;
        END;
      END;
    END;
    VAR
      rgb := Color.T{0.730, 0.730, 1.0};
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Fg);
    BEGIN
      countVBT[Counter.New] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.New] := TextVBT.New("new", bgFg := quad);
    END;
    VAR
      rgb := Color.T{0.75, 0.421, 0.421};
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Bg);
    BEGIN
      countVBT[Counter.Copied] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.Copied] := TextVBT.New("copied", bgFg := quad);
    END;
    VAR
      rgb := Color.T{0.275, 0.676, 0.275};
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Fg);
    BEGIN
      countVBT[Counter.Immobile] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.Immobile] :=
        TextVBT.New("immobile", bgFg := quad);
    END;
    VAR
      rgb := Color.T{0.725, 0.225, 0.725};
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Bg);
    BEGIN
      countVBT[Counter.Older] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.Older] := TextVBT.New("older", bgFg := quad);
    END;
  END InitColors;
------------------------------------------------------------ Heap map ---

TYPE
  HeapMapVBT = VBT.Leaf OBJECT
                 rect                    := Rect.T{0, 1, 0, 1};
                 side        : INTEGER;
                 nCols, nRows: INTEGER   := 1;
                 firstSquare : Rect.T;
                 displayedTints: REF ARRAY OF PaintOp.T := NIL;
               OVERRIDES
                 repaint := RepaintHeapMap;
                 reshape := ReshapeHeapMap;
                 shape   := ShapeHeapMap;
               END;

PROCEDURE LayoutHeapMap (self: HeapMapVBT) = (* Given the rectangle to be
                                                occupied by the heap map
                                                and the number of pages to
                                                display, compute the size
                                                of each square *)
  VAR
    tryLarger              := TRUE;
    p                      := MAX(lastPage - firstPage + 1, 1);
    width, height: INTEGER;
  BEGIN                          (* Recompute the layout of the map *)
    width := self.rect.east - self.rect.west;
    height := self.rect.south - self.rect.north;
    self.side := 1;
    self.nCols := width;
    self.nRows := height;

    WHILE tryLarger DO
      WITH largerSide = self.side + 1,
           largerCols = width DIV largerSide,
           largerRows = height DIV largerSide DO

        IF p <= largerCols * largerRows THEN (* ok *)
          self.side := largerSide;
          self.nCols := largerCols;
          self.nRows := largerRows;
        ELSE
          tryLarger := FALSE;
        END;
      END;
    END;

    self.firstSquare :=
      Rect.FromCorner(
        Point.MoveHV(Rect.NorthWest(self.rect),
                     (width - self.side * self.nCols) DIV 2,
                     (height - self.side * self.nRows) DIV 2), self.side,
        self.side);

  END LayoutHeapMap;

PROCEDURE RepaintHeapMap (                    self: HeapMapVBT;
                          <*UNUSED*> READONLY rgn : Region.T    ) =
  VAR
    p       := 0;
    nbPages := lastPage - firstPage + 1;
    square  := self.firstSquare;
  BEGIN
    (* Fill the map with the background color *)
    VBT.PaintTint(self, self.rect, mapBackGround);

    (* redisplay each page *)
    FOR y := 0 TO self.nRows - 1 DO
      FOR x := 0 TO self.nCols - 1 DO
        IF p < nbPages THEN
          VAR
            d  := desc[p];
            sq := square;
          BEGIN
            INC(sq.north, 1);
            DEC(sq.south, 1);
            IF NOT d.continued THEN INC(sq.west, 2); END;
            VBT.PaintTint(self, square, white);
            VBT.PaintTint(self, sq, tint[d.space, d.generation, d.pure,
                                         d.note, d.gray, d.clean]);
          END;
        END;
        INC(p);
        INC(square.east, self.side);
        INC(square.west, self.side);
      END;
      square.east := self.firstSquare.east;
      square.west := self.firstSquare.west;
      INC(square.north, self.side);
      INC(square.south, self.side);
    END;
  END RepaintHeapMap;

PROCEDURE RepaintOnePage (self: HeapMapVBT; page: Page) =
  VAR
    p     := page - firstPage;
    row   := p DIV MAX(self.nCols, 1);
    col   := p - row * self.nCols;
    west  := self.firstSquare.west + col * self.side;
    east  := west + self.side;
    north := self.firstSquare.north + row * self.side;
    south := north + self.side;
    square := Rect.T{
                west := west, east := east, north := north, south := south};
  BEGIN
    VBT.PaintTint(self, square, white);
    VAR
      d := desc[p];
      t := tint[d.space, d.generation, d.pure, d.note, d.gray, d.clean];
      sq := square;
    BEGIN
      INC(sq.north, 1);
      DEC(sq.south, 1);
      IF NOT d.continued THEN INC(sq.west, 2); END;
      VBT.PaintTint(self, sq, t);
    END;
  END RepaintOnePage;

PROCEDURE ReshapeHeapMap (self: HeapMapVBT; READONLY cd: VBT.ReshapeRec) =
  BEGIN
    self.rect := cd.new;
    LayoutHeapMap(self);
    RepaintHeapMap(self, Region.T{r := cd.new});
  END ReshapeHeapMap;

PROCEDURE ShapeHeapMap (<*UNUSED*> self: HeapMapVBT;
                                   ax  : Axis.T;
                        <*UNUSED*> n   : CARDINAL    ): VBT.SizeRange =
  BEGIN
    IF ax = Axis.T.Hor THEN
      RETURN (VBT.SizeRange{lo := 200, pref := 300, hi := 100 * 1000});
    ELSE
      RETURN (VBT.SizeRange{lo := 200, pref := 200, hi := 100 * 1000});
    END;
  END ShapeHeapMap;
---------------------------------------------------------- various VBTs ---

PROCEDURE ShowValueVBT (name: Text.T; value: VBT.T): VBT.T =
  BEGIN
    RETURN HVSplit.Cons(Axis.T.Hor, TextVBT.New(name, 0.0), value);
  END ShowValueVBT;

TYPE A = REF RECORD p: PROCEDURE ();  END;

PROCEDURE ActionVBT (name: Text.T; action: PROCEDURE ()): VBT.T =
  BEGIN
    RETURN
      ButtonVBT.New(TextVBT.New(name), DoActionVBT, NEW(A, p := action));
  END ActionVBT;

PROCEDURE DoActionVBT (                    self: ButtonVBT.T;
                       <*UNUSED*> READONLY cd  : VBT.MouseRec ) =
  BEGIN
    NARROW(VBT.GetProp(self, TYPECODE(A)), A).p();
  END DoActionVBT;
------------------------------------------------------- Number Displays ---

VAR
  gcs := TextVBT.New("");
  off := TextVBT.New("");
-------------------------------------------------------------- controls ---

VAR
  root, control: VBT.T;
  map          : HeapMapVBT;

PROCEDURE StartAction () =
  BEGIN
    Wr.PutChar(Stdio.stdout, 'g');
    Wr.Flush(Stdio.stdout);
  END StartAction;

PROCEDURE QuitAction () =
  BEGIN
    Trestle.Delete(root);
    Process.Exit(0);
  END QuitAction;

PROCEDURE SetupVBT () =
  BEGIN
    control := HVSplit.New(Axis.T.Ver);
    Split.AddChild(
      control, countVBT[Counter.New], countTextVBT[Counter.New],
      countVBT[Counter.Copied], countTextVBT[Counter.Copied],
      countVBT[Counter.Immobile], countTextVBT[Counter.Immobile],
      countVBT[Counter.Older], countTextVBT[Counter.Older]);
    Split.AddChild(
      control, ShowValueVBT("gcs = ", gcs), ShowValueVBT("off = ", off));
    Split.AddChild(control, ActionVBT("start", StartAction),
                   ActionVBT("quit", QuitAction));
    map := NEW(HeapMapVBT);
    root := HVSplit.Cons(Axis.T.Hor, control, map);
    Trestle.Install(root);
  END SetupVBT;
---------------------------------------------------------------------------

TYPE
  Evt = RTHeapEvent.T;

CONST
  EvtSize = (BITSIZE (Evt) + BITSIZE (CHAR) - 1) DIV BITSIZE (CHAR);

TYPE
  EvtChars = ARRAY [0..EvtSize-1] OF CHAR;

PROCEDURE GetEvent (): Evt =
  VAR e: Evt;
  BEGIN
    EVAL Rd.GetSub (Stdio.stdin, LOOPHOLE (e, EvtChars));
    RETURN e;
  END GetEvent;
---------------------------------------------------------------------------

PROCEDURE Run () =
  BEGIN
    LOOP
      VAR e := GetEvent();
      BEGIN
        CASE e.kind OF
        | RTHeapEvent.Kind.Begin =>
            INC(collections);
            TextVBT.SetFont(gcs, TextVBT.GetFont(gcs), gcOnQuad);
            TextVBT.Put(gcs, Fmt.Int(collections));
        | RTHeapEvent.Kind.Flip =>
        | RTHeapEvent.Kind.Roots =>
        | RTHeapEvent.Kind.End =>
            TextVBT.SetFont(gcs, TextVBT.GetFont(gcs), gcOffQuad);
        | RTHeapEvent.Kind.Grow =>
            VAR
              newFirstPage, newLastPage: Page;
              newDesc                  : UNTRACED REF ARRAY OF Desc;
            BEGIN
              IF firstPage = 1 AND lastPage = 0 THEN
                newFirstPage := e.first;
                newLastPage := e.first + e.nb - 1;
              ELSE
                newFirstPage := MIN(e.first, firstPage);
                newLastPage := MAX(e.first + e.nb - 1, lastPage);
              END;
              newDesc := NEW(UNTRACED REF ARRAY OF Desc,
                             newLastPage - newFirstPage + 1);
              FOR p := e.first TO e.first + e.nb - 1 DO
                newDesc[p - newFirstPage].space := Space.Free;
                newDesc[p - newFirstPage].pure := TRUE;
                newDesc[p - newFirstPage].continued := FALSE;
              END;
              IF NOT (firstPage = 1 AND lastPage = 0) THEN
                SUBARRAY(newDesc^, firstPage - newFirstPage,
                         lastPage - firstPage + 1) := desc^;
                FOR p := e.first + e.nb TO firstPage - 1 DO
                  newDesc[p - newFirstPage].space := Space.Unallocated;
                END;
                FOR p := lastPage + 1 TO e.first - 1 DO
                  newDesc[p - newFirstPage].space := Space.Unallocated;
                END;
              END;
              desc := newDesc;
              firstPage := newFirstPage;
              lastPage := newLastPage;
            END;
            LayoutHeapMap(map);
            RepaintHeapMap(map, Region.T{r := map.rect});
        | RTHeapEvent.Kind.Change =>
            VAR
              edesc := Desc{space      := e.desc.space,
                            generation := e.desc.generation,
                            pure       := e.desc.pure,
                            note       := e.desc.note,
                            gray       := e.desc.gray,
                            clean      := e.desc.clean};
              new := CounterOf(edesc);
            BEGIN
              VAR old := CounterOf(desc[e.first - firstPage]);
              BEGIN
                desc[e.first - firstPage] := edesc;
                IF new # old THEN
                  IF old # Counter.None THEN
                    DEC(count[old]);
                    TextVBT.Put(countVBT[old], Fmt.Int(count[old]));
                  END;
                  IF new # Counter.None THEN
                    INC(count[new]);
                    TextVBT.Put(countVBT[new], Fmt.Int(count[new]));
                  END;
                END;
              END;
              edesc.continued := TRUE;
              FOR p := e.first + 1 TO e.first + e.nb - 1 DO
                VAR old := CounterOf(desc[p - firstPage]);
                BEGIN
                  desc[p - firstPage] := edesc;
                  IF new # old THEN
                    IF old # Counter.None THEN
                      DEC(count[old]);
                      TextVBT.Put(countVBT[old], Fmt.Int(count[old]));
                    END;
                    IF new # Counter.None THEN
                      INC(count[new]);
                      TextVBT.Put(countVBT[new], Fmt.Int(count[new]));
                    END;
                  END;
                END;
              END;
            END;
            FOR p := e.first TO e.first + e.nb - 1 DO
              RepaintOnePage(map, p);
            END;
        | RTHeapEvent.Kind.Bye => EXIT;
        | RTHeapEvent.Kind.Off => TextVBT.Put(off, Fmt.Int(e.nb));
        | RTHeapEvent.Kind.CollectNow, RTHeapEvent.Kind.GCOff,
            RTHeapEvent.Kind.GCOn => <* ASSERT FALSE *>
        END;
      END;
    END;
  END Run;

BEGIN
  InitColors();
  SetupVBT();
  Run();
  Trestle.AwaitDelete(root);
END ShowHeap.