freepascal.ru

Хоть завалящий таймер высокого (можно не очень) разрешения? Ну хоть до милисекундной точности?
А?

З.Ы. В арме я полный нуб

Попробуйте SysTick

А позиксовый clock_gettime(CLOCK_MONOTONIC, ...) не устраивает?

А я и в линуксе почти нуб

Спасибо, вечером попробую!

Добавлено спустя 13 часов 18 минут 10 секунд:
clock_gettime() позорно слила gettimeofday() по быстродействию, почти в три раза
SysTick не определена для используемой платформы.

Код: Выделить всё

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

Добавлено спустя 4 минуты 26 секунд:
с использованием

Код: Выделить всё

{$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}, то какой результат по скорости получится?

Дож писал(а):А если попробовать {$IFDEF LINUX}CLOCK_MONOTONIC_RAW{$ENDIF}, то какой результат по скорости получится?

RAW будет быстрее, но он некорректируемый, а потому погрешность измерений накапливается по шкале времени. Для скорости можно CLOCK_MONOTONIC_COARSE использовать, только там точность не очень высокая, на моём железе 4 msec на смарте 3 msec.

Добавлено спустя 20 минут 51 секунду:

Cheb писал(а):gettimeofday()

Её для замеров использовать нельзя, подробнее: http://nadeausoftware.com/articles/2012 ... ttimeofday

Дрейф мне абсолютно фиолетов, важно именно высокое разрешение. Я таймеры высокого разрешения использую только в стиле "запомнить точку, позже получить дельту от той точки", для косвенного измерения загрузки видеокарты, ограничения некоторых задач по времени выполнения, на уровне милисекунд или меньше, и встроенного профайлера.
Для измерения основного потока времени идёт Now(), у неё милисекундная точность на всех платформах (в линуксе по дефолту, в винде после вздрючивания системы вызовом TimeBeginPeriod(1) )
Единичные взглюки таймера высокого разрешения тоже не критичны, результаты как правило пересчитываются в относительные величины и усредняются по нескольким кадрам.

Cheb писал(а):для косвенного измерения загрузки видеокарты

А какова методика такого измерения, не поделишься?

1. Отключаем VSync
2. Мерим длительность вызова SwapBuffers (wglSwapBuffers/glxSwapBuffers и как ещё её там)
3. Плавно меняем размер рендертаргетов в зависимости от полученного значения (не забывая проверяьть ещё FPS, поскольку одна длительность SwapBuffers все ситуации не охватывает)

ИЧСХ, работает везде, где я ни тестировал. Очень похоже на то, что драйвер видеокарты откладывает как можно бОльшую часть работы до вызова SwapBuffers.
Очень полезно тем, что работает даже когда ограничиваешь FPS, например, до 30, посредством Sleep'ов (например, для всяких визуальных редакторов, использующих OpenGL)

Примерные значения:
< 1мс - вес пера, можно грузить ещё
6..8 мс - нормальная нагрузка (или поверх окна программы наложилось полупрозрачное окошко Aero, что нехило утяжеляет)
~ 10мс - толсто, пора придержать лошадей.