home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue71 / Stack / WMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-04-19  |  7.2 KB  |  235 lines
  1. unit WMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   PSTimer,
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   StdCtrls, ExtCtrls;
  9.  
  10.  
  11. type
  12.   TFMain = class(TForm)
  13.     paBottom: TPanel;
  14.     btTest: TButton;
  15.     paMain: TPanel;
  16.     meOutput: TMemo;
  17.     btClear: TButton;
  18.     chMultipleThreads: TCheckBox;
  19.     btTrace: TButton;
  20.     procedure btTestClick(Sender: TObject);
  21.     procedure btClearClick(Sender: TObject);
  22.     procedure btTraceClick(Sender: TObject);
  23.   private
  24.     procedure WriteHeader;
  25.     procedure WriteTime( const msg : string; time : TTime ); overload;
  26.     procedure WriteRatio( const msg : string; time1, time2 : TTime );
  27.     procedure WriteLn( const msg : string = '' ); overload;
  28.   public
  29.   end;
  30.  
  31. procedure WriteLn( const msg : string = '' ); overload;
  32.  
  33. var
  34.   FMain: TFMain;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. uses
  41.   TraceableClass,
  42.   FastObjects;
  43.  
  44. const
  45.   COUNT = 1000;
  46.  
  47. var
  48.   intsInStack : array[0..COUNT-1] of TIntegerRec;
  49.   intsInFastStack : array[0..COUNT-1] of TFastIntegerRec;
  50.   intsInHeap  : array[0..COUNT-1] of TInteger;
  51.   ints : array[0..COUNT-1] of Integer;
  52.  
  53. procedure WriteLn( const msg : string = '' ); overload;
  54. begin
  55.   FMain.WriteLn( msg );
  56. end;
  57.  
  58. procedure TFMain.btTestClick(Sender: TObject);
  59. var
  60.   i : Integer;
  61.   counter          : TPSTimer;
  62.   stackCreateTime  : TTime;
  63.   stackFastCreateTime : TTime;
  64.   heapCreateTime   : TTime;
  65.   intCreateTime : TTime;
  66.   stackDestroyTime : TTime;
  67.   stackFastDestroyTime : TTime;
  68.   heapDestroyTime  : TTime;
  69.   intDestroyTime : TTime;
  70.   overhead : TTime;
  71. begin
  72.   // Simulate the effects of multiple threads in memory allocation and
  73.   // deallocation?
  74.   IsMultiThread := chMultipleThreads.Checked;
  75.  
  76.   // *************************************************************
  77.   // Calculate overhead
  78.   StartCount(counter);
  79.   for i := 0 to COUNT-1 do
  80.     ;
  81.   overhead := StopCount(counter);
  82.  
  83.   // *************************************************************
  84.   // Time construction
  85.   StartCount(counter);
  86.   for i := 0 to COUNT-1 do
  87.     CreateObject( intsInStack[i], i );
  88.   stackCreateTime := StopCount(counter) - overhead;
  89.   // Check that objects have been adequately created in the stack
  90.   for i := 0 to COUNT-1 do
  91.     Assert( GetObject(intsInStack[i]).Value = i );
  92.  
  93.   StartCount(counter);
  94.   for i := 0 to COUNT-1 do
  95.     CreateObject( intsInFastStack[i], i );
  96.   stackFastCreateTime := StopCount(counter) - overhead;
  97.   // Check that objects have been adequately created in the stack
  98.   for i := 0 to COUNT-1 do
  99.     Assert( GetObject(intsInFastStack[i]).Value = i );
  100.  
  101.   StartCount(counter);
  102.   for i := 0 to COUNT-1 do
  103.     intsInHeap[i] := TInteger.Create( i );
  104.   heapCreateTime := StopCount(counter) - overhead;
  105.  
  106.   // Time insteger "construction", that is, assignment
  107.   StartCount(counter);
  108.   for i := 0 to COUNT-1 do
  109.     ints[i] := i;
  110.   intCreateTime := StopCount(counter) - overhead;
  111.  
  112.   // *************************************************************
  113.   // Time destruction
  114.   StartCount(counter);
  115.   for i := 0 to COUNT-1 do
  116.     FreeObject(intsInStack[i]);
  117.   stackDestroyTime := StopCount(counter) - overhead;
  118.  
  119.   StartCount(counter);
  120.   for i := 0 to COUNT-1 do
  121.     FreeObject(intsInFastStack[i]);
  122.   stackFastDestroyTime := StopCount(counter) - overhead;
  123.  
  124.   StartCount(counter);
  125.   for i := 0 to COUNT-1 do
  126.     intsInHeap[i].Free;
  127.   heapDestroyTime := StopCount(counter) - overhead;
  128.  
  129.   intDestroyTime  := 0.0;
  130.  
  131.   // *************************************************************
  132.   // Report results
  133.   WriteHeader;
  134.   // Creation results
  135.   WriteLn( '-------------- CONSTRUCTION' );
  136.   WriteTime( 'Creation in stack', stackCreateTime );
  137.   WriteTime( 'Fast creation in stack', stackFastCreateTime );
  138.   WriteTime( 'Creation in heap', heapCreateTime );
  139.   WriteTime( 'Direct Integer assignment', intCreateTime );
  140.   WriteRatio( 'RATIO stack vs. heap',
  141.                stackCreateTime, heapCreateTime );
  142.   WriteRatio( 'RATIO fast stack vs. heap',
  143.                stackFastCreateTime, heapCreateTime );
  144.   WriteRatio( 'RATIO fast stack vs. direct int assignment',
  145.                stackFastCreateTime, intCreateTime );
  146.  
  147.   WriteLn( '-------------- DESTRUCTION' );
  148.   WriteTime( 'Destruction in stack', stackDestroyTime );
  149.   WriteTime( 'Fast destruction in stack', stackFastDestroyTime );
  150.   WriteTime( 'Destruction in heap', heapDestroyTime );
  151.   WriteRatio( 'RATIO stack vs. heap',
  152.                stackDestroyTime, heapDestroyTime );
  153.   WriteRatio( 'RATIO fast stack vs. heap',
  154.                stackFastDestroyTime, heapDestroyTime );
  155.   WriteLn( '-------------- OVERALL RESULTS' );
  156.   WriteTime( 'Fast Stack creation + dest.', stackFastCreateTime + stackFastDestroyTime );
  157.   WriteTime( 'Stack creation + destruction', stackCreateTime + stackDestroyTime );
  158.   WriteTime( 'Heap creation + destruction', heapCreateTime + heapDestroyTime );
  159.   WriteRatio( 'RATIO stack vs. heap', stackCreateTime + stackDestroyTime,
  160.                heapCreateTime + heapDestroyTime );
  161.   WriteRatio( 'RATIO fast stack vs. heap', stackFastCreateTime + stackFastDestroyTime,
  162.                heapCreateTime + heapDestroyTime );
  163.   WriteRatio( 'RATIO fast stack vs. direct int assignment',
  164.                stackFastCreateTime + stackFastDestroyTime, intCreateTime + intDestroyTime );
  165.   WriteLn( '------------------------------------------------------------------------------' );
  166.   WriteLn;
  167. end;
  168.  
  169. procedure TFMain.WriteRatio( const msg : string; time1, time2 : TTime );
  170. var
  171.   ratio : TTime;
  172. begin
  173.   ratio := time2 / time1;
  174.   if ratio >= 1.0 then
  175.     WriteLn( Format( '%s: %n times faster', [msg, ratio] ) )
  176.   else begin
  177.     ratio := time1 / time2;
  178.     WriteLn( Format( '%s: %n times slower', [msg, ratio] ) )
  179.   end;
  180. end;
  181.  
  182. procedure TFMain.WriteTime(const msg: string; time: TTime);
  183. var
  184.   opsPerSecond : TTime;
  185.   microSecs    : TTime;
  186.   cnt        : TTime;
  187. begin
  188.   opsPerSecond := COUNT*1.0/time;
  189.   cnt := COUNT;
  190.   microsecs := time*1000000.0;
  191.   WriteLn( Format( '%-30s %20.3n %10.0n %16n',
  192.                   [msg, microsecs, cnt, opsPerSecond] ) );
  193. end;
  194.  
  195. procedure TFMain.WriteHeader;
  196. begin
  197.   WriteLn( Format( 'Timer resolution: %10.6n microseconds', [TPSTimer.Resolution*1000000.0] ) );
  198.   WriteLn;
  199.   WriteLn( Format('%-30s %20s %10s %16s', ['Operation', 'Time (microsecs.)', 'Ops.', 'Ops./second' ]) );
  200.   WriteLn( '------------------------------------------------------------------------------' );
  201. end;
  202.  
  203. procedure TFMain.WriteLn(const msg: string);
  204. begin
  205.   meOutput.Lines.Add( msg );
  206. end;
  207.  
  208. procedure TFMain.btClearClick(Sender: TObject);
  209. begin
  210.   meOutput.Lines.Clear;
  211. end;
  212.  
  213. procedure TFMain.btTraceClick(Sender: TObject);
  214. begin
  215.   WriteLn( '--------- Successful construction' );
  216.   Trace( rpNone );
  217.  
  218.   WriteLn( '--------- Construction failed due to a NewInstance failure' );
  219.   Trace( rpNewInstance );
  220.  
  221.   WriteLn( '--------- Construction failed due to a Create failure' );
  222.   Trace( rpCreate );
  223.  
  224.   WriteLn( '--------- Construction failed due to a base class Create failure' );
  225.   Trace( rpBaseCreate );
  226.  
  227.   WriteLn( '--------- Construction failed due to an AfterConstruction failure' );
  228.   trace( rpAfterConstruction );
  229.  
  230.   WriteLn( '--------- Construction failed due to a base class AfterConstruction failure' );
  231.   Trace( rpBaseAfterConstruction );
  232. end;
  233.  
  234. end.
  235.