UNSAFE MODULE------------------------------------------------------------ heap state ---ShowHeap EXPORTSMain ; 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*>
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------------------------------------------------------- Number Displays ---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; PROCEDUREActionVBT (name: Text.T; action: PROCEDURE ()): VBT.T = BEGIN RETURN ButtonVBT.New(TextVBT.New(name), DoActionVBT, NEW(A, p := action)); END ActionVBT; PROCEDUREDoActionVBT ( self: ButtonVBT.T; <*UNUSED*> READONLY cd : VBT.MouseRec ) = BEGIN NARROW(VBT.GetProp(self, TYPECODE(A)), A).p(); END DoActionVBT;
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; PROCEDUREQuitAction () = BEGIN Trestle.Delete(root); Process.Exit(0); END QuitAction; PROCEDURESetupVBT () = 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;
PROCEDURERun () = 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.