home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / LIB / TESTPRGS.ZIP / HEAPTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-07  |  5.0 KB  |  159 lines
  1. PROGRAM HeapTest;  { Copyright (c) 1992,1993 Norbert Juffa }
  2.  
  3. { HeapTest tests correctness and speed of heap operations in real mode. }
  4.  
  5. {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R-,S-,V-,X-}
  6. {$M 4096,0,655360}
  7.  
  8. USES Time;
  9.  
  10. VAR Dummy,Start, LoopTime,LoopTime2: LONGINT;
  11.     Delta, TotalTime: LONGINT;
  12.     L,Choice,K,T: WORD;
  13.     BlkPtr:  ARRAY [1..1000] OF POINTER;
  14.     BlkSize: ARRAY [1..1000] OF WORD;
  15.     Permutation: ARRAY [1..1000] OF WORD;
  16.  
  17. BEGIN
  18.    WriteLn ('Test of TP heap functions');
  19.    WriteLn;
  20.    TotalTime := 0;
  21.    RandSeed := 997;
  22.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  23.    Start := Clock;
  24.    FOR L := 1 TO 1000 DO BEGIN
  25.    END;
  26.    LoopTime := Clock-Start;
  27.    FOR L := 1 TO 1000 DO BEGIN
  28.       BlkSize [L] := Random (512) + 1;
  29.    END;
  30.    Write ('Allocating 1000 blocks at the end of the heap: ');
  31.    Start := Clock;
  32.    FOR L := 1 TO 1000 DO BEGIN
  33.       GetMem (BlkPtr [L], BlkSize [L]);
  34.    END;
  35.    Delta := Clock-Start-LoopTime;
  36.    Inc (TotalTime, Delta);
  37.    WriteLn (Delta:5, ' ms');
  38.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  39.    Write ('Deallocating same 1000 blocks in reverse order:');
  40.    Start := Clock;
  41.    FOR L := 1 TO 1000 DO BEGIN
  42.       FreeMem (BlkPtr [L], BlkSize [L]);
  43.    END;
  44.    Delta := Clock-Start-LoopTime;
  45.    Inc (TotalTime, Delta);
  46.    WriteLn (Delta:5, ' ms');
  47.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  48.    Write ('Allocating 1000 blocks at the end of the heap: ');
  49.    Start := Clock;
  50.    FOR L := 1 TO 1000 DO BEGIN
  51.       GetMem (BlkPtr [L], BlkSize [L]);
  52.    END;
  53.    Delta := Clock-Start-LoopTime;
  54.    Inc (TotalTime, Delta);
  55.    WriteLn (Delta:5, ' ms');
  56.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  57.    FOR L := 1 TO 1000 DO BEGIN
  58.       Permutation [L] := L;
  59.    END;
  60.    Start := Clock;
  61.    FOR L := 1000 DOWNTO 1 DO BEGIN
  62.       Choice := Random (L)+1;
  63.       K := Permutation [Choice];
  64.       Permutation [Choice] := Permutation [L];
  65.    END;
  66.    LoopTime2 := Clock - Start;
  67.    FOR L := 1 TO 1000 DO BEGIN
  68.       Permutation [L] := L;
  69.    END;
  70.    Write ('Deallocating same 1000 blocks at random:       ');
  71.    Start := Clock;
  72.    FOR L := 1000 DOWNTO 1 DO BEGIN
  73.       Choice := Random (L)+1;
  74.       K := Permutation [Choice];
  75.       Permutation [Choice] := Permutation [L];
  76.       FreeMem (BlkPtr [K], BlkSize [K]);
  77.    END;
  78.    Delta := Clock - Start - LoopTime2;
  79.    Inc (TotalTime, Delta);
  80.    WriteLn (Delta:5, ' ms');
  81.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  82.    Write ('Allocating 1000 blocks at the end of the heap: ');
  83.    Start := Clock;
  84.    FOR L := 1 TO 1000 DO BEGIN
  85.       GetMem (BlkPtr [L], BlkSize [L]);
  86.    END;
  87.    Delta := Clock-Start-LoopTime;
  88.    Inc (TotalTime, Delta);
  89.    WriteLn (Delta:5, ' ms');
  90.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  91.    FOR L := 1 TO 1000 DO BEGIN
  92.       Permutation [L] := L;
  93.    END;
  94.    Start := Clock;
  95.    FOR L := 1000 DOWNTO 1 DO BEGIN
  96.       Choice := Random (L)+1;
  97.       K := Permutation [Choice];
  98.       T:= Permutation [L];
  99.       Permutation [L] := Permutation [Choice];
  100.       Permutation [Choice] := T;
  101.    END;
  102.    LoopTime2 := Clock - Start;
  103.    FOR L := 1 TO 1000 DO BEGIN
  104.       Permutation [L] := L;
  105.    END;
  106.    Write ('Deallocating 500 blocks at random:             ');
  107.    Start := Clock;
  108.    FOR L := 1000 DOWNTO 501 DO BEGIN
  109.       Choice := Random (L)+1;
  110.       K := Permutation [Choice];
  111.       T:= Permutation [L];
  112.       Permutation [L] := Permutation [Choice];
  113.       Permutation [Choice] := T;
  114.       SYSTEM.FreeMem (BlkPtr [K], BlkSize [K]);
  115.    END;
  116.    Delta := Clock-Start-LoopTime2;
  117.    Inc (TotalTime, Delta);
  118.    WriteLn (Delta:5, ' ms');
  119.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  120.    Start := Clock;
  121.    FOR L := 1 TO 1000 DO BEGIN
  122.       Dummy := MaxAvail;
  123.    END;
  124.    Delta := Clock-Start;
  125.    Inc (TotalTime, (Delta + 5) DIV 10);
  126.    WriteLn ('1000 calls to MaxAvail:                        ', Delta:5, ' ms');
  127.    Start := Clock;
  128.    FOR L := 1 TO 1000 DO BEGIN
  129.       Dummy := MemAvail;
  130.    END;
  131.    Delta := Clock - Start;
  132.    Inc (TotalTime, (Delta + 5) DIV 10);
  133.    WriteLn ('1000 calls to MemAvail:                        ', Delta:5, ' ms');
  134.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  135.    Write ('Reallocating deallocated 500 blocks at random: ');
  136.    Start := Clock;
  137.    FOR L := 501 TO 1000 DO BEGIN
  138.       GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
  139.    END;
  140.    Delta := Clock-Start-LoopTime;
  141.    Inc (TotalTime, Delta);
  142.    WriteLn (Delta:5, ' ms');
  143.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  144.    Write ('Deallocating all 1000 blocks at random:        ');
  145.    Start := Clock;
  146.    FOR L := 1000 DOWNTO 1 DO BEGIN
  147.       FreeMem (BlkPtr [L], BlkSize [L]);
  148.    END;
  149.    Delta := Clock-Start-LoopTime;
  150.    Inc (TotalTime, Delta);
  151.    WriteLn (Delta:5, ' ms');
  152.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  153.    WriteLn;
  154.    WriteLn ('Total time for benchmark: ', TotalTime, ' ms');
  155. END.
  156.  
  157.  
  158.  
  159.