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---------------------------------------------------------------- colors ---CounterOf (d: Desc): Counter = BEGIN RETURN counterOf[ d.space, d.generation, d.pure, d.note, d.gray, d.clean]; END CounterOf;
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------------------------------------------------------------ Heap map ---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; PROCEDUREInitColors () = 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;
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---------------------------------------------------------- various VBTs ---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; PROCEDURERepaintHeapMap ( 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; PROCEDURERepaintOnePage (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; PROCEDUREReshapeHeapMap (self: HeapMapVBT; READONLY cd: VBT.ReshapeRec) = BEGIN self.rect := cd.new; LayoutHeapMap(self); RepaintHeapMap(self, Region.T{r := cd.new}); END ReshapeHeapMap; PROCEDUREShapeHeapMap (<*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;
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.