Хоть завалящий таймер высокого (можно не очень) разрешения? Ну хоть до милисекундной точности?
А?
З.Ы. В арме я полный нуб
Модератор: Модераторы
pi@raspberrypi:~/tmp $ ./test_timers now
Testing the Now() function (cross/platform, ported from Delphi)...
0ms: 0
1ms: 1001
Total changes: 1001, cycles: 318806
The milisecond grid is too coarse! Measuring microseconds...
1000us: 1001
Total changes: 1001, cycles: 323298
pi@raspberrypi:~/tmp $ ./test_timers gtod
Testing the gettimeofday() function...
0ms: 0
1ms: 1001
Total changes: 1001, cycles: 1201564
The milisecond grid is too coarse! Measuring microseconds...
1us: 984382
2us: 1643
3us: 15
4us: 1
6us: 1
9us: 59
10us: 304
11us: 265
12us: 66
13us: 48
14us: 31
15us: 27
16us: 11
17us: 4
18us: 48
19us: 31
20us: 5
21us: 4
22us: 8
23us: 1
24us: 2
25us: 4
26us: 4
27us: 2
28us: 2
29us: 4
30us: 2
31us: 2
32us: 1
33us: 1
35us: 2
37us: 1
38us: 1
41us: 1
42us: 1
44us: 1
45us: 1
48us: 1
49us: 2
51us: 1
55us: 1
59us: 1
74us: 1
89us: 1
Total changes: 986994, cycles: 1202333
pi@raspberrypi:~/tmp $ ./test_timers cgt
Testing the clock_gettime() function...
Trying CLOCK_PROCESS_CPUTIME_ID... 0s, 1ns.
0ms: 0
1ms: 1001
Total changes: 1001, cycles: 502762
The milisecond grid is too coarse! Measuring microseconds...
2us: 293599
3us: 134160
4us: 832
5us: 789
6us: 166
7us: 7
13us: 2
14us: 2
15us: 1
16us: 2
17us: 40
18us: 23
19us: 10
20us: 2
21us: 4
22us: 1
23us: 1
25us: 2
26us: 1
27us: 1
31us: 1
34us: 1
35us: 1
37us: 1
43us: 1
46us: 1
58us: 1
59us: 1
Total changes: 429653, cycles: 429654
{$mode objfpc}
{$longstrings on}
{$apptype console}
{$coperators on}
program test_timers;
uses sysutils, classes, math
{$ifdef windows} , windows {$endif}
{$ifdef unix} , baseunix, unix
{$ifdef linux}, linux {$endif}
{$endif}
;
var what: string;
{$ifdef windows}
type
MMRESULT = UINT;
const
TIMERR_NOERROR = 0;
function timeBeginPeriod(x1: UINT): MMRESULT; stdcall; external 'winmm.dll' name 'timeBeginPeriod';
function timeEndPeriod(x1: UINT): MMRESULT; stdcall; external 'winmm.dll' name 'timeEndPeriod';
{$endif}
procedure TestNow;
var
btime: TDateTime;
prev, current: TDateTime;
i, m: integer;
a: array[0..1000] of int64;
total, cycles: int64;
begin
WriteLn('Testing the Now() function (cross/platform, ported from Delphi)...');
FillChar(a, sizeof(a), 0);
btime:= Now();
cycles:=0;
repeat
current:= Now();
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(100, round((current - prev) * 86400000.0)))]);
prev:= current;
Inc(cycles);
until current > (btime + (1.0 / 86400.0));
m:= 1;
total:= 0;
for i:= 0 to 100 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
WriteLn(' ', i, 'ms: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
if ((1.0 * a[0]) > (0.1 * total)) or ((1.0 * a[1]) > (0.1 * total))
then begin
WriteLn(' The milisecond grid is too coarse! Measuring microseconds...');
FillChar(a, sizeof(a), 0);
btime:= Now();
cycles:=0;
repeat
current:= Now();
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(1000, round((current - prev) * 86400000000.0)))]);
prev:= current;
Inc(cycles);
until current > (btime + (1.0 / 86400.0));
m:= 1;
total:= 0;
for i:= 0 to 1000 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
if a[i] > 0
then WriteLn(' ', i, 'us: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
end;
end;
procedure TestGetTickCount(use_tbp: boolean);
var
btime: Longint;
prev, current: Longint;
i, m: integer;
a: array[0..100] of int64;
total, cycles: int64;
begin
WriteLn('Testing the GetTickCount() function of Win API...');
{$ifndef windows}
WriteLn(' Not supported on this platform!');
Exit;
{$else}
FillChar(a, sizeof(a), 0);
if use_tbp then begin
Write(' Calling TimeBeginPeriod(1)... ');
if TimeBeginPeriod(1) <> TIMERR_NOERROR then begin
WriteLn('FAILURE!');
Exit;
end;
WriteLn('Ok')
end;
btime:= GetTickCount();
cycles:=0;
repeat
current:= GetTickCount();
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(100, current - prev))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000);
if use_tbp then TimeEndPeriod(1);
m:= 1;
total:= 0;
for i:= 0 to 100 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
WriteLn(' ', i, 'ms: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
{$endif}
end;
procedure TestGetTimeOfDay;
{$ifdef unix}
var
btime: int64;
prev, current: int64;
i, m: integer;
a: array[0..1000] of int64;
total, cycles: int64;
tv: timeval; //record tv_sec:time_t; tv_usec:clong; end;
{$endif}
begin
WriteLn('Testing the gettimeofday() function...');
{$ifndef unix}
WriteLn(' Not supported on this platform!');
Exit;
{$else}
FillChar(a, sizeof(a), 0);
fpgettimeofday(@tv, NIL);
btime:= tv.tv_sec * 1000 + (tv.tv_usec div 1000);
cycles:= 0;
repeat
fpgettimeofday(@tv, NIL);
current:= tv.tv_sec * 1000 + (tv.tv_usec div 1000);
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(100, current - prev))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000);
m:= 1;
total:= 0;
for i:= 0 to 100 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
WriteLn(' ', i, 'ms: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
if ((1.0 * a[0]) > (0.1 * total)) or ((1.0 * a[1]) > (0.1 * total))
then begin
WriteLn(' The milisecond grid is too coarse! Measuring microseconds...');
FillChar(a, sizeof(a), 0);
fpgettimeofday(@tv, NIL);
btime:= tv.tv_sec * 1000000 + tv.tv_usec;
cycles:=0;
repeat
fpgettimeofday(@tv, NIL);
current:= tv.tv_sec * 1000000 + tv.tv_usec;
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(1000, current - prev))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000000);
m:= 1;
total:= 0;
for i:= 0 to 1000 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
if a[i] > 0
then WriteLn(' ', i, 'us: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
end;
{$endif}
end;
procedure TestClockGetTime;
{$ifdef linux}
var
btime: int64;
prev, current: int64;
i, m: integer;
a: array[0..1000] of int64;
total, cycles: int64;
cid: clockid_t;
spec: timespec; //record tv_sec: Longint; tv_nsec: Longint; end;
{$endif}
begin
WriteLn('Testing the clock_gettime() function...');
{$ifndef linux}
WriteLn(' Not supported on this platform!');
Exit;
{$else}
FillChar(a, sizeof(a), 0);
cid:= CLOCK_PROCESS_CPUTIME_ID;
Write (' Trying CLOCK_PROCESS_CPUTIME_ID...');
if 0 <> clock_getres(cid, @spec) then begin
WriteLn ('FAIL!');
Exit;
end;
WriteLn (' ', spec.tv_sec, 's, ', spec.tv_nsec, 'ns.');
if spec.tv_sec <> 0 then begin
WriteLn ('EPIC FAIL: the seconds value is non-zero!');
Exit;
end;
clock_gettime(cid, @spec);
btime:= spec.tv_sec * 1000 + (spec.tv_nsec div 1000000);
cycles:= 0;
repeat
clock_gettime(cid, @spec);
current:= spec.tv_sec * 1000 + (spec.tv_nsec div 1000000);
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(100, current - prev))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000);
m:= 1;
total:= 0;
for i:= 0 to 100 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
WriteLn(' ', i, 'ms: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
if ((1.0 * a[0]) > (0.1 * total)) or ((1.0 * a[1]) > (0.1 * total))
then begin
WriteLn(' The milisecond grid is too coarse! Measuring microseconds...');
FillChar(a, sizeof(a), 0);
clock_gettime(cid, @spec);
btime:= spec.tv_sec * 1000000 + (spec.tv_nsec div 1000);
cycles:=0;
repeat
clock_gettime(cid, @spec);
current:= spec.tv_sec * 1000000 + (spec.tv_nsec div 1000);
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(1000, current - prev))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000000);
m:= 1;
total:= 0;
for i:= 0 to 1000 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
if a[i] > 0
then WriteLn(' ', i, 'us: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
if ((1.0 * a[0]) > (0.1 * total)) or ((1.0 * a[1]) > (0.1 * total))
then begin
WriteLn(' The microsecond grid is too coarse! Measuring nanoseconds...');
FillChar(a, sizeof(a), 0);
clock_gettime(cid, @spec);
btime:= int64(spec.tv_sec) * int64(1000000000) + spec.tv_nsec;
cycles:=0;
repeat
clock_gettime(cid, @spec);
current:= int64(spec.tv_sec) * int64(1000000000) + spec.tv_nsec;
if (cycles > 0) and (current <> prev)
then Inc(a[Math.max(0, Math.min(1000, current - prev))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000000000);
m:= 1;
total:= 0;
for i:= 0 to 1000 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
if a[i] > 0
then WriteLn(' ', i, 'ns: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
end;
end;
{$endif}
end;
{$if defined(CPUi386) or defined(CPUX86_64)}
{$define x86}
{$endif}
var q: int64;
{$ifdef x86}
{$asmmode intel}
procedure getnt;
begin
asm
{$ifdef cpu64}
pushf
push rdx
push rax
rdtsc
mov dword[q], eax
mov dword[q + 4], edx
pop rax
pop rdx
popf
{$else}
pushf
push edx
push eax
rdtsc
mov dword[q], eax
mov dword[q + 4], edx
pop eax
pop edx
popf
{$endif}
end;
end;
{$endif}
procedure TestRDTSC;
var
btime, prev, current: double;
factor: double;
i, m: integer;
a: array[0..1000] of int64;
total, cycles: int64;
qprev: int64;
t1: TDateTime;
begin
WriteLn('Testing the mighty RDTSC instruction, directly from the CPU!');
{$ifndef x86}
WriteLn(' Not supported on this platform!');
Exit;
{$else}
FillChar(a, sizeof(a), 0);
Write(' Measuring frequency... ');
t1:= Now();
getnt();
prev:= q;
repeat until (Now() - t1) > (1 / 86400);
getnt();
WriteLn (q - prev);
factor:= 1000.0 / (q - prev);
getnt();
btime:= 0;
current:= 0;
cycles:= 0;
repeat
qprev:= q;
getnt();
current+= (q - qprev) * factor;
if (cycles > 0) and (round (current - prev) <> 0)
then Inc(a[Math.max(0, Math.min(100, round(current - prev)))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000);
m:= 1;
total:= 0;
for i:= 0 to 100 do begin
if a[i] > 0 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
WriteLn(' ', i, 'ms: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
if ((1.0 * a[0]) > (0.1 * total)) or ((1.0 * a[1]) > (0.1 * total))
then begin
WriteLn(' The milisecond grid is too coarse! Measuring microseconds...');
FillChar(a, sizeof(a), 0);
factor *= 1000.0;
getnt();
btime:= 0;
current:= 0;
cycles:=0;
repeat
qprev:= q;
getnt();
current+= (q - qprev) * factor;
if (cycles > 0) and (round (current - prev) <> 0)
then Inc(a[Math.max(0, Math.min(1000, round(current - prev)))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000000);
m:= 1;
total:= 0;
for i:= 0 to 1000 do begin
if a[i] > 1000 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
if a[i] > 1000
then WriteLn(' ', i, 'us: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
if ((1.0 * a[0]) > (0.1 * total)) or ((1.0 * a[1]) > (0.1 * total))
then begin
WriteLn(' The microsecond grid is too coarse! Measuring nanoseconds...');
FillChar(a, sizeof(a), 0);
factor *= 1000.0;
getnt();
btime:= 0;
current:= 0;
cycles:=0;
repeat
qprev:= q;
getnt();
current+= (q - qprev) * factor;
if (cycles > 0) and (round (current - prev) <> 0)
then Inc(a[Math.max(0, Math.min(1000, round(current - prev)))]);
prev:= current;
Inc(cycles);
until current > (btime + 1000000000);
m:= 1;
total:= 0;
for i:= 0 to 1000 do begin
if a[i] > 1000 then m:= i;
total+= a[i];
end;
for i:= 0 to m do
if a[i] > 1000
then WriteLn(' ', i, 'ns: ', a[i]);
WriteLn (' Total changes: ', total, ', cycles: ', cycles);
end;
end;
{$endif}
end;
begin
what:= LowerCase(ParamStr(1));
if what = 'now'
then TestNow
else if what = 'tc'
then TestGetTickCount(false)
else if what = 'tc-tbp'
then TestGetTickCount(true)
else if what = 'gtod'
then TestGetTimeOfDay
else if what = 'cgt'
then TestClockGetTime
else if what = 'rdtsc'
then TestRDTSC
else begin
WriteLn ('Usage: test_timers <timer>');
WriteLn (' where <timers> is:');
WriteLn (' now - the Now() function, ported from Delphi to all platforms');
WriteLn (' tc - GetTickCount() of Win API');
WriteLn (' tc-tbp - GetTickCount() + TimeBeginPeriod(1)');
WriteLn (' gtod - gettimeofday() function of Linux API');
WriteLn (' cgt - clock_gettime() function of Linux API');
WriteLn (' rdtsc - the RDTSC instruction of the x86 CPU');
end;
{$ifdef windows}
WriteLn('press Enter to close');
ReadLn;
{$endif}
end.
Cheb писал(а):clock_gettime() позорно слила gettimeofday() по быстродействию, почти в три раза :x
Дож писал(а):А если попробовать {$IFDEF LINUX}CLOCK_MONOTONIC_RAW{$ENDIF}, то какой результат по скорости получится?
Cheb писал(а):gettimeofday()
Cheb писал(а):для косвенного измерения загрузки видеокарты
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 18