home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / AEXMPSRC.RAR / MEMMGR / P5TIMER.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  3KB  |  121 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples  Version 2.1             █}
  4. {█      Implements high accuracy timer (Pentium Only)    █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1998-2000 vpascal.com              █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. {$Delphi+,H-,Use32+,G5+,Optimize+}
  11.  
  12. unit P5Timer;
  13.  
  14. interface
  15.  
  16. uses
  17.   SysUtils;
  18.  
  19. type
  20.   TQWord = Comp;
  21.  
  22. const
  23.   // Modify this line to contain actual CPU speed
  24.   CPUSpeed : TQWord = 400e6;
  25.  
  26. function tmCPUTicks: TQWord;
  27.   // Get number of CPU ticks since machine was booted
  28.  
  29. function tmSecsElapsed(_Tick1, _Tick2: TQWord): Double;
  30.   // Get difference between tick counts in milli-seconds
  31.  
  32. function tmElapsed(_Timer: Integer): Double;
  33.   // Return current elapsed time in msecs
  34.  
  35. procedure tmStart(_Timer: Integer);
  36.   // Start a timer
  37.  
  38. procedure tmPause(_Timer: Integer);
  39.   // Pause a timer
  40.  
  41. function tmStop(_Timer: Integer): String;
  42.   // Stop a timer; return elapsed time/msec as a formatted string
  43.  
  44. function tmElapsedStr(_Timer: Integer): String;
  45.   // Return current elapsed time/msec as a formatted string
  46.  
  47. implementation
  48.  
  49. const
  50.   cTimers = 4;
  51.   lStart:   array[1..cTimers] of TQWord  = (0, 0, 0, 0);
  52.   lElapsed: array[1..cTimers] of TQWord  = (0, 0, 0, 0);
  53.   lPaused:  array[1..cTimers] of Boolean = (True, True, True, True);
  54.  
  55. procedure tmStart(_Timer: Integer);
  56. begin
  57.   asm
  58.     push eax
  59.   end;
  60.   lPaused[_Timer] := False;
  61.   lStart[_Timer]  := tmCPUTicks;
  62.   asm
  63.     pop eax
  64.   end;
  65. end;
  66.  
  67. procedure tmPause(_Timer: Integer);
  68. begin
  69.   asm
  70.     push eax
  71.   end;
  72.   lPaused[_Timer]  := True;
  73.   lElapsed[_Timer] := lElapsed[_Timer] + tmCPUTicks - lStart[_Timer];
  74.   asm
  75.     pop eax
  76.   end;
  77. end;
  78.  
  79. function tmElapsed(_Timer: Integer): Double;
  80. var
  81.   Ticks: TQWord;
  82. begin
  83.   if lPaused[_Timer] then
  84.     Ticks := lElapsed[_Timer]
  85.   else
  86.     Ticks := lElapsed[_Timer] + tmCPUTicks - lStart[_Timer];
  87.   Result := 1000*Ticks/CPUSpeed;
  88. end;
  89.  
  90. function tmElapsedStr(_Timer: Integer): String;
  91. begin
  92.   Str(tmElapsed(_Timer):10:2, Result);
  93. end;
  94.  
  95. function tmStop(_Timer: Integer): String;
  96. begin
  97.   Result := tmElapsedStr(_Timer);
  98.   lElapsed[_Timer] := 0;
  99. end;
  100.  
  101. function tmCPUTicks: TQWord; assembler; {&frame-} {&uses ecx,edx}
  102. asm
  103.   push   0
  104.   push   0
  105.   mov    ecx,esp
  106.   rdtsc
  107.   mov    [ecx+4],edx
  108.   mov    [ecx],eax
  109.   fild   qword ptr [ecx]
  110.   pop    eax
  111.   pop    eax
  112. end;
  113.  
  114. function tmSecsElapsed(_Tick1, _Tick2: TQWord): Double;
  115. begin
  116.   Result := (Comp(_Tick2)-Comp(_Tick1)) / CPUSpeed;
  117. end;
  118.  
  119. end.
  120.  
  121.