home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / HEAPTEST.ZIP / HEAPTEST.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  1.6 KB  |  58 lines
  1. program HeapTest(input, output);
  2.  
  3. {This program demonstrates a bug in Turbo Pascal, version 2.
  4. I put 10 integers on the stack, then release the stack and put
  5. 10 integers on the stack again.  In v. 1.0 we get the same results
  6. each time, as we should.  In v. 2.0 we get different answers.  Apparently
  7. the procedure Release(HeapTop) is not working properly.}
  8.  
  9. {The procedure ReleaseHeap is a replacement for Release(HeapTop) and
  10. seems to work correctly}
  11.  
  12. type
  13.   IntegerPointer = ^integer;
  14.  
  15. var
  16.   Number :  ^integer;
  17.   HeapTop : ^integer;
  18.   Mem : real;
  19.  
  20. procedure ReleaseHeap (AHeapPointer : IntegerPointer);
  21. var i : integer;
  22. begin
  23.   i := ((seg(heapptr^) - seg(AHeapPointer^)) shl 4) +
  24.         (ofs(heapptr^) - ofs(AHeapPointer^));
  25.   FreeMem(AHeapPointer,i);
  26. end;
  27.  
  28. procedure report; {report memory available}
  29. begin
  30.     Mem := MemAvail;
  31.     if (Mem < 0) then Mem := 65536.0+MemAvail;
  32.     write('MemAvail = ',Mem:7:0, ' paragraphs ', Mem*16.0:9:0, ' bytes');
  33. end;
  34.  
  35. procedure FillTheHeap(xc,yc,Depth : integer); {fill the heap to Depth}
  36. var
  37.   n : integer;
  38. begin
  39. for n := 1 to Depth do
  40.     begin
  41.     New(Number) ;
  42.     Number^ := n;
  43.     gotoxy(xc,yc);
  44.     report;
  45.     end
  46. end;
  47.  
  48. begin
  49.     Mark(HeapTop);  {Mark the top of the heap}
  50.     gotoxy(5,20);
  51.     report;               {1: Report memory available}
  52.     FilltheHeap(5,21,10); {2: Fill the heap with 10 integers}
  53.     releaseheap(HeapTop);     {Release the heap using the fix}
  54.     gotoxy(5,22);
  55.     report;               {3: Report memory available; should be same as in 1}
  56.     FilltheHeap(5,23,10); {4: Put 10 integers on again; should be same as in 2}
  57. end.
  58.