PC Pro 2/PcPro-2a.iso/Demos/ProDelph/PROTMAIN.PAS

Pascal/Delphi Source File | 2000-01-05 | 16.3 KB | 632 lines

//PROFILE-NO
unit protmain;
{$O-}  // Do not remove! Delphi might crash !!!!
{$R-}
{$Q-}
{$A+}

interface

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

TYPE
{$IFDEF VER120 }
  TMyComp  = Int64;
{$ELSE }
  {$IFDEF VER130 }
    TMyComp  = Int64;
  {$ELSE }
    TMyComp  = Comp;
  {$ENDIF }
{$ENDIF }
  TMyLargeInteger = RECORD
                    CASE Byte OF
                     0 : ( LowPart  : DWORD; HighPart : LongInt );
                     1 : ( QuadPart : TMyComp );
                  END;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    f0: TLabel;
    f0d: TLabel;
    f10: TLabel;
    f10d: TLabel;
    f100: TLabel;
    f1000: TLabel;
    f10000: TLabel;
    f100d: TLabel;
    f1000d: TLabel;
    f10000d: TLabel;
    Bevel1: TBevel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    pmam: TLabel;
    prom: TLabel;
    pmamd: TLabel;
    promd: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Bevel8: TBevel;
    Bevel9: TBevel;
    Bevel10: TBevel;
    Bevel11: TBevel;
    Label8: TLabel;
    Bevel12: TBevel;
    tmlf: TLabel;
    tmlfd: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label21: TLabel;
    Bevel13: TBevel;
    recu: TLabel;
    recud: TLabel;
    Label24: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    procedure StartItAll(Sender: TObject);
  private
    { Private-Deklarationen }
    PROCEDURE UserMessage ( VAR Message ); Message WM_USER+5;
    FUNCTION  PostIt : TMyLargeInteger;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

CONST
  MHZ1 = 0; MHZn = 28;
  MHzTab : Array[MHZ1..MHZn] OF Word =
          (33, 40, 50, 66, 75, 83, 90, 100, 120, 133, 150, 166, 180, 200, 233,
           266, 300, 333, 350, 366, 380, 400, 433, 450, 466, 500, 533, 550, 600 );

VAR
  MHZes  : Double;
  QPCAss : TMyLargeInteger; // Time used for PRTSC + mov + mov

PROCEDURE EstimateMHz ;
VAR
  mega         : Double;
  takte        : TMyLargeInteger;
  dauer        : TMyLargeInteger;
  i            : Integer;
  tickx        : LongInt;
  tick1, tick2 : LongInt;
  startt, endt : TMyLargeInteger;
BEGIN
  startt.QuadPart := 0;
  dauer.quadpart  := 0;
  tick1 := GetTickCount;
  REPEAT
    tick2 := GetTickCount;
  UNTIL tick2 <> tick1;

  REPEAT
    tick1 := GetTickCount;
  UNTIL tick2 <> tick1;

  asm
    DW 310FH;
    mov startt.lowpart,eax
    mov startt.highpart,edx
  end;
  tickx := tick1;

  FOR i := 1 TO 66 DO BEGIN
    tick2 := tick1;
    REPEAT
      tick1 := GetTickCount;
    UNTIL tick1 <> tick2;
  END;
  asm
    DW 310FH;
    mov endt.lowpart,eax
    mov endt.highpart,edx
  end;

  dauer.lowpart  := tick1 - tickx ;
  takte.quadpart := endt.quadpart - startt.quadpart - QPCAss.QuadPart - QPCAss.QuadPart;
  mega := takte.quadpart;
  mega := mega / dauer.lowpart / 1000;
  MHZes := Trunc(mega);

  FOR i := MHZ1 TO MHZn DO BEGIN
    IF Abs(MHZes - MHZTab[i]) < 5 THEN BEGIN
      MHZes := MHZTab[i];
      break;
    END;
  END;
END;

PROCEDURE ConvertTime ( VAR wertstr : String; wert : Double; AsCycles : Boolean );
VAR
  einheit : String;
BEGIN
  IF AsCycles = TRUE THEN BEGIN
    Str(wert:0:0, einheit);
    wertstr := '';
    WHILE Length(einheit) > 3 DO BEGIN
      wertstr := ',' + Copy(einheit, Length(einheit)-2, 3) + wertstr;
      einheit := Copy(einheit, 1, Length(einheit)-3);
    END;
    wertstr := einheit + wertstr;
    exit;
  END;
  wert := wert / MHZes;
  IF wert < 1000.0 THEN BEGIN       { < 1 ms -> micro sec}
    einheit := ' ╡S';
    END
  ELSE BEGIN
    IF wert < 1000000.0 THEN BEGIN  { < 1 sec -> milli sec }
      wert := wert / 1000;
      einheit := ' ms';
      END
    ELSE BEGIN
      wert := wert / 1000000.0;     { nano sec -> sec }
      IF wert < 60.0 THEN BEGIN
        einheit := '  s ';
        END
      ELSE BEGIN
        wert := wert / 60.0;        { sec -> min }
        einheit := '  m ';
        IF wert > 60 THEN BEGIN
          wert := wert / 60.0;      { min -> std }
          einheit := '  h ';
        END;
      END;
    END;
  END;
  Str(wert:0:3, wertstr);
  wertstr := wertstr + einheit;
END;

FUNCTION MidFunction  : Integer; Forward;
FUNCTION DeepFunction  : Integer; Forward;

VAR
  res     : Array[0..10] OF TMyLargeInteger;
  ta      : TMyLargeInteger;
  tsum    : TMyLargeInteger;
  count   : Integer;
  resstr  : Array[0..10] OF String;
  resstr2 : Array[0..10] OF String;


PROCEDURE TForm1.UserMessage ( VAR Message );
VAR
  i : Integer;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;

  FOR i := 1 TO 1000 DO
    INC(count);

  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  res[7].lowpart := res[7].lowpart + tsum.lowpart;
END;

FUNCTION TForm1.PostIt : TMyLargeInteger;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;
  Result.lowpart  := 0;
  Result.highpart := 0;

  PostMessage(application.mainform.handle, WM_USER+5, 1, 2);
// In the program protest2 you will find here Application.ProcessMessages, it is
// here at the end of the procedure, in order not to be measured. A good rofiler
// stops measuring before entering that procedure. The reason is, that the
// current process, so to say, hands over the cpu to another process. E.g. that
// the current process is interrupted and contiued after returning from
// Application.ProcessMessages. That's why this procedure shouldn't be measured.
// Even Windows does not change to another process but continues the current one,
// which will be done in this example because we just posted a message to the
// main window, measurement must be stopped. The next executed procedure, in this
// example UserMessage or the default handler, is NOT a child procedure of this.
  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result.lowpart := tsum.lowpart;
  Application.ProcessMessages;
END;

FUNCTION Minimum ( a, b : TMyComp ) : TMyComp;
BEGIN
  IF a > b THEN
    Result := b
  ELSE
    Result := a;
END;

FUNCTION GetAssemblerQPC : TMyLargeInteger;
VAR
  n  : Integer;
  te : TMyLargeInteger;
  ts : TMyLargeInteger;
BEGIN
  Result.quadpart := 1000000000;
  FOR n := 1 TO 40 DO BEGIN
    // Until here a certain amount of instructions have been processed
    // The next instruction (PRTSC) gives how many
    asm
      DW 310FH;
      mov ts.lowpart,eax
      mov ts.highpart,edx
      // The next line results in how many cycles were used until here
      // ts - te : how many cycles were used by the previous 3 instruction or
      // by the next 3
      DW 310FH;
      mov te.lowpart,eax
      mov te.highpart,edx
    end;
    Result.quadpart := Minimum(Result.quadpart, ABS(te.Quadpart - ts.QuadPart));
  END;
END;

FUNCTION FunctionWith10( VAR index : Integer ) : TMyLargeInteger;
VAR
  i : Integer;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;
  Result.lowpart  := 0;
  Result.highpart := 0;

  FOR i := 1 TO 10 DO
    INC(Index);
  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result.lowpart := tsum.lowpart;
END;

FUNCTION FunctionWith100( VAR index : Integer ) : TMyLargeInteger;
VAR
  i : Integer;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;
  Result.lowpart  := 0;
  Result.highpart := 0;

  FOR i := 1 TO 100 DO
    INC(Index);

  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result.lowpart := tsum.lowpart;
END;

FUNCTION FunctionWith1000( VAR index : Integer ) : TMyLargeInteger;
VAR
  i : Integer;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;
  Result.lowpart  := 0;
  Result.highpart := 0;

  FOR i := 1 TO 1000 DO
    INC(Index);

  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result.lowpart := tsum.lowpart;
END;

FUNCTION FunctionWith10000( VAR index : Integer ) : TMyLargeInteger;
VAR
  i : Integer;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;
  Result.lowpart  := 0;
  Result.highpart := 0;

  FOR i := 1 TO 10000 DO
    INC(index);

  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result.lowpart := tsum.lowpart;
END;

FUNCTION TopFunction ( VAR index : Integer ) : TMyLargeInteger;
VAR
  i : Integer;
BEGIN
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;

  FOR i := 1 TO 10 DO
    index := MidFunction;
  Result.highpart := 0;
  Result.lowpart := 0;

  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result.lowpart := tsum.lowpart;
END;

FUNCTION MidFunction  : Integer;
VAR
  i : Integer;
BEGIN
  FOR i := 1 TO 10 DO
    Result := DeepFunction;
END;

FUNCTION DeepFunction : Integer;
BEGIN
  Result := 0;
END;

FUNCTION DoRecursion ( VAR HowOften : Integer ) : DWORD;
BEGIN
  DEC(HowOften);
  IF HowOften <= 0 THEN BEGIN
    Result := 0;
    exit;
  END;
  result := DoRecursion(HowOften);
END;

FUNCTION HeaderTime ( VAR HowOften : Integer ) : TMyLargeInteger;
BEGIN
END;

FUNCTION Recursion( VAR index : Integer ) : DWORD;
VAR
  i : Integer;
  h : TMyLargeInteger;
BEGIN
// Calculate how many cycles a function header uses. The measurement normally
// only measures the body of a function. This procedure measures one additional
// function header. So we must subtract the time for this.
  FOR i := 1 TO 40 DO
    HeaderTime(index);
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;
  HeaderTime(index);
  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov h.lowpart,eax
    mov h.highpart,edx
  end;
// Now we make the test for the recursive function
  asm
    DW 310FH;   // first PRTSC, get cycles before tested instruction
    mov ta.lowpart,eax
    mov ta.highpart,edx
  end;

  DoRecursion(index);

  asm
    DW 310FH;   // get cycles after tested instructions
    // Next lines calculate the no of cycles now - no of cycles before first PRTSC
    sub eax,ta.lowpart
    sbb edx,ta.highpart
    // Next lines subtract no of cycles for the first PRTSC + mov instructions
    sub eax,QPCAss.lowpart
    sbb edx,QPCAss.highpart
    // Next lines subtract no of cycles for additional function header
    sub eax,h.lowpart
    sbb edx,h.highpart
    // = No of cycles for the measured instructions
    // stored in tsum
    mov tsum.lowpart,eax
    mov tsum.highpart,edx
  end;
  result := tsum.lowpart;
END;

procedure TForm1.StartItAll(Sender: TObject);
VAR
  i, x     : Integer;
  xd       : Double;
  Ergebnis : Integer;
begin

  EstimateMHZ;

  QPCAss  := GetAssemblerQPC;
  FOR i := 0 TO 10 DO
    res[i].quadpart := 0;

  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[5].lowpart := res[5].lowpart + TopFunction(Ergebnis).lowpart;
  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[4].lowpart := res[4].lowpart + FunctionWith10000(Ergebnis).lowpart;
  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[3].lowpart := res[3].lowpart + FunctionWith1000(Ergebnis).lowpart;
  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[2].lowpart := res[2].lowpart + FunctionWith100(Ergebnis).lowpart;
  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[1].lowpart := res[1].lowpart + FunctionWith10(Ergebnis).lowpart;
  Ergebnis := 0;
  FOR i := 1 TO 200 DO BEGIN
    Ergebnis := 10;
    res[8].lowpart := res[8].lowPart + Recursion(Ergebnis);
  END;
  Ergebnis := 0;
  FOR i := 1 TO 200 DO BEGIN
    count := 0;
    res[6].lowpart := res[6].lowpart + PostIt.lowpart;
  END;

  FOR i := 0 TO 10 DO BEGIN
    x := res[i].lowpart;
    IF (i <> 8) AND (i <> 5) THEN
      x := x DIV 200;
    ConvertTime(resstr[i], x, TRUE);
    xd := Round(x);
    ConvertTime(resstr2[i], xd, FALSE);
  END;

  f0.caption  := '0';
  f10.caption := resstr[1];
  f100.caption := resstr[2];
  f1000.caption := resstr[3];
  f10000.caption := resstr[4];
  tmlf.caption := resstr[5];
  pmam.caption := resstr[6];
  prom.caption := resstr[7];
  recu.caption := resstr[8];

  f0d.caption  := '0.000 ╡S';
  f10d.caption := resstr2[1];
  f100d.caption := resstr2[2];
  f1000d.caption := resstr2[3];
  f10000d.caption := resstr2[4];
  tmlfd.caption := resstr2[5];
  pmamd.caption := resstr2[6];
  promd.caption := resstr2[7];
  recud.caption := resstr2[8];
end;

end.