[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]

    {
    From: dmurdoch@mast.queensu.ca (Duncan Murdoch)
    >
    >Anyhow, what this program is doing (among other things) is reading data from
    >an ASCII file when commanded to, one line at a time, and plotting it on the
    >screen.  My problem is, when you return to the main menu, a bit of the RAM
    >has been used.  If you call up a couple of plots in a row, eventually you
    >run out of RAM and crash.  And I'm having a devil of a time trying to figure
    >where the memory is going.

    This is one of the harder kinds of error to track down.  The way I do it is
    as follows:

    1.  Throughout program development, I use a debugging unit that warns me if
    anything is left on the heap when the program terminates. If there is, I
    immediately track it down and fix it.  The error is probably in the new
    part, and that helps to find it.

    2.  To prevent errors, I program in a very structured way:  every allocation
    has a matching de-allocation, preferable within a dozen or two lines of
    it so they're both on screen at once and I can see that they match.

    3.  If the preventive methods don't work, I have to track down the bugs. I
    have a routine that can print heap usage when I want.  I print all the heap
    that's used at the end of the program (should be none!), and try to
    recognize where the stuff came from.  If it's strings, it's easy, but if
    it's binary data, it's hard.  If necessary I trace through the program until
    I see one of those parts get allocated.

    I've attached my heap routine below, but it won't compile for you without a
    few utility routines from TurboPower's Object Professional library (and
    some others of mine).  Hopefully it'll still be useful for you and you can
    write the other parts yourself.

    Duncan Murdoch
    }
    unit heap;
    { This unit does integrity checks on the TP 6.0 heap }

    interface

    uses standard,opinline,opstring,dump;

    function heapokay:boolean;

    procedure showfreelist(var where:text;msg:string);
    { Prints the free list }

    procedure showheapused(var where:text;msg:string);
    { Prints the heap usage }

    type
      PFreeRec = ^TFreeRec;
      TFreeRec = record
        next: PFreeRec;
        size: Pointer;
      end;

    implementation

    function Ordered(p1,p2:pointer):boolean;
    { Tests whether p1 <= p2 }
    begin
      Ordered := PtrToLong(p1) <= PtrToLong(p2);
    end;

    function Normed(p:pointer):boolean;
    { Checks whether p is a normalized pointer }
    begin
      case ofs(p^) of
      0..$F : Normed := true;
      else    Normed := false;
      end;
    end;

    function heapokay:boolean;

    procedure error(msg:string);
    begin
      writeln(stderr,msg);
      heapokay := false;
      halt(99);
    end;

    type
      PFreeRec = ^TFreeRec;
      TFreeRec = record
        next: PFreeRec;
        size: Pointer;
      end;
    var
      FreeRec : PFreeRec;
    begin
      if not Normed(HeapOrg) then
        error('HeapOrg bad!');
      if not Normed(FreeList) then
        error('FreeList bad!');
      if not Normed(HeapPtr) then
        error('HeapPtr bad!');
      if not Normed(HeapEnd) then
        error('HeapEnd bad!');

      if not Ordered(HeapOrg,FreeList) then
        error('HeapOrg > FreeList');
      if not Ordered(FreeList,HeapPtr) then
        error('FreeList > HeapPtr');
      if not Ordered(HeapPtr,HeapEnd) then
        error('HeapPtr > HeapEnd');

      FreeRec := FreeList;
      while PtrToLong(FreeRec) < PtrToLong(HeapPtr) do   { Walk the free list }
      begin
        if not Normed(FreeRec^.next) then
          error('Bad next in free record '+HexPtr(FreeRec));
        if not ordered(FreeRec,FreeRec^.next) then
          error('self > next in free record '+HexPtr(FreeRec));
        if not ordered(AddLongToPtr(FreeRec,PtrToLong(FreeRec^.size)),
                       FreeRec^.next) then
          error('Bad size in free record '+HexPtr(FreeRec));
        if FreeRec = FreeRec^.Next then
          error('Self pointer in free record '+HexPtr(FreeRec));
        FreeRec := FreeRec^.Next;
      end;
      if FreeRec <> HeapPtr then
        error('Bad last free block');

      heapokay := true;
    end;

    function addtopointer(p:pointer;incr:longint):pointer;
    {  Adds increment to pointer, only normalizes if necessary }
    begin
      if ofs(p^) + incr > 65535 then
        addtopointer := AddLongToPtr(p,incr)
      else
        addtopointer := AddWordToPtr(p,incr);
    end;

    procedure showfreelist(var where:text;msg:string);
    { Prints the free list }
    var
      FreePtr : PFreerec;
      Free,Total:longint;
    begin
      writeln(where,msg);
      writeln(where,'  Start      Stop    Size free');

      FreePtr := PFreeRec(@FreeList);
      Total := 0;
      repeat
        Free:=PtrToLong(Freeptr^.Size);
        inc(Total,Free);
        if Free <> 0 then
          writeln(where, HexPtr(FreePtr), '  ', HexPtr(AddToPointer(FreePtr,Free)),
                         '  ',Free:6);
        FreePtr := FreePtr^.next;
      until FreePtr = HeapPtr;
      Free := PtrDiff(HeapEnd,HeapPtr);
      inc(Total,Free);
      writeln(where, HexPtr(HeapPtr), '  ', HexPtr(HeapEnd),
                     '  ',Free:6);
      writeln(where, 'Total':8,'':14, Total:6);
    end;

    procedure showheapused(var where:text;msg:string);
    { Prints what's been used on the heap }
    var
      FreePtr : PFreerec;
      UsedPtr : Pointer;
      Used : longint;
      Total: longint;
    begin
      writeln(where,msg);
      writeln(where,'  Start      Stop    Size used     Data');

      FreePtr := FreeList;
      UsedPtr := HeapOrg;
      total := 0;
      while FreePtr <> HeapPtr do
      begin
        Used := PtrDiff(UsedPtr,FreePtr);
        inc(Total,Used);
        if used <> 0 then
        begin
          write(where, HexPtr(UsedPtr), '  ', HexPtr(AddToPointer(UsedPtr,Used)),
                         '  ',Used:6,'   ');
          dumpbothshort(where, UsedPtr^, 0, 8);
        end;

        UsedPtr := AddLongToPtr(FreePtr,PtrToLong(FreePtr^.size));
        if FreePtr <> HeapPtr then
          FreePtr := FreePtr^.next;
      end;
      Used := PtrDiff(HeapPtr,UsedPtr);
      inc(Total,used);
      if used <> 0 then
      begin
        write(where, HexPtr(UsedPtr), '  ', HexPtr(AddToPointer(UsedPtr,Used)),
                         '  ',Used:6,'   ');
        dumpbothshort(where, UsedPtr^, 0,8);
      end;
      writeln(where, 'Total':8,'':14, Total:6);
    end;

    end.

[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]