-- 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...