home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / nastroje / d23456 / PRODEL.ZIP / PROTMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  2002-07-23  |  9KB  |  370 lines
  1. //PROFILE-NO
  2. unit Protmain;
  3. {$O-}  // Do not remove! Delphi might crash !!!!
  4. {$R-}
  5. {$Q-}              
  6. {$A+}
  7.  
  8. interface
  9.  
  10. uses
  11.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  12.   ExtCtrls, StdCtrls, Procal;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     Label1: TLabel;
  18.     Label4: TLabel;
  19.     Label5: TLabel;
  20.     Label6: TLabel;
  21.     Label7: TLabel;
  22.     f0: TLabel;
  23.     f0d: TLabel;
  24.     f100: TLabel;
  25.     f1000: TLabel;
  26.     f100d: TLabel;
  27.     f1000d: TLabel;
  28.     Bevel1: TBevel;
  29.     Label20: TLabel;
  30.     prom: TLabel;
  31.     promd: TLabel;
  32.     Label25: TLabel;
  33.     Label26: TLabel;
  34.     Bevel2: TBevel;
  35.     Bevel4: TBevel;
  36.     Bevel5: TBevel;
  37.     Bevel6: TBevel;
  38.     Bevel8: TBevel;
  39.     Bevel9: TBevel;
  40.     Bevel10: TBevel;
  41.     Bevel11: TBevel;
  42.     Label8: TLabel;
  43.     tmlf: TLabel;
  44.     tmlfd: TLabel;
  45.     Label9: TLabel;
  46.     Label12: TLabel;
  47.     Label13: TLabel;
  48.     Label15: TLabel;
  49.     Label16: TLabel;
  50.     Label17: TLabel;
  51.     Label2: TLabel;
  52.     Bevel3: TBevel;
  53.     Label3: TLabel;
  54.     prouse: TLabel;
  55.     proused: TLabel;
  56.     Label14: TLabel;
  57.     Label18: TLabel;
  58.     Label19: TLabel;
  59.     Label21: TLabel;
  60.     f0ds: TLabel;
  61.     f100ds: TLabel;
  62.     f1000ds: TLabel;
  63.     f0s: TLabel;
  64.     f100s: TLabel;
  65.     f1000s: TLabel;
  66.     tmlfs: TLabel;
  67.     tmlfds: TLabel;
  68.     Label30: TLabel;
  69.     Label31: TLabel;
  70.     procedure StartItAll(Sender: TObject);
  71.   private
  72.     { Private-Deklarationen }
  73.     FUNCTION  MBox : TMyLargeInteger;
  74.     PROCEDURE UserMessage ( VAR Message ); Message WM_USER+5;
  75.   private
  76.     res     : Array[0..5] OF TMyLargeInteger;
  77.     resstr  : Array[0..5] OF String;
  78.     resstr2 : Array[0..5] OF String;
  79.  
  80.   public
  81.     { Public-Deklarationen }
  82.   end;
  83.  
  84. var
  85.   Form1: TForm1;
  86.  
  87. implementation
  88.  
  89.  
  90. {$R *.dfm}
  91.  
  92. CONST
  93.   MHZ1 = 0; MHZn = 28;
  94.   MHzTab : Array[MHZ1..MHZn] OF Word =
  95.           (33, 40, 50, 66, 75, 83, 90, 100, 120, 133, 150, 166, 180, 200, 233,
  96.            266, 300, 333, 350, 366, 380, 400, 433, 450, 466, 500, 533, 550, 600 );
  97.  
  98. VAR
  99.   MHZes  : Double;
  100.   ta     : TMyLargeInteger;
  101.   tsum   : TMyLargeInteger;
  102.  
  103. FUNCTION TForm1.MBox : TMyLargeInteger;
  104. BEGIN
  105.   asm
  106.     DW 310FH;   // first PRTSC, get cycles before tested instruction
  107.     mov ta.lowpart,eax
  108.     mov ta.highpart,edx
  109.   end;
  110.   Result.lowpart  := 0;
  111.   Result.highpart := 0;
  112.  
  113.   PostMessage(application.mainform.handle, WM_USER+5, 1, 2);
  114. //  MessageBoxSimu(0, 'Messagebox demo, waiting for click should not be measured',
  115. //                    'Protest', MB_OK);
  116. // In the program protest2 you will find here MessageBox, it is here at the end
  117. // of the procedure, in order not to be measured. A good profiler
  118. // stops measuring before entering that procedure. The reason is, that the
  119. // current process, so to say, hands over the cpu to another process. E.g. that
  120. // the current process is interrupted and continued after returning from
  121. // MessageBox. That's why this procedure shouldn't be measured.
  122.   asm
  123.     DW 310FH;   // get cycles after tested instructions
  124.     // Next lines calculate the no of cycles now - no of cycles before first PRTSC
  125.     sub eax,ta.lowpart
  126.     sbb edx,ta.highpart
  127.     // Next lines subtract no of cycles for the first PRTSC + mov instructions
  128.     sub eax,QPCAss.lowpart
  129.     sbb edx,QPCAss.highpart
  130.     // = No of cycles for the measured instructions
  131.     // stored in tsum
  132.     mov tsum.lowpart,eax
  133.     mov tsum.highpart,edx
  134.   end;
  135.   result.lowpart := tsum.lowpart;
  136.   MessageBox(0, 'Messagebox demo, waiting for click should not be measured',
  137.                 'Protest', MB_OK);
  138. END;
  139.  
  140. PROCEDURE TForm1.UserMessage ( VAR Message );
  141. VAR
  142.   i : Integer;
  143. BEGIN
  144.   asm
  145.     DW 310FH;   // first PRTSC, get cycles before tested instruction
  146.     mov ta.lowpart,eax
  147.     mov ta.highpart,edx
  148.   end;
  149.  
  150.   i := 0;
  151.   WHILE i < 100000 DO
  152.     INC(i);
  153.  
  154.   asm
  155.     DW 310FH;   // get cycles after tested instructions
  156.     // Next lines calculate the no of cycles now - no of cycles before first PRTSC
  157.     sub eax,ta.lowpart
  158.     sbb edx,ta.highpart
  159.     // Next lines subtract no of cycles for the first PRTSC + mov instructions
  160.     sub eax,QPCAss.lowpart
  161.     sbb edx,QPCAss.highpart
  162.     // = No of cycles for the measured instructions
  163.     // stored in tsum
  164.     mov tsum.lowpart,eax
  165.     mov tsum.highpart,edx
  166.   end;
  167.   res[5].quadpart := tsum.quadpart;
  168. END;
  169.  
  170. PROCEDURE ConvertTime ( VAR wertstr : String; wert : Double; AsCycles : Boolean );
  171. VAR
  172.   einheit : String;
  173. BEGIN
  174.   IF AsCycles = TRUE THEN BEGIN
  175.     Str(wert:0:0, einheit);
  176.     wertstr := '';
  177.     WHILE Length(einheit) > 3 DO BEGIN
  178.       wertstr := ',' + Copy(einheit, Length(einheit)-2, 3) + wertstr;
  179.       einheit := Copy(einheit, 1, Length(einheit)-3);
  180.     END;
  181.     wertstr := einheit + wertstr;
  182.     exit;
  183.   END;
  184.   wert := wert / MHZes;
  185.   IF wert < 1000.0 THEN BEGIN       { < 1 ms -> micro sec}
  186.     einheit := ' ╡S';
  187.     END
  188.   ELSE BEGIN
  189.     IF wert < 1000000.0 THEN BEGIN  { < 1 sec -> milli sec }
  190.       wert := wert / 1000;
  191.       einheit := ' ms';
  192.       END
  193.     ELSE BEGIN
  194.       wert := wert / 1000000.0;     { nano sec -> sec }
  195.       IF wert < 60.0 THEN BEGIN
  196.         einheit := '  s ';
  197.         END
  198.       ELSE BEGIN
  199.         wert := wert / 60.0;        { sec -> min }
  200.         einheit := '  m ';
  201.         IF wert > 60 THEN BEGIN
  202.           wert := wert / 60.0;      { min -> std }
  203.           einheit := '  h ';
  204.         END;
  205.       END;
  206.     END;
  207.   END;
  208.   Str(wert:0:3, wertstr);
  209.   wertstr := wertstr + einheit;
  210. END;
  211.  
  212. FUNCTION Minimum ( a, b : TMyComp ) : TMyComp;
  213. BEGIN
  214.   IF a > b THEN
  215.     Result := b
  216.   ELSE
  217.     Result := a;
  218. END;
  219.  
  220. FUNCTION GetAssemblerQPC : TMyLargeInteger;
  221. VAR
  222.   n  : Integer;
  223.   te : TMyLargeInteger;
  224.   ts : TMyLargeInteger;
  225. BEGIN
  226.   Result.quadpart := 1000000000;
  227.   FOR n := 1 TO 40 DO BEGIN
  228.     // Until here a certain amount of instructions have been processed
  229.     // The next instruction (PRTSC) gives how many
  230.     asm
  231.       DW 310FH;
  232.       mov ts.lowpart,eax
  233.       mov ts.highpart,edx
  234.       // The next line results in how many cycles were used until here
  235.       // ts - te : how many cycles were used by the previous 3 instruction or
  236.       // by the next 3
  237.       DW 310FH;
  238.       mov te.lowpart,eax
  239.       mov te.highpart,edx
  240.     end;
  241.     Result.quadpart := Minimum(Result.quadpart, ABS(te.Quadpart - ts.QuadPart));
  242.   END;
  243. END;
  244.  
  245. PROCEDURE EstimateMHz ;
  246. VAR
  247.   mega         : Double;
  248.   takte        : TMyLargeInteger;
  249.   dauer        : TMyLargeInteger;
  250.   i            : Integer;
  251.   tickx        : LongInt;
  252.   tick1, tick2 : LongInt;
  253.   startt, endt : TMyLargeInteger;
  254. BEGIN
  255.   startt.QuadPart := 0;
  256.   dauer.quadpart  := 0;
  257.   tick1 := GetTickCount;
  258.   REPEAT
  259.     tick2 := GetTickCount;
  260.   UNTIL tick2 <> tick1;
  261.  
  262.   REPEAT
  263.     tick1 := GetTickCount;
  264.   UNTIL tick2 <> tick1;
  265.  
  266.   asm
  267.     DW 310FH;
  268.     mov startt.lowpart,eax
  269.     mov startt.highpart,edx
  270.   end;
  271.   tickx := tick1;
  272.  
  273.   FOR i := 1 TO 66 DO BEGIN
  274.     tick2 := tick1;
  275.     REPEAT
  276.       tick1 := GetTickCount;
  277.     UNTIL tick1 <> tick2;
  278.   END;
  279.   asm
  280.     DW 310FH;
  281.     mov endt.lowpart,eax
  282.     mov endt.highpart,edx
  283.   end;
  284.  
  285.   dauer.lowpart  := tick1 - tickx ;
  286.   takte.quadpart := endt.quadpart - startt.quadpart - QPCAss.QuadPart {- QPCAss.QuadPart};
  287.   mega := takte.quadpart;
  288.   mega := mega / dauer.lowpart / 1000;
  289.   MHZes := Trunc(mega);
  290.  
  291.   FOR i := MHZ1 TO MHZn DO BEGIN
  292.     IF Abs(MHZes - MHZTab[i]) < 3 THEN BEGIN
  293.       MHZes := MHZTab[i];
  294.       break;
  295.     END;
  296.   END;
  297. END;
  298.  
  299. procedure TForm1.StartItAll(Sender: TObject);
  300. VAR
  301.   i, x     : Integer;
  302.   xd       : Double;
  303.   Ergebnis : Integer;
  304.   resstrs  : Array[0..5] OF String;
  305.   resstr2s : Array[0..5] OF String;
  306. begin
  307.   EstimateMHZ;
  308.   QPCAss  := GetAssemblerQPC;
  309.  
  310.   FOR i := 0 TO 5 DO
  311.     res[i].quadpart := 0;
  312.  
  313.   Ergebnis := 0;
  314.   FOR i := 1 TO 100 DO
  315.     res[3].lowpart := res[3].lowpart + TopFunction(Ergebnis).lowpart;
  316.  
  317.   Ergebnis := 0;
  318.   FOR i := 1 TO 100 DO
  319.     res[1].lowpart := res[1].lowpart + FunctionWith100(Ergebnis, 100).lowpart;
  320.  
  321.   Ergebnis := 0;
  322.   FOR i := 1 TO 100 DO
  323.     res[2].lowpart := res[2].lowpart + FunctionWith1000(Ergebnis, 1000).lowpart;
  324.  
  325.   res[4].lowpart := res[4].lowpart + MBox.lowpart;
  326.  
  327.   FOR i := 0 TO 5 DO BEGIN
  328.     x := res[i].lowpart;
  329.     IF i < 4 THEN
  330.       x := x DIV 100;
  331.     ConvertTime(resstr[i], x, TRUE);
  332.     xd := Round(x);
  333.     ConvertTime(resstr2[i], xd, FALSE);
  334.     IF i < 4 THEN BEGIN
  335.       x := res[i].lowpart;
  336.       ConvertTime(resstrs[i], x, TRUE);
  337.       xd := Round(x);
  338.       ConvertTime(resstr2s[i], xd, FALSE);
  339.     END;
  340.   END;
  341.  
  342.   f0.caption     := '0';
  343.   f100.caption   := resstr[1];
  344.   f1000.caption  := resstr[2];
  345.   tmlf.caption   := resstr[3];
  346.   prom.caption   := resstr[4];
  347.   prouse.caption := resstr[5];
  348.  
  349.   f0s.caption    := '0';
  350.   f100s.caption  := resstrs[1];
  351.   f1000s.caption := resstrs[2];
  352.   tmlfs.caption  := resstrs[3];
  353.  
  354.   f0d.caption     := '0.000 ╡S';
  355.   f0d.caption     := resstr2[0];
  356.   f100d.caption   := resstr2[1];
  357.   f1000d.caption  := resstr2[2];
  358.   tmlfd.caption   := resstr2[3];
  359.   promd.caption   := resstr2[4];
  360.   proused.caption := resstr2[5];
  361.  
  362.   f0ds.caption   := '0.000 ╡S';
  363.   f0ds.caption   := resstr2s[0];
  364.   f100ds.caption := resstr2s[1];
  365.   f1000ds.caption:= resstr2s[2];
  366.   tmlfds.caption := resstr2s[3];
  367. end;
  368.  
  369. end.
  370.