-- File: DebugHeapAlto.mesa - last edit:
-- Smokey, May 7, 1980 3:59 PM
-- Mark Jul 25, 1980 4:35 PM
-- Evans Mar 21, 1979 10:23 AM
-- Bruce October 3, 1980 1:49 PM
-- HGM February 14, 1981 10:31 PM
DIRECTORY
Ascii USING [SP],
ControlDefs USING [GlobalFrameHandle],
DebugOps USING [StringExpToOctal],
DebugUsefulDefs USING [Name, ShortREAD, ShortCopyREAD, Enumerate],
Event USING [AddNotifier, Item, Masks, Notifier],
FSPDefs USING [
BlockSize, DestroyZone, FreeNode, MakeNode, MakeNewZone, NodeHeader,
NodePointer, ZoneHeader, ZonePointer],
FSP,
Frames USING [Invalid],
ImageDefs USING [BcdTime],
Inline USING [COPY],
Menu USING [Create, Handle, Instantiate, ItemObject, Items, MakeItem, MCRType],
NubOps USING [WhereAmI],
Put USING [CR, Char, Octal, Decimal, CurrentSelection, Line, Text],
Selection USING [Convert, Number],
String USING [AppendString, EqualString, InvalidNumber],
Storage USING [Node, FreePages, FreeString, HeapZone, Pages, Prune],
TextSW USING [SetEOF],
Time USING [Append, Unpack],
Tool USING [Create, MakeFileSW, MakeSWsProc],
UserTerminal USING [BlinkDisplay],
Window USING [Handle],
WindowFont USING [CharWidth];
DebugHeapAlto: PROGRAM
IMPORTS
DebugOps, DebugUsefulDefs, Event, FSPDefs, Frames, Inline, ImageDefs, Menu,
NubOps, Put, Selection, String, Storage, TextSW, Time, Tool, UserTerminal,
WindowFont
SHARES FSP, FSPDefs =
BEGIN OPEN FSPDefs;
-- global variable declarations
heapData: HeapData ← [];
isDebugger: BOOLEAN;
toolWindow: Window.Handle;
logSW: Window.Handle;
event: Event.Item ← [eventMask: Event.Masks[newSession], eventProc: Notify];
NodeDataHandle: TYPE = POINTER TO NodeData;
NodeData: TYPE = MACHINE DEPENDENT RECORD [
link: NodeDataHandle, size, count: CARDINAL];
HeapData: TYPE = RECORD [
fspFreeWords: CARDINAL ← 0,
fspUsedWords: CARDINAL ← 0,
fspFreeNodes: CARDINAL ← 0,
fspUsedNodes: CARDINAL ← 0,
nodeChain: NodeDataHandle ← NIL,
lookup: BOOLEAN ← TRUE,
myZone: FSPDefs.ZonePointer ← NULL,
TheHeap: FSPDefs.ZonePointer ← NULL];
-- HeapProc support Routines
Notify: Event.Notifier = {
IF why # newSession THEN RETURN;
heapData.TheHeap ← NIL;
heapData.lookup ← TRUE};
FindHeap: PROCEDURE [FSPGFH: POINTER TO FRAME[FSP]] =
BEGIN
IF ~heapData.lookup THEN RETURN;
IF isDebugger THEN
BEGIN
IF FSPGFH = NIL THEN FSPGFH ← LOOPHOLE[DebugUsefulDefs.Enumerate[Check]];
IF FSPGFH = NIL THEN heapData.TheHeap ← NIL
ELSE heapData.TheHeap ← DebugUsefulDefs.ShortREAD[@FSPGFH.TheHeap]
END
ELSE heapData.TheHeap ← Storage.HeapZone[];
IF heapData.TheHeap = NIL THEN Put.Line[logSW, "No FSP found!"L]
ELSE heapData.lookup ← FALSE;
END;
Check: PROCEDURE [gf: ControlDefs.GlobalFrameHandle] RETURNS [BOOLEAN] =
BEGIN
mod: STRING ← [40];
DebugUsefulDefs.Name[
mod, gf !
Frames.Invalid =>
BEGIN
Put.Text[logSW, "Invalid global frame ["L];
Put.Octal[logSW, f];
Put.Line[logSW, "]"L];
CONTINUE;
END];
RETURN[String.EqualString[mod, "FSP"L]]
END;
DebugHeapSetup: Tool.MakeSWsProc =
BEGIN
s: STRING = [40];
logSW ← Tool.MakeFileSW[window, "DebugHeap.log"L];
TextSW.SetEOF[logSW, 0];
String.AppendString[s, "Debug Heap of "L];
Time.Append[s, Time.Unpack[ImageDefs.BcdTime[]]];
Put.Line[logSW, s];
Put.CR[logSW];
heapData.myZone ← MakeNewZone[Storage.Pages[3], 3*256, Storage.FreePages];
Menu.Instantiate[Menu.Create[MakeMenuArray[], "HeapOps"L], window];
END;
DebugHeapUndoSetup: PROCEDURE = {FSPDefs.DestroyZone[heapData.myZone]};
DestroyNodeChain: PROCEDURE =
BEGIN OPEN FSPDefs, heapData;
node: NodeDataHandle ← nodeChain;
UNTIL node = NIL DO
node ← node.link; FreeNode[myZone, nodeChain]; nodeChain ← node; ENDLOOP;
END;
MakeMenuArray: PROCEDURE RETURNS [menuItems: Menu.Items] =
BEGIN OPEN Menu;
nItems: CARDINAL = 10;
menuItems ← DESCRIPTOR[Storage.Node[SIZE[ItemObject]*nItems], nItems];
menuItems[0] ← MakeItem["Info"L, MCR];
menuItems[1] ← MakeItem["Zones"L, MCR];
menuItems[2] ← MakeItem["UsedNodes"L, MCR];
menuItems[3] ← MakeItem["FreeNodes"L, MCR];
menuItems[4] ← MakeItem["NodesOfSize"L, MCR];
menuItems[5] ← MakeItem["AsciiContents"L, MCR];
menuItems[6] ← MakeItem["OctalContents"L, MCR];
menuItems[7] ← MakeItem["PruneHeap"L, MCR];
menuItems[8] ← MakeItem["Set FSP GFH"L, MCR];
menuItems[9] ← MakeItem["Verbose"L, MCR];
END;
MCR: Menu.MCRType =
BEGIN OPEN heapData;
n: CARDINAL;
FindHeap[NIL];
SELECT index FROM
0 => DisplayHeapInfo[];
1 => DisplayHeapZones[];
2 => DisplayUsedNodes[];
3 => DisplayFreeNodes[];
4 =>
BEGIN
n ← Selection.Number[ ! String.InvalidNumber => GOTO ret];
Put.Text[logSW, "NodesOfSize("L];
Put.CurrentSelection[logSW];
Put.Text[logSW, "): "L];
DisplayHeapBlocks[n];
END;
5 =>
BEGIN
n ← Selection.Number[8 ! String.InvalidNumber => GOTO ret];
DisplayHeapString[LOOPHOLE[n]];
END;
6 =>
BEGIN
n ← Selection.Number[8 ! String.InvalidNumber => GOTO ret];
DisplayHeapItem[LOOPHOLE[n]];
END;
7 =>
IF ~isDebugger THEN [] ← Storage.Prune[] ELSE UserTerminal.BlinkDisplay[];
8 =>
BEGIN
s: STRING;
FSPGFH: CARDINAL;
IF ~isDebugger THEN GOTO Blink;
IF (s ← Selection.Convert[string]) = NIL THEN GOTO Blink;
FSPGFH ← DebugOps.StringExpToOctal[s];
IF Check[LOOPHOLE[FSPGFH]] THEN {
lookup ← TRUE; FindHeap[LOOPHOLE[FSPGFH]]};
Storage.FreeString[s];
EXITS Blink => UserTerminal.BlinkDisplay[];
END;
9 => DisplayEverything[];
ENDCASE;
Put.CR[logSW];
EXITS ret => BEGIN UserTerminal.BlinkDisplay[]; RETURN END;
END;
-- Records
TwoChars: TYPE = RECORD [lh: CHARACTER, rh: CHARACTER];
-- global constant declarations
UsedNodeSize: FSPDefs.BlockSize = SIZE[inuse NodeHeader];
FreeSize: FSPDefs.BlockSize = SIZE[free NodeHeader];
ZoneHeaderSize: FSPDefs.BlockSize = SIZE[ZoneHeader];
-- Heap (FSP) Display Routines
DisplayHeapBlocks: PUBLIC PROCEDURE [size: CARDINAL] =
BEGIN
DisplayNodeAddress: PROCEDURE [n: NodePointer, nh: NodeHeader]
RETURNS [BOOLEAN] =
BEGIN
IF nh.length = size AND nh.state = inuse THEN
BEGIN Put.Octal[logSW, n]; Put.Char[logSW, Ascii.SP]; END;
RETURN[TRUE]
END;
EnumerateHeapNodes[DisplayNodeAddress];
END;
DisplayHeapItem: PUBLIC PROCEDURE [p: NodePointer] =
BEGIN
i: CARDINAL;
found: BOOLEAN ← FALSE;
DisplayNodeContents: PROCEDURE [n: NodePointer, nh: NodeHeader]
RETURNS [BOOLEAN] =
BEGIN
IF n = p THEN
BEGIN
FOR i IN [1..nh.length) DO
IF i MOD 8 = 1 THEN
BEGIN
IF i # 1 THEN Put.CR[logSW];
Put.Octal[logSW, n + i];
Put.Char[logSW, '/];
END;
Put.Char[logSW, Ascii.SP];
Put.Octal[logSW, LocalREAD[n + i]];
ENDLOOP;
found ← TRUE;
RETURN[FALSE];
END;
RETURN[TRUE]
END;
EnumerateHeapNodes[DisplayNodeContents];
IF ~found THEN Put.Line[logSW, " Not a Heap node"L];
END;
DisplayHeapString: PUBLIC PROCEDURE [p: NodePointer] =
BEGIN
i: CARDINAL;
word: TwoChars;
found: BOOLEAN ← FALSE;
DisplayNodeContents: PROCEDURE [n: NodePointer, nh: NodeHeader]
RETURNS [BOOLEAN] =
BEGIN
IF n = p THEN
BEGIN
Put.Octal[logSW, n + 1];
Put.Char[logSW, '/];
Put.Text[logSW, " ("L];
Put.Decimal[logSW, LocalREAD[n + 1]];
Put.Char[logSW, ',];
Put.Decimal[logSW, LocalREAD[n + 2]];
Put.Char[logSW, ')];
Put.Char[logSW, '"];
FOR i IN [3..nh.length) DO
word ← LocalREAD[n + i];
Put.Char[logSW, word.lh];
Put.Char[logSW, word.rh];
ENDLOOP;
Put.Char[logSW, '"];
found ← TRUE;
RETURN[FALSE]
END;
RETURN[TRUE]
END;
EnumerateHeapNodes[DisplayNodeContents];
IF ~found THEN Put.Line[logSW, "Not a Heap string"L];
END;
DisplayHeapInfo: PUBLIC PROCEDURE =
BEGIN OPEN heapData;
fspFreeWords ← fspUsedWords ← fspFreeNodes ← fspUsedNodes ← 0;
Put.Text[logSW, "Heap Info:"L];
EnumerateHeapNodes[CollectFreeNodes];
DisplayInfo[];
DestroyNodeChain[];
END;
DisplayHeapZones: PUBLIC PROCEDURE =
BEGIN OPEN FSPDefs, heapData;
z: ZonePointer;
zh: ZoneHeader;
Put.Text[logSW, "Heap Zones (Address,length)"L];
FOR z ← TheHeap, zh.restOfZone UNTIL z = NIL DO
zh ← GetZoneHeader[z];
Put.Char[logSW, Ascii.SP];
Put.Octal[logSW, z];
Put.Char[logSW, ',];
Put.Decimal[logSW, zh.length];
ENDLOOP;
END;
DisplayUsedNodes: PUBLIC PROCEDURE =
BEGIN OPEN heapData;
fspFreeWords ← fspUsedWords ← fspFreeNodes ← fspUsedNodes ← 0;
Put.Line[logSW, "Used nodes (length(count)): "L];
EnumerateHeapNodes[CollectUsedNodes];
DisplayHeapNumbers[];
DestroyNodeChain[];
END;
DisplayFreeNodes: PUBLIC PROCEDURE =
BEGIN OPEN heapData;
fspFreeWords ← fspUsedWords ← fspFreeNodes ← fspUsedNodes ← 0;
Put.Line[logSW, "Free nodes (length(count)): "L];
EnumerateHeapNodes[CollectFreeNodes];
DisplayHeapNumbers[];
DestroyNodeChain[];
END;
DisplayEverything: PUBLIC PROCEDURE =
BEGIN OPEN heapData;
fspFreeWords ← fspUsedWords ← fspFreeNodes ← fspUsedNodes ← 0;
Put.Line[logSW, "All nodes: "L];
mode ← new;
EnumerateHeapNodes[ShowEverything];
Put.CR[logSW];
DestroyNodeChain[];
END;
mode: {free, used, new};
ShowEverything: PROCEDURE [n: NodePointer, nh: NodeHeader] RETURNS [BOOLEAN] =
BEGIN OPEN heapData;
WITH nh SELECT FROM
inuse =>
BEGIN
IF mode # used THEN
BEGIN Put.CR[logSW]; Put.Text[logSW, "Used: "L]; mode ← used; END
ELSE Put.Text[logSW, ", "];
END;
free =>
BEGIN
IF mode # free THEN
BEGIN Put.CR[logSW]; Put.Text[logSW, "Free: "L]; mode ← free; END
ELSE Put.Text[logSW, ", "];
END;
ENDCASE;
Put.Octal[logSW, n];
Put.Text[logSW, " "L];
Put.Decimal[logSW, nh.length];
RETURN[TRUE];
END;
CollectUsedNodes: PROCEDURE [n: NodePointer, nh: NodeHeader] RETURNS [BOOLEAN] =
BEGIN OPEN heapData;
WITH nh SELECT FROM
inuse =>
BEGIN
node: NodeDataHandle ← GetNodeData[length];
node.count ← node.count + 1;
fspUsedWords ← fspUsedWords + length;
fspUsedNodes ← fspUsedNodes + 1;
END;
free =>
BEGIN
fspFreeWords ← fspFreeWords + length;
fspFreeNodes ← fspFreeNodes + 1;
END;
ENDCASE;
RETURN[TRUE];
END;
CollectFreeNodes: PROCEDURE [n: NodePointer, nh: NodeHeader] RETURNS [BOOLEAN] =
BEGIN OPEN heapData;
WITH nh SELECT FROM
inuse =>
BEGIN
fspUsedWords ← fspUsedWords + length;
fspUsedNodes ← fspUsedNodes + 1;
END;
free =>
BEGIN
node: NodeDataHandle ← GetNodeData[length];
node.count ← node.count + 1;
fspFreeWords ← fspFreeWords + length;
fspFreeNodes ← fspFreeNodes + 1;
END;
ENDCASE;
RETURN[TRUE];
END;
GetNodeData: PROCEDURE [length: CARDINAL] RETURNS [NodeDataHandle] =
BEGIN OPEN heapData;
node: NodeDataHandle ← LOOPHOLE[@heapData.nodeChain];
DO
IF node.link = NIL OR node.link.size > length THEN -- put new guy here
BEGIN
newNode: NodeDataHandle ← FSPDefs.MakeNode[myZone, SIZE[NodeData]];
newNode↑ ← [link: node.link, size: length, count: 0];
node.link ← newNode;
RETURN[newNode];
END;
IF node.link.size = length THEN RETURN[node.link];
node ← node.link;
ENDLOOP;
END;
DisplayInfo: PUBLIC PROCEDURE =
BEGIN OPEN heapData;
Put.Text[logSW, " Free words: "L];
Put.Decimal[logSW, fspFreeWords];
Put.Text[logSW, ", Free nodes: "L];
Put.Decimal[logSW, fspFreeNodes];
Put.Text[logSW, ", Used words: "L];
Put.Decimal[logSW, fspUsedWords];
Put.Text[logSW, ", Used nodes: "L];
Put.Decimal[logSW, fspUsedNodes];
END;
DisplayHeapNumbers: PROCEDURE =
BEGIN OPEN heapData;
node: NodeDataHandle ← nodeChain;
i: CARDINAL ← 0;
CommaState: TYPE = {notGoing, sameLine, newLine};
commaState: CommaState ← notGoing;
itemsPerLine: CARDINAL =
IF logSW = NIL THEN 5 ELSE logSW.box.dims.w/(WindowFont.CharWidth['W]*9);
UNTIL node = NIL DO
SELECT commaState FROM
notGoing => commaState ← sameLine;
sameLine => Put.Text[logSW, ", "L];
newLine => {Put.Line[logSW, ","L]; commaState ← sameLine};
ENDCASE;
Put.Decimal[logSW, node.size];
Put.Char[logSW, '(];
Put.Decimal[logSW, node.count];
Put.Char[logSW, ')];
IF i = itemsPerLine THEN {i ← 0; commaState ← newLine} ELSE i ← i + 1;
node ← node.link;
ENDLOOP;
END;
-- routines to process the Heap
EnumerateHeapNodes: PUBLIC PROCEDURE [
proc: PROCEDURE [NodePointer, NodeHeader] RETURNS [BOOLEAN]] =
BEGIN OPEN FSPDefs, heapData;
-- funny code in here so this routine can be used in the Debbuger!
rest: ZonePointer;
z: ZonePointer;
zh: ZoneHeader ← GetZoneHeader[TheHeap];
node: NodePointer;
nh: NodeHeader;
nodeLength: BlockSize;
FOR z ← TheHeap, rest UNTIL z = NIL DO
zh ← GetZoneHeader[z];
rest ← zh.restOfZone;
FOR node ← LOOPHOLE[z + ZoneHeaderSize, NodePointer], node + nodeLength DO
nh ← GetNodeHeader[node];
IF nh.length = UsedNodeSize THEN EXIT;
IF ~proc[node, nh] THEN RETURN;
nodeLength ← nh.length;
ENDLOOP;
ENDLOOP;
END;
GetZoneHeader: PROCEDURE [z: ZonePointer] RETURNS [zh: ZoneHeader] =
BEGIN LocalCopyRead[@zh, z, SIZE[ZoneHeader]]; END;
GetNodeHeader: PROCEDURE [n: NodePointer] RETURNS [nh: NodeHeader] =
BEGIN LocalCopyRead[@nh, n, SIZE[NodeHeader]]; END;
LocalCopyRead: PROCEDURE [to, from: POINTER, count: CARDINAL] =
BEGIN
IF isDebugger THEN
DebugUsefulDefs.ShortCopyREAD[to: to, from: from, nwords: count]
ELSE Inline.COPY[to: to, from: from, nwords: count]
END;
LocalREAD: PROCEDURE [address: POINTER] RETURNS [word: UNSPECIFIED] =
BEGIN
RETURN[IF isDebugger THEN DebugUsefulDefs.ShortREAD[address] ELSE address↑];
END;
-- Mainline code
Init: PROC =
BEGIN
isDebugger ←
SELECT NubOps.WhereAmI[] FROM
debugger, internaldebugger => TRUE,
ENDCASE => FALSE;
Event.AddNotifier[@event];
toolWindow ← Tool.Create[
makeSWsProc: DebugHeapSetup, name: "DebugHeap"L, initialState: default,
movableBoundaries: FALSE];
END;
Init[];
END...