home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / arc / arctool / demo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-29  |  3.2 KB  |  110 lines
  1. {
  2.                        F i l e    I n f o r m a t i o n
  3.  
  4. * DESCRIPTION
  5. This program demonstrates the use of the heap allocation tools provided in
  6. the HeapChek unit.
  7.  
  8. * ASSOCIATED FILES
  9. HEAPCHEK.PAS
  10. DEMO.EXE
  11. DEMO.PAS
  12. HEAPCHEK.TPU
  13.  
  14. }
  15. Program Demo;
  16.  
  17. { This program demonstrates the use of the heap allocation tools provided
  18.   in the HeapChek unit.
  19.  
  20.   Public Domain -- Lynn W. Taylor (CIS 74176,52) }
  21.  
  22. Uses TpCRT, TpString, HeapChek;
  23.  
  24. const MaxArray=24;
  25.       BlockSize=1;
  26.  
  27. var PointerArray: array  [1..MaxArray] of Pointer;
  28.     Ctr, Index: integer;
  29.     AllocationStrategy: char;
  30.  
  31. Begin
  32.   ClrScr;
  33.   WriteLn('Heap allocation strategy demo');
  34.   WriteLn;
  35.   WriteLn('Program demonstrates tools to show heap states, and to alter the allocation');
  36.   WriteLn('strategies used by the Heap Manager by modifying the free list.');
  37.   WriteLn;
  38.   WriteLn('To demonstrate, program will allocate 24 one-byte blocks, deallocate them');
  39.   WriteLn('in a random order, then re-allocate them.');
  40.   WriteLn;
  41.   WriteLn('After the blocks are allocated, an "*" will indicate a block which');
  42.   WriteLn('has been deallocated.  The new pointer will be displayed to the right');
  43.   WriteLn('as it is allocated, along with the size of the largest free block.');
  44.   WriteLn;
  45.   WriteLn('Choose [E] for Exact Fit');
  46.   WriteLn('       [F] for First Fit');
  47.   WriteLn('       [B] for Best Fit');
  48.   WriteLn('       [W] for Worst Fit');
  49.   WriteLn('       [S] to place disposed pointer at end of free list');
  50.   WriteLn;
  51.   WriteLn('Any other key uses Turbo default heap management');
  52.   AllocationStrategy:=ReadKey;
  53.   ClrScr;
  54.   Randomize;
  55.   AlwaysShowHeapStatus:=true;
  56.   ClrScr;
  57.   For Ctr:=1 to MaxArray do
  58.     Begin
  59.       GetMem(PointerArray[Ctr], BlockSize);
  60.       GotoXY(32, Ctr);
  61.       Write(Ctr:2,' $', HexPtr(PointerArray[Ctr]));
  62.       GotoXY(1, 1);
  63.       HeapCheck;
  64.       Delay(500)
  65.     End;
  66.   For Ctr:=1 to Random(MaxArray)+MaxArray div 2 do
  67.     Begin
  68.       Index:=Random(MaxArray)+1;
  69.       If PointerArray[Index]<>NIL then
  70.         Begin
  71.           GotoXY(46, Index);
  72.           Write('+');
  73.           FreeMem(PointerArray[Index], BlockSize);
  74.           If UpCase(AllocationStrategy)='S' then SwapFreeHeap;
  75.           GotoXY(1,1);
  76.           HeapCheck;
  77.           ShowFreeList;
  78.           While WhereY<24 do WriteLn('                       ');
  79.           Delay(500);
  80.           GotoXY(46, Index);
  81.           Write('*');
  82.           PointerArray[Index]:=NIL;
  83.         End
  84.     End;
  85.   GotoXY(46, Index);
  86.   Write('+');
  87.   For Ctr:=1 to MaxArray do
  88.     If PointerArray[Ctr]=NIL then
  89.       Begin
  90.         GotoXY(60, Ctr);
  91.         Write('(',MaxFreeListBlock,')');
  92.         Case AllocationStrategy of
  93.           'b','B': BestFitHeap(BlockSize);
  94.           'e','E': ExactFitHeap(BlockSize);
  95.           'f','F': FirstFitHeap(BlockSize);
  96.           'w','W': WorstFitHeap
  97.         end;  {cases}
  98.         GetMem(PointerArray[Ctr], BlockSize);
  99.         GotoXY(48, Ctr);
  100.         Write('$', HexPtr(PointerArray[Ctr]));
  101.         GotoXY(1,1);
  102.         HeapCheck;
  103.         ShowFreeList;
  104.         While WhereY<24 do WriteLn('                       ');
  105.         Delay(500)
  106.       End;
  107.   GotoXY(1,1)
  108. End.
  109. 
  110.