Chip 2002 June/Chip_2002-06_cd1.bin/zkuste/delphi/nastroje/d23456/PRODEL.ZIP/PROTMAIN.PAS

Pascal/Delphi Source File | 2001-05-05 | 9.2 KB | 370 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, Procal;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    f0: TLabel;
    f0d: TLabel;
    f100: TLabel;
    f1000: TLabel;
    f100d: TLabel;
    f1000d: TLabel;
    Bevel1: TBevel;
    Label20: TLabel;
    prom: TLabel;
    promd: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Bevel2: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel8: TBevel;
    Bevel9: TBevel;
    Bevel10: TBevel;
    Bevel11: TBevel;
    Label8: TLabel;
    tmlf: TLabel;
    tmlfd: TLabel;
    Label9: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label2: TLabel;
    Bevel3: TBevel;
    Label3: TLabel;
    prouse: TLabel;
    proused: TLabel;
    Label14: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label21: TLabel;
    f0ds: TLabel;
    f100ds: TLabel;
    f1000ds: TLabel;
    f0s: TLabel;
    f100s: TLabel;
    f1000s: TLabel;
    tmlfs: TLabel;
    tmlfds: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    procedure StartItAll(Sender: TObject);
  private
    { Private-Deklarationen }
    FUNCTION  MBox : TMyLargeInteger;
    PROCEDURE UserMessage ( VAR Message ); Message WM_USER+5;
  private
    res     : Array[0..5] OF TMyLargeInteger;
    resstr  : Array[0..5] OF String;
    resstr2 : Array[0..5] OF String;

  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;
  ta     : TMyLargeInteger;
  tsum   : TMyLargeInteger;

FUNCTION TForm1.MBox : 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);
//  MessageBoxSimu(0, 'Messagebox demo, waiting for click should not be measured',
//                    'Protest', MB_OK);
// In the program protest2 you will find here MessageBox, it is here at the end
// of the procedure, in order not to be measured. A good profiler
// 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 continued after returning from
// MessageBox. That's why this procedure shouldn't be measured.
  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;
  MessageBox(0, 'Messagebox demo, waiting for click should not be measured',
                'Protest', MB_OK);
END;

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;

  i := 0;
  WHILE i < 100000 DO
    INC(i);

  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[5].quadpart := tsum.quadpart;
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 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;

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]) < 3 THEN BEGIN
      MHZes := MHZTab[i];
      break;
    END;
  END;
END;

procedure TForm1.StartItAll(Sender: TObject);
VAR
  i, x     : Integer;
  xd       : Double;
  Ergebnis : Integer;
  resstrs  : Array[0..5] OF String;
  resstr2s : Array[0..5] OF String;
begin
  EstimateMHZ;
  QPCAss  := GetAssemblerQPC;

  FOR i := 0 TO 5 DO
    res[i].quadpart := 0;

  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[3].lowpart := res[3].lowpart + TopFunction(Ergebnis).lowpart;

  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[2].lowpart := res[2].lowpart + FunctionWith1000(Ergebnis).lowpart;

  Ergebnis := 0;
  FOR i := 1 TO 200 DO
    res[1].lowpart := res[1].lowpart + FunctionWith100(Ergebnis).lowpart;

  res[4].lowpart := res[4].lowpart + MBox.lowpart;

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

  f0.caption     := '0';
  f100.caption   := resstr[1];
  f1000.caption  := resstr[2];
  tmlf.caption   := resstr[3];
  prom.caption   := resstr[4];
  prouse.caption := resstr[5];

  f0s.caption    := '0';
  f100s.caption  := resstrs[1];
  f1000s.caption := resstrs[2];
  tmlfs.caption  := resstrs[3];

  f0d.caption     := '0.000 ╡S';
  f0d.caption     := resstr2[0];
  f100d.caption   := resstr2[1];
  f1000d.caption  := resstr2[2];
  tmlfd.caption   := resstr2[3];
  promd.caption   := resstr2[4];
  proused.caption := resstr2[5];

  f0ds.caption   := '0.000 ╡S';
  f0ds.caption   := resstr2s[0];
  f100ds.caption := resstr2s[1];
  f1000ds.caption:= resstr2s[2];
  tmlfds.caption := resstr2s[3];
end;

end.