home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HEAP_CHK.ZIP / HEAP_CHK.PAS
Encoding:
Pascal/Delphi Source File  |  1986-05-31  |  2.0 KB  |  63 lines
  1. { These two routines are for Turbo Pascal Version 3.01A and PC-DOS only and
  2.   are simple debugging routines for examining the current heap structure and
  3.   the heap free space.  To use include this file into your program and call
  4.   InitHeap as the first thing in your main program block.  This initializes
  5.   the heap and prepares for subsequent calls to DumpHeap.  Whenever DumpHeap
  6.   is then called, it will display a list of used and free memory blocks.  This
  7.   will help tell if memory is becoming fragmented or pieces of the heap are
  8.   being lost.  If you have any questions, contact me at
  9.  
  10.         Scott Bussinger
  11.         Professional Practice Systems
  12.         110 South 131st Street
  13.         Tacoma, WA  98444
  14.         Compuserve [72247,2671]  }
  15.  
  16. type HeapPointer = ^HeapRec;
  17.      HeapRec = record
  18.        Next: HeapPointer;
  19.        Size: HeapPointer
  20.        end;
  21.  
  22. var HeapStart: HeapPointer;
  23.  
  24. procedure InitHeap;
  25.   { Initialize the heap display variables }
  26.   var HeapWaste: ^byte;
  27.   begin
  28.   new(HeapStart);
  29.   new(HeapWaste);
  30.   dispose(HeapStart)
  31.   end;
  32.  
  33. procedure DumpHeap;
  34.   { Display the heap free space chain }
  35.   var FreeSpace: real;
  36.       Heap: HeapPointer;
  37.  
  38.   function Address(var Pointer): real;
  39.     begin
  40.     Address := 16.0*seg(Pointer) + ofs(Pointer)
  41.     end;
  42.  
  43.   begin
  44.   writeln;
  45.   writeln('Current Heap Status:');
  46.   writeln('--------------------');
  47.   FreeSpace := 16.0*memavail-8.0;
  48.   if HeapStart^.Next^.Next <> nil then
  49.     begin
  50.     if Address(HeapStart^.Next^)-Address(HeapStart^)-Address(HeapStart^.Size^)-8.0 <> 0.0 then
  51.       writeln(Address(HeapStart^.Next^)-Address(HeapStart^)-Address(HeapStart^.Size^)-8.0:24:0,' bytes used.');
  52.     Heap := HeapStart^.Next;
  53.     while Heap^.Next <> nil do
  54.       begin
  55.       writeln(Address(Heap^.Size^):6:0,' bytes free. ',
  56.               Address(Heap^.Next^)-Address(Heap^)-Address(Heap^.Size^):5:0,' bytes used.');
  57.       FreeSpace := FreeSpace - Address(Heap^.Size^);
  58.       Heap := Heap^.Next
  59.       end
  60.     end;
  61.   writeln(FreeSpace:6:0,' bytes free.')
  62.   end;
  63.