Delphi - RealTimeCPUCounter

program Project2;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

function RDTSC: Int64; // sollte UInt64 sein
// Liest den Time Stamp Counter der CPU 
asm 
       DW    0310Fh    // RDTSC Opcode, hier als DW f�r D3-D4
end; 

function IsRDTSCPresent: Boolean; 
// �berpr�ft ob der Time Stamp Counter durch die CPU unterst�tzt wird. 
// Extrahiert aus meinem Delphi Encryption Compendium. Es gelten die 
// Copyright aus dem DEC, Public Domain. 

  function HasRDTSC: Boolean; assembler; 
  asm 
       PUSH    EBX 
       PUSHFD 
       PUSHFD 
       POP     EAX 
       MOV     EDX,EAX 
       XOR     EAX,0040000h 
       PUSH    EAX 
       POPFD 
       PUSHFD 
       POP     EAX 
       XOR     EAX,EDX 
       JZ      @@1 
       PUSHFD 
       POP     EAX 
       MOV     EDX,EAX 
       XOR     EAX,0200000h 
       PUSH    EAX 
       POPFD 
       PUSHFD 
       POP     EAX 
       XOR     EAX,EDX 
@@1:   POPFD 
       TEST    EAX,EAX 
       JZ      @@2 
       MOV     EAX,1 
       DW      0A20Fh     // CPUID 
       TEST    EDX,010h   // test RDTSC flag in Features 
       SETNZ   AL 
@@2:   POP     EBX 
  end; 

begin 
// dieser Try Except Block ist absolut n�tig. 
// RDTSC kann eine privilegierte Instruktion sein, d.h. das OS kann jederzeit 
// so konfiguriert sein das es die CPU anweisst das RDTSC eine priviligierte 
// Instruktion ist. 
  try 
    Result := HasRDTSC;
    if Result then RDTSC; 
  except 
    Result := False; 
  end;
end; 

function CalcCPUFrequency(Rounds: Cardinal = 1): Int64; 
// Berechnet die CPU Taktfrequenz. Diese Funktion nutzt eine sehr exakte und schnelle Methode. 
// Relativ zu einem Referenztakt werden die Taktzyklen der CPU gez�hlt. 
// Danach wird �ber unseren Referenztakt und dessen Frequenz die Taktzyklen in 
// die CPU Taktfrequnz umgerechnet. Die genaueste Referenzquelle im Windows System 
// ist QueryPerformaceCounter() + QueryPerformanceFrequncy(). Beide werden durch 
// den Real Time Clock Chip der mit dem BIOS zusammenarbeitet erzeugt. 
// Auf den meisten Systemen arbeitet dieser mit einem Takt von 3.579.545 Hz = 3.6 MHz. 
// D.h. wir k�nnen mit dieser Funktion die CPU Taktfrequenz mit einer maximalen 
// Genauigkeit von 3.6 MHz errechnen. Sollte die CPU mit 1500MHz getaktet werden so 
// betr�gt die best m�gliche Genauigkeit +- 1500MHz/3.6MHz = +-417 Hz. 
// Die Me�methode selber ist unabh�nig vom Tasksheduler von Windows da relativ zu 
// zwei Frequenzen die unabh�nig von Tasksheduler sind gerechnet wird. 
// D.h. die L�nge der Me�dauer ist im Grunde unwichtig und kann sehr kurz gehalten werden. 

// Warum beschreibe ich das ?? 
// Weil es im WEB viele Sourcen gibt die eine Me�schleife per Sleep() oder GetTickCount() 
// aufbauen. Beide Methoden sind abh�ngig vom Tasksheduler und haben eine viel zu geringe 
// Genauigkeit. Die bestm�gliche Genauigkeit mit GetTickCount() und einer 1.5GHz CPU 
// liegt bei 1.500.000.000Hz / 1.000Hz = +-1.500.000 = +-1.5MHz. D.h. die Aufl�sung 
// mit GetTickCount = 1ms = 1000Hz ist 1.500.000 / 417 = 3.597 mal schlechter als 
// mit nachfolgender Methode. Die Aufl�sung bei Sleep() liegt bestenfalls bei 10ms, 
// also 10 mal schlechter als mit GetTickCount(). 

// Nat�rlich wird die theoretische Genauigkeit bei einer 1.5GHz CPU von +-417Hz nicht 
// erreicht. Im Durchschnitt liegt sie jedoch bei +- 2000Hz. 
// Rounds erh�ht die Genauigkeit, 100 macht es ~100 mal genauer, aber nur hypothetisch. 

// Probleme k�nnten mit den Int64 auftreten falls die CPU schon sehr lange l�uft. 
var 
  C,F,S,E,D,T: Int64; 
begin 
  if IsRDTSCPresent and QueryPerformanceFrequency(F) and QueryPerformanceCounter(S) then
  begin 
    C := F * (Rounds +1); 
    QueryPerformanceCounter(S); 
    D := RDTSC; 
    while C > 0 do Dec(C); 
    QueryPerformanceCounter(E); 
    T := RDTSC; 
    Result := Round((T - D) * F / (E - S)); 
  end else Result := 0; 
end; 

function CPUFrequency: Int64; 
// gibt die Takzyklen pro Sekunde zur�ck 
const 
  Frequency: Int64 = 0; 
begin 
  if Frequency = 0 then 
  begin 
    Frequency := CalcCPUFrequency;
    if Frequency = 0 then 
      raise Exception.Create('Kann CPU Frequenz nicht berechnen'); 
  end; 
  Result := Frequency; 
end;

function Secs(Cycles: Int64): Double; 
// rechnet Taktzyklen in Sekunden um 
begin 
  Result := Cycles / CPUFrequency; 
end; 

function Ticks(Cycles: Int64): Double; 
// rechnet Taktzyklen in Millisekunden um 
begin 
  Result := Cycles * 1000 / CPUFrequency; 
end; 

procedure Test; 
var 
  Start,Stop: Int64; 
  Tick: DWord; 
begin 
  WriteLn('CPU Taktfrequenz ist ', CPUFrequency/1000000.0:6:1, ' MHz'); 
  
  Tick := GetTickCount + 100; 

  Start := RDTSC; 
  while GetTickCount < Tick do ; 
  Stop := RDTSC; 

  WriteLn; 
  WriteLn('Testschleife dauerte: '); 
  WriteLn('Taktzyklen    : ', Stop - Start:10); 
  WriteLn('Millisekunden : ', Ticks(Stop - Start):10:2); 
  WriteLn('Sekunden      : ', Secs(Stop - Start):10:2); 

end;

begin
  Test();
  readln;
end.

Hagen Reddmann


2012-01-26T23:14:48 +0100, mail+homepage[at]michael-puff.de