home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 July / Chip_2000-07_cd.bin / sharewar / prodelph / PROTMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  2000-05-01  |  9KB  |  341 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.     f1000: TLabel;
  25.     f10000: TLabel;
  26.     f1000d: TLabel;
  27.     f10000d: 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.     procedure StartItAll(Sender: TObject);
  61.   private
  62.     { Private-Deklarationen }
  63.     FUNCTION  MBox : TMyLargeInteger;
  64.     PROCEDURE UserMessage ( VAR Message ); Message WM_USER+5;
  65.   private
  66.     res     : Array[0..5] OF TMyLargeInteger;
  67.     resstr  : Array[0..5] OF String;
  68.     resstr2 : Array[0..5] OF String;
  69.  
  70.   public
  71.     { Public-Deklarationen }
  72.   end;
  73.  
  74. var
  75.   Form1: TForm1;
  76.  
  77. implementation
  78.  
  79.  
  80. {$R *.DFM}
  81.  
  82. CONST
  83.   MHZ1 = 0; MHZn = 28;
  84.   MHzTab : Array[MHZ1..MHZn] OF Word =
  85.           (33, 40, 50, 66, 75, 83, 90, 100, 120, 133, 150, 166, 180, 200, 233,
  86.            266, 300, 333, 350, 366, 380, 400, 433, 450, 466, 500, 533, 550, 600 );
  87.  
  88. VAR
  89.   MHZes  : Double;
  90.   ta     : TMyLargeInteger;
  91.   tsum   : TMyLargeInteger;
  92.  
  93. FUNCTION TForm1.MBox : TMyLargeInteger;
  94. BEGIN
  95.   asm
  96.     DW 310FH;   // first PRTSC, get cycles before tested instruction
  97.     mov ta.lowpart,eax
  98.     mov ta.highpart,edx
  99.   end;
  100.   Result.lowpart  := 0;
  101.   Result.highpart := 0;
  102.  
  103.   PostMessage(application.mainform.handle, WM_USER+5, 1, 2);
  104. //  MessageBoxSimu(0, 'Messagebox demo, waiting for click should not be measured',
  105. //                    'Protest', MB_OK);
  106. // In the program protest2 you will find here MessageBox, it is here at the end
  107. // of the procedure, in order not to be measured. A good profiler
  108. // stops measuring before entering that procedure. The reason is, that the
  109. // current process, so to say, hands over the cpu to another process. E.g. that
  110. // the current process is interrupted and continued after returning from
  111. // MessageBox. That's why this procedure shouldn't be measured.
  112.   asm
  113.     DW 310FH;   // get cycles after tested instructions
  114.     // Next lines calculate the no of cycles now - no of cycles before first PRTSC
  115.     sub eax,ta.lowpart
  116.     sbb edx,ta.highpart
  117.     // Next lines subtract no of cycles for the first PRTSC + mov instructions
  118.     sub eax,QPCAss.lowpart
  119.     sbb edx,QPCAss.highpart
  120.     // = No of cycles for the measured instructions
  121.     // stored in tsum
  122.     mov tsum.lowpart,eax
  123.     mov tsum.highpart,edx
  124.   end;
  125.   result.lowpart := tsum.lowpart;
  126.   MessageBox(0, 'Messagebox demo, waiting for click should not be measured',
  127.                 'Protest', MB_OK);
  128. END;
  129.  
  130. PROCEDURE TForm1.UserMessage ( VAR Message );
  131. VAR
  132.   i : Integer;
  133. BEGIN
  134.   asm
  135.     DW 310FH;   // first PRTSC, get cycles before tested instruction
  136.     mov ta.lowpart,eax
  137.     mov ta.highpart,edx
  138.   end;
  139.  
  140.   i := 0;
  141.   WHILE i < 100000 DO
  142.     INC(i);
  143.  
  144.   asm
  145.     DW 310FH;   // get cycles after tested instructions
  146.     // Next lines calculate the no of cycles now - no of cycles before first PRTSC
  147.     sub eax,ta.lowpart
  148.     sbb edx,ta.highpart
  149.     // Next lines subtract no of cycles for the first PRTSC + mov instructions
  150.     sub eax,QPCAss.lowpart
  151.     sbb edx,QPCAss.highpart
  152.     // = No of cycles for the measured instructions
  153.     // stored in tsum
  154.     mov tsum.lowpart,eax
  155.     mov tsum.highpart,edx
  156.   end;
  157.   res[5].quadpart := tsum.quadpart;
  158. END;
  159.  
  160. PROCEDURE ConvertTime ( VAR wertstr : String; wert : Double; AsCycles : Boolean );
  161. VAR
  162.   einheit : String;
  163. BEGIN
  164.   IF AsCycles = TRUE THEN BEGIN
  165.     Str(wert:0:0, einheit);
  166.     wertstr := '';
  167.     WHILE Length(einheit) > 3 DO BEGIN
  168.       wertstr := ',' + Copy(einheit, Length(einheit)-2, 3) + wertstr;
  169.       einheit := Copy(einheit, 1, Length(einheit)-3);
  170.     END;
  171.     wertstr := einheit + wertstr;
  172.     exit;
  173.   END;
  174.   wert := wert / MHZes;
  175.   IF wert < 1000.0 THEN BEGIN       { < 1 ms -> micro sec}
  176.     einheit := ' ╡S';
  177.     END
  178.   ELSE BEGIN
  179.     IF wert < 1000000.0 THEN BEGIN  { < 1 sec -> milli sec }
  180.       wert := wert / 1000;
  181.       einheit := ' ms';
  182.       END
  183.     ELSE BEGIN
  184.       wert := wert / 1000000.0;     { nano sec -> sec }
  185.       IF wert < 60.0 THEN BEGIN
  186.         einheit := '  s ';
  187.         END
  188.       ELSE BEGIN
  189.         wert := wert / 60.0;        { sec -> min }
  190.         einheit := '  m ';
  191.         IF wert > 60 THEN BEGIN
  192.           wert := wert / 60.0;      { min -> std }
  193.           einheit := '  h ';
  194.         END;
  195.       END;
  196.     END;
  197.   END;
  198.   Str(wert:0:3, wertstr);
  199.   wertstr := wertstr + einheit;
  200. END;
  201.  
  202. FUNCTION Minimum ( a, b : TMyComp ) : TMyComp;
  203. BEGIN
  204.   IF a > b THEN
  205.     Result := b
  206.   ELSE
  207.     Result := a;
  208. END;
  209.  
  210. FUNCTION GetAssemblerQPC : TMyLargeInteger;
  211. VAR
  212.   n  : Integer;
  213.   te : TMyLargeInteger;
  214.   ts : TMyLargeInteger;
  215. BEGIN
  216.   Result.quadpart := 1000000000;
  217.   FOR n := 1 TO 40 DO BEGIN
  218.     // Until here a certain amount of instructions have been processed
  219.     // The next instruction (PRTSC) gives how many
  220.     asm
  221.       DW 310FH;
  222.       mov ts.lowpart,eax
  223.       mov ts.highpart,edx
  224.       // The next line results in how many cycles were used until here
  225.       // ts - te : how many cycles were used by the previous 3 instruction or
  226.       // by the next 3
  227.       DW 310FH;
  228.       mov te.lowpart,eax
  229.       mov te.highpart,edx
  230.     end;
  231.     Result.quadpart := Minimum(Result.quadpart, ABS(te.Quadpart - ts.QuadPart));
  232.   END;
  233. END;
  234.  
  235. PROCEDURE EstimateMHz ;
  236. VAR
  237.   mega         : Double;
  238.   takte        : TMyLargeInteger;
  239.   dauer        : TMyLargeInteger;
  240.   i            : Integer;
  241.   tickx        : LongInt;
  242.   tick1, tick2 : LongInt;
  243.   startt, endt : TMyLargeInteger;
  244. BEGIN
  245.   startt.QuadPart := 0;
  246.   dauer.quadpart  := 0;
  247.   tick1 := GetTickCount;
  248.   REPEAT
  249.     tick2 := GetTickCount;
  250.   UNTIL tick2 <> tick1;
  251.  
  252.   REPEAT
  253.     tick1 := GetTickCount;
  254.   UNTIL tick2 <> tick1;
  255.  
  256.   asm
  257.     DW 310FH;
  258.     mov startt.lowpart,eax
  259.     mov startt.highpart,edx
  260.   end;
  261.   tickx := tick1;
  262.  
  263.   FOR i := 1 TO 66 DO BEGIN
  264.     tick2 := tick1;
  265.     REPEAT
  266.       tick1 := GetTickCount;
  267.     UNTIL tick1 <> tick2;
  268.   END;
  269.   asm
  270.     DW 310FH;
  271.     mov endt.lowpart,eax
  272.     mov endt.highpart,edx
  273.   end;
  274.  
  275.   dauer.lowpart  := tick1 - tickx ;
  276.   takte.quadpart := endt.quadpart - startt.quadpart - QPCAss.QuadPart {- QPCAss.QuadPart};
  277.   mega := takte.quadpart;
  278.   mega := mega / dauer.lowpart / 1000;
  279.   MHZes := Trunc(mega);
  280.  
  281.   FOR i := MHZ1 TO MHZn DO BEGIN
  282.     IF Abs(MHZes - MHZTab[i]) < 3 THEN BEGIN
  283.       MHZes := MHZTab[i];
  284.       break;
  285.     END;
  286.   END;
  287. END;
  288.  
  289. procedure TForm1.StartItAll(Sender: TObject);
  290. VAR
  291.   i, x     : Integer;
  292.   xd       : Double;
  293.   Ergebnis : Integer;
  294. begin
  295.   EstimateMHZ;
  296.   QPCAss  := GetAssemblerQPC;
  297.  
  298.   FOR i := 0 TO 5 DO
  299.     res[i].quadpart := 0;
  300.  
  301.   Ergebnis := 0;
  302.   FOR i := 1 TO 200 DO
  303.     res[3].lowpart := res[3].lowpart + TopFunction(Ergebnis).lowpart;
  304.  
  305.   Ergebnis := 0;
  306.   FOR i := 1 TO 200 DO
  307.     res[2].lowpart := res[2].lowpart + FunctionWith10000(Ergebnis).lowpart;
  308.  
  309.   Ergebnis := 0;
  310.   FOR i := 1 TO 200 DO
  311.     res[1].lowpart := res[1].lowpart + FunctionWith1000(Ergebnis).lowpart;
  312.  
  313.   res[4].lowpart := res[4].lowpart + MBox.lowpart;
  314.  
  315.   FOR i := 0 TO 5 DO BEGIN
  316.     x := res[i].lowpart;
  317.     IF i < 4 THEN
  318.       x := x DIV 200;
  319.     ConvertTime(resstr[i], x, TRUE);
  320.     xd := Round(x);
  321.     ConvertTime(resstr2[i], xd, FALSE);
  322.   END;
  323.  
  324.   f0.caption     := '0';
  325.   f1000.caption  := resstr[1];
  326.   f10000.caption := resstr[2];
  327.   tmlf.caption   := resstr[3];
  328.   prom.caption   := resstr[4];
  329.   prouse.caption := resstr[5];
  330.  
  331.   f0d.caption     := '0.000 ╡S';
  332.   f0d.caption     := resstr2[0];
  333.   f1000d.caption  := resstr2[1];
  334.   f10000d.caption := resstr2[2];
  335.   tmlfd.caption   := resstr2[3];
  336.   promd.caption   := resstr2[4];
  337.   proused.caption := resstr2[5];
  338. end;
  339.  
  340. end.
  341.