🚀 go-pugleaf

I found a nice way to track down those hard to find memory allocation errors.  
The type where you allocate n bytes and use n+m bytes, usually clobbering 
something else.  Normally the program works until much later when the 
clobbered data causes it to crash.  I'm sure you know the type... :-)

Anyway, here is a debugging tool.  It checks the heap consistency before and 
after every procedure.  Remember to compile all the suspect modules with the 
(*$Q+*) switch to include procedure-tracing code.  The heap consistency check 
will catch the error because the heap linked list is interleaved with the 
allocated memory.

(code fragment follows)

VAR DebugWindow :Window.WinType;

PROCEDURE TraceEntryProc();
VAR Used :WinType;
BEGIN
  Used := Window.Used();
  Window.Use(DebugWindow);
  IO.WrStr("In:  ");  IO.WrStr(ProcTrace.Get_Name());  IO.WrLn;
  IF NOT CheckHeap() THEN
    IO.WrStr(" !Heap inconsistent (in)");  IO.WrLn;
    IF KeyInAtomic() = ESC THEN HALT END;
  END;
  Window.Use(Used);
END TraceEntryProc;

PROCEDURE TraceExitProc();
VAR Used :WinType;
BEGIN
  Used := Window.Used();
  Window.Use(DebugWindow);
  IO.WrStr("Out: ");  IO.WrStr(ProcTrace.Get_Name());  IO.WrLn;
  IF NOT CheckHeap() THEN
    IO.WrStr(" !Heap inconsistent (out)");  IO.WrLn;
    IF KeyInAtomic() = ESC THEN HALT END;
  END;
  Window.Use(Used);
END TraceExitProc;

PROCEDURE InitWinKernel();
VAR Used :WinType;
BEGIN
  InitKeyboard();
  InitKeys();
  InitProcesses();
  IF Indaba.DebugTrace THEN
    Used := Window.Used();
    DebugWindow := Window.Open(Window.WinDef(40,1,79,24, 
                   Window.White, Window.Black,
                   TRUE, TRUE, FALSE, TRUE, Window.SingleFrame,
                   Window.Yellow, Window.Black));
    Window.SetTitle(DebugWindow, " Debug Trace ", Window.RightUpperTitle);
    ProcTrace.Install();
    ProcTrace.Entry := TraceEntryProc;
    ProcTrace.Exit := TraceExitProc;
    Window.Use(Used);
  END;
END InitWinKernel;


(*
 * Check if the heap is consistent (Debug)
 * JPI Modula-2 specific
 *)

PROCEDURE CheckHeap() :BOOLEAN;
VAR
  p :Storage.HeapRecPtr;
  c :CARDINAL;
BEGIN
  p := Storage.MainHeap^.next;
  FOR c := 1 TO 50000 DO
    IF p = NIL THEN RETURN FALSE END;  (* should be endless ring *)
    IF p = Storage.MainHeap THEN RETURN FALSE END;  (* no endmarker *)
    IF p^.size = 0FFFFH THEN RETURN TRUE END;  (* Found endmarker *)
    p := p^.next;
  END;
  RETURN FALSE;  (* endless junk *)
END CheckHeap;

That's it.

Oh yes, a warning.  I use JPI 1.17 and this code might not work as expected on 
any other compiler.

-- Pieter



--  
uucp: uunet!m2xenix!puddle!5!492!11!Pieter.Muller
Internet: Pieter.Muller@f11.n492.z5.fidonet.org