for not having anything remotely similar to QueryPerformanceCounter.
*sigh*
RDTSC has *much* better precision (about 30 nanoseconds) while performance counter on most systems is bastardized timestamp counter (for compatibility purposes I assume) and is rounded up to granulation of about 400 nanoseconds.
Any CPU today outside of museum range has TSC invariancy meaning yes, you *can* use the counter safely, the frequency is stable and counyer is the same for all cores.
Code:
{$ifdef cpuarm}
function UsecDelta (ptsc: pqword): double; cdecl; //allegedly valid ANY Linux and ANY non-x86 CPU
var v: timeval;
begin
v:= ptimeval(ptsc)^;
fpgettimeofday(ptimeval(ptsc), NIL); //one microsecond resolution
{$push}
{$overflowchecks off}
{$rangechecks off}
Result:=
1000000.0 * longint(ptimeval(ptsc)^.tv_sec - v.tv_sec)
+ 1.0 * longint(ptimeval(ptsc)^.tv_usec - v.tv_usec);
{$pop}
if Result < 0.0 then Result:= 0.0;
end;
{$endif}
{$ifdef CPUX86_64}
function UsecDelta (ptsc: pqword): double; cdecl;
var q: qword;
begin
q:= ptsc^;
asm
rdtsc
shl rdx, 32
or rdx, rax
mov rax, qword[ptsc]
mov qword[rax], rdx
end ['rax', 'rdx'];
if q >= ptsc^ then q:=ptsc^ - 1;
Result:= (ptsc^ - q) * Mother^.Timer.RDTSCFactor;
end;
{$endif}
{$ifdef CPU386}
function UsecDelta (ptsc: pqword): double; cdecl;
var q: qword;
begin
q:= ptsc^;
asm
mov ecx, ptsc
rdtsc
mov [ecx], eax
mov [ecx + 4], edx
end ['ecx', 'eax', 'edx'];
if q >= ptsc^ then q:=ptsc^ - 1;
Result:= (ptsc^ - q) * Mother^.Timer.RDTSCFactor;
end;
{$endif}
{$ifndef cpuarm}
var
_PrevTscCheckSec: double = 0;
_PrevTsc: qword;
_tsc: qword;
function RecheckTSCFreq(period: double = TSCMeasuringInterval): longbool;
var
sec: double;
begin
try
sec:= Second();
if (sec - _PrevTscCheckSec) < period then Exit(false);
_tsc:= GetTimeStamp();
Result:= true;
if _tsc <= _prevTsc then Result:= false;
if Result then begin
Mother^.Timer.RDTSCFrequency:= (_tsc - _prevTSC) / (sec - _prevTscCheckSec);
Mother^.Timer.RdtscFactor:= 1000000.0 / Math.max(1.0, Mother^.Timer.RdtscFrequency);
end;
_prevTSC:= _tsc;
_PrevTscCheckSec:= sec;
except end;
end;
{$endif}
function GetTimeStamp: qword;
//is *also* used for hash generation, so requirement obligatory increase is vital
{$ifdef cpuarm}
var v: timeval;
begin
{$push}
{$overflowchecks off}
{$rangechecks off}
fpgettimeofday(@v, NIL); //one microsecond resolution
Result:= qword((int64(1000000) * int64(v.tv_sec)) + int64(v.tv_usec));
{$pop}
{$else cpuarm}
begin
{$ifdef cpu64}
//ONLY the rax register is free to access memory at addresses above 4Gb freely!
asm
rdtsc
shl rdx, 32
or rax, rdx
mov qword[Result], rax
end ['rax', 'rdx'];
{$else}
asm
rdtsc
mov dword[Result], eax
mov dword[Result + 4], edx
end ['eax', 'edx'];
{$endif}
{$endif cpuarm}
if Result <= PrevTimeStamp then begin
Result:=PrevTimeStamp + 1;
inc(PrevTimeStamp);
end
else
PrevTimeStamp:=Result;
end;
Bookmarks