home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / demo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-08  |  4.7 KB  |  147 lines
  1. {TUG PDS CERT 1.01 (Pascal)
  2.  
  3. ==========================================================================
  4.  
  5.                   TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION
  6.  
  7. The Turbo User Group (TUG) is recognized by Borland International as the
  8. official support organization for Turbo languages.  This file has been
  9. compiled and verified by the TUG library staff.  We are reasonably certain
  10. that the information contained in this file is public domain material, but
  11. it is also subject to any restrictions applied by its author.
  12.  
  13. This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
  14. DOMAIN, provided as a service of TUG for the use of its members.  The
  15. Turbo User Group will not be liable for any damages, including any lost
  16. profits, lost savings or other incidental or consequential damages arising
  17. out of the use of or inability to use the contents, even if TUG has been
  18. advised of the possibility of such damages, or for any claim by any
  19. other party.
  20.  
  21. To the best of our knowledge, the routines in this file compile and function
  22. properly in accordance with the information described below.
  23.  
  24. If you discover an error in this file, we would appreciate it if you would
  25. report it to us.  To report bugs, or to request information on membership
  26. in TUG, please contact us at:
  27.  
  28.              Turbo User Group
  29.              PO Box 1510
  30.              Poulsbo, Washington USA  98370
  31.  
  32. --------------------------------------------------------------------------
  33.                        F i l e    I n f o r m a t i o n
  34.  
  35. * DESCRIPTION
  36. This program demonstrates the use of the heap allocation tools provided in
  37. the HeapChek unit.
  38.  
  39. * ASSOCIATED FILES
  40. HEAPCHEK.PAS
  41. DEMO.EXE
  42. DEMO.PAS
  43. HEAPCHEK.TPU
  44.  
  45. * CHECKED BY
  46. DRM 08/08/88
  47.  
  48. * KEYWORDS
  49. TURBO PASCAL V4.0
  50.  
  51. ==========================================================================
  52. }
  53. Program Demo;
  54.  
  55. { This program demonstrates the use of the heap allocation tools provided
  56.   in the HeapChek unit.
  57.  
  58.   Public Domain -- Lynn W. Taylor (CIS 74176,52) }
  59.  
  60. Uses TpCRT, TpString, HeapChek;
  61.  
  62. const MaxArray=24;
  63.       BlockSize=1;
  64.  
  65. var PointerArray: array  [1..MaxArray] of Pointer;
  66.     Ctr, Index: integer;
  67.     AllocationStrategy: char;
  68.  
  69. Begin
  70.   ClrScr;
  71.   WriteLn('Heap allocation strategy demo');
  72.   WriteLn;
  73.   WriteLn('Program demonstrates tools to show heap states, and to alter the allocation');
  74.   WriteLn('strategies used by the Heap Manager by modifying the free list.');
  75.   WriteLn;
  76.   WriteLn('To demonstrate, program will allocate 24 one-byte blocks, deallocate them');
  77.   WriteLn('in a random order, then re-allocate them.');
  78.   WriteLn;
  79.   WriteLn('After the blocks are allocated, an "*" will indicate a block which');
  80.   WriteLn('has been deallocated.  The new pointer will be displayed to the right');
  81.   WriteLn('as it is allocated, along with the size of the largest free block.');
  82.   WriteLn;
  83.   WriteLn('Choose [E] for Exact Fit');
  84.   WriteLn('       [F] for First Fit');
  85.   WriteLn('       [B] for Best Fit');
  86.   WriteLn('       [W] for Worst Fit');
  87.   WriteLn('       [S] to place disposed pointer at end of free list');
  88.   WriteLn;
  89.   WriteLn('Any other key uses Turbo default heap management');
  90.   AllocationStrategy:=ReadKey;
  91.   ClrScr;
  92.   Randomize;
  93.   AlwaysShowHeapStatus:=true;
  94.   ClrScr;
  95.   For Ctr:=1 to MaxArray do
  96.     Begin
  97.       GetMem(PointerArray[Ctr], BlockSize);
  98.       GotoXY(32, Ctr);
  99.       Write(Ctr:2,' $', HexPtr(PointerArray[Ctr]));
  100.       GotoXY(1, 1);
  101.       HeapCheck;
  102.       Delay(500)
  103.     End;
  104.   For Ctr:=1 to Random(MaxArray)+MaxArray div 2 do
  105.     Begin
  106.       Index:=Random(MaxArray)+1;
  107.       If PointerArray[Index]<>NIL then
  108.         Begin
  109.           GotoXY(46, Index);
  110.           Write('+');
  111.           FreeMem(PointerArray[Index], BlockSize);
  112.           If UpCase(AllocationStrategy)='S' then SwapFreeHeap;
  113.           GotoXY(1,1);
  114.           HeapCheck;
  115.           ShowFreeList;
  116.           While WhereY<24 do WriteLn('                       ');
  117.           Delay(500);
  118.           GotoXY(46, Index);
  119.           Write('*');
  120.           PointerArray[Index]:=NIL;
  121.         End
  122.     End;
  123.   GotoXY(46, Index);
  124.   Write('+');
  125.   For Ctr:=1 to MaxArray do
  126.     If PointerArray[Ctr]=NIL then
  127.       Begin
  128.         GotoXY(60, Ctr);
  129.         Write('(',MaxFreeListBlock,')');
  130.         Case AllocationStrategy of
  131.           'b','B': BestFitHeap(BlockSize);
  132.           'e','E': ExactFitHeap(BlockSize);
  133.           'f','F': FirstFitHeap(BlockSize);
  134.           'w','W': WorstFitHeap
  135.         end;  {cases}
  136.         GetMem(PointerArray[Ctr], BlockSize);
  137.         GotoXY(48, Ctr);
  138.         Write('$', HexPtr(PointerArray[Ctr]));
  139.         GotoXY(1,1);
  140.         HeapCheck;
  141.         ShowFreeList;
  142.         While WhereY<24 do WriteLn('                       ');
  143.         Delay(500)
  144.       End;
  145.   GotoXY(1,1)
  146. End.
  147.