Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/timetest/timer.pas

Pascal/Delphi Source File | 1995-12-22 | 5.4 KB | 212 lines

unit Timer;

interface
{  This is a simple program for comparing the execution time of two
   methods.

   test_0  is the setup method. Initialize any test arrays or
           conditions.

   test_1  is executed by the Test 1 button N Iteration times.

   test_2  is executed by the Test 2 button N Iteration times.

   Timing accuracy is +/- .055 seconds, so any test should exceed
   a second or two to be meaningful. Test 1 is often 1 tick faster
   than Test 2. I am guessing the events are handled in a consistent
   fashion relative to clock ticks, and so the start time for 1
   is closer to the last tick before it runs. Maybe.

   Do several tests in case there are hardware interrupts which
   might invalidate any single test.

   This is handy for comparing local vs global variables, near vs far
   calls, and implementation of parts of functions in assembler.

   I am new to Delphi, new to Windows, and new to Pascal, any tips
   or constructive criticism would be appreciated.

   Placed in the public domain, 1995 by Peter Jennings.

   Comments to [e-mail]

}

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Panel1: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Single: TLabel;
    Niter: TEdit;
    Plus: TButton;
    Minus: TButton;
    Exit: TButton;
    Test1: TButton;
    Test2: TButton;
    T1Addr: TLabel;
    T2Addr: TLabel;
    Single2: TLabel;
    Total: TLabel;
    Total2: TLabel;
    procedure ExitClick(Sender: TObject);
    procedure PlusClick(Sender: TObject);
    procedure MinusClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Test1Click(Sender: TObject);
    procedure Test2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  NIterations : LongInt;

  buf : array[0..8200] of char;

function HWToStr(w: Word): String;
procedure test_0;
procedure test_1;
procedure test_2;

function StrPosi(var Buffer;Size: word;S: string): integer;

implementation

{$R *.DFM}

procedure TForm1.ExitClick(Sender: TObject);
begin
   Close;
end;

procedure TForm1.PlusClick(Sender: TObject);
begin
   NIterations := StrtoInt( NIter.Text );
   if NIterations < 1000000000 then
      NIterations := NIterations * 10;
   NIter.Text := InttoStr(NIterations);
end;

procedure TForm1.MinusClick(Sender: TObject);
begin
   NIterations := StrtoInt( NIter.Text );
   NIterations := NIterations div 10;
   If NIterations < 1 then
      NIterations := 1;
   NIter.Text := InttoStr(NIterations);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   test_0;
   T1Addr.Caption := HWToStr(Seg(test_1)) +':'+ HWToStr(Ofs(test_1));
   T2Addr.Caption := HWToStr(Seg(test_2)) +':'+ HWToStr(Ofs(test_2));
end;

procedure TForm1.Test1Click(Sender: TObject);
var
  NIterations : LongInt;
  BeginTime   : TDateTime;
  ElapsedTime : double;
  i           : LongInt;
begin
  NIterations := StrtoInt( NIter.Text );
  Screen.Cursor := crHourGlass;
  Single.Caption := '- - - -';
  total.Caption  := '- - - -';
  Application.ProcessMessages;
  BeginTime := Now;
  for i := 1 to NIterations do
  begin
    Test_1;
  end;
  ElapsedTime := ((Now - BeginTime) * 86400.0);
  total.Caption  := FloatToStrF(ElapsedTime, ffNumber, 4, 2);
  single.Caption := FloatToStrF(ElapsedTime/NIterations, ffNumber, 10,6);
  Screen.Cursor := crDefault;

end;

procedure TForm1.Test2Click(Sender: TObject);
var
  BeginTime   : TDateTime;
  ElapsedTime : double;
  i           : LongInt;
begin
  NIterations := StrtoInt( NIter.Text );
  Screen.Cursor := crHourGlass;
  Single2.Caption := '- - - -';
  total2.Caption  := '- - - -';
  Application.ProcessMessages;
  BeginTime := Now;
  for i := 1 to NIterations do
  begin
  test_2
  end;
  ElapsedTime := ((Now - BeginTime) * 86400.0);
  total2.Caption  := FloatToStrF(ElapsedTime, ffNumber, 4, 2);
  single2.Caption := FloatToStrF(ElapsedTime/NIterations, ffNumber, 10,6);
  Screen.Cursor := crDefault;

end;


function HWToStr(w: Word): string;
const
   hex: array [0..15] of Char ='0123456789ABCDEF';
var
   H : String;
begin
   HWToStr :=   hex[Hi(w) shr 4] + hex[Hi(w) and $F]
                + hex[Lo(w) shr 4] + hex[Lo(w) and $F];
end;

{ ----------------- place the test methods here ----------------------}

{ This example compares the execution time for a search of an 8K buffer
  using StrPos vs an assembler function. 11.48 vs 6.38 seconds for 12,500
  iterations on a 486/100 laptop.Your mileage may vary.}

procedure test_0;      { initialization for test }
var
i : integer;
begin
for i := low(buf) to high(buf) do buf[i] := char(random(26)+ord('a'));
StrCopy(buf+8000,'findme');
end;

procedure test_1;      { perform test 1 }
var
p : PChar;
begin
p := StrPos(buf, 'findme');
end;

procedure test_2;      { perform test 2 }
var
i : integer;
begin
i := StrPosi(buf,8200,'findme');
end;

function StrPosi(var Buffer;Size: word;S: string): integer;
begin
Inline($1E/$16/$1F/$C4/$BE/>buffer/$89/$FB/$8B/$8E/>size/$8D/$B6/>s+2/
       $8A/$86/>s+1/$8A/$96/>s/$84/$D2/$74/$23/$FE/$CA/$30/$F6/$29/$D1/
       $76/$1B/$FC/$F2/$AE/$75/$16/$85/$D2/$74/$0C/$51/$57/$56/$89/$D1/
       $F3/$A6/$5E/$5F/$59/$75/$EC/$89/$F8/$29/$D8/$EB/$02/$31/$C0/
       $89/$46/$FE/$1F)
end;


end.