Delphi: Точный таймер (Win API) (комментарии)

  TMotherTimer = maybepacked record
    FPS,
    QF: single;
    StartupDateTime: TDateTime;
    RdtscFrequency, //gets updated dynamically, a few times per second. Thus, it's somewhat noisy.
    RdtscFactor, // 1000000.0 / RdtscFrequency , updates synchronously
    LastSwapBuffersDuration: double; //seconds
    FpsDisplayingParams: TFpsCounterParams;
    AverageSwapBuffersDuration: double;
    QF_ManualOverride: boolean;
    SuspendSwapBuffersMeasurement: boolean; { This is set by the module:
      signaling the mother to suspend measurement
      during potentially costly operations like creating FBOs
      to avoid creating a feedback loop}
    CullFrameRate: integer; {
      This field gets set to 30 before each call to the module pulse function
        (or to 60 if a mouse movement event was received).
      Unless the module sets it back to a higher value, there will be Sleep() called
        by the mother module after return from the module pulse function, to cull
        frame rate at the value determined here. (implemented in cl_window)
      This way only high-performance 3d rendering modules would hog
        all the video card & cpu resources,
        and only when they specifically request it.
      Setting it higher than 300 disables culling.
    }
    Second: function (): double; cdecl;
    UsecDelta: function (ptsc: pqword): double; cdecl;
    {$ifdef windows}
    ActiveTBP1: boolean; // to monitor calls to timeBeginPeriod(1)
    //  Highrer resolution waits are used for arbitrary FPS stabilization
    //  but must be deactivated when laptop is running on battery as this
    //  OS-wide mode prevents CPU from power saving
    {$endif}
    HiResSleep: procedure(ms: longint); cdecl;
    ReservedStub: array[0..15] of ptruint;
  end;

{$ifndef cpuarm}
  {$asmmode intel}
  const
    ctRDTSCFreqEstimationPeriod
      = {$ifdef windows} 5.0 {$else} 20.0 {$endif};
    ctFreqCheckPeriod
      = {$ifdef windows} 2.0 {$else} 5.0 {$endif};
    ctFreqDeviationTolerancy
      = {$ifdef windows} 0.05 {$else} 0.2 {$endif};
      //because I don't know how to raise thread priority in unix,
      //  so error marign should be much wider.
{$endif}


var
  _startTSC: qword;
{$ifdef windows}
  _starttick: int64;//longint;
function Second: double; cdecl;
begin
  Result:= (GetTickCount() - _starttick) / 1000.0;
end;
{$else}
  _StartNow: TDateTime;
function Second(): double; cdecl;
begin
  Result:= (Now() - _StartNow) * SecondsPerDay;
end;
{$endif}

  function GetTimeStamp: qword; forward;

{$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}
  

  {$ifdef cpuarm}
    function UsecDelta (ptsc: pqword): double; cdecl;
    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}

 var
    PrevTimeStamp: qword = 0;

  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;



  procedure InitCTimer;
  begin
    {$ifdef cpuarm}
      Assert(sizeof(timeval) = 8, 'The timer routines are not compatible with 64-bit architecture.');
      Mother^.Timer.RDTSCFrequency:= 1000000;
      Mother^.Timer.RdtscFactor:= 1000000.0 / Mother^.Timer.RdtscFrequency;
      _startnow:= Now();
    {$else cpuarm}
      {$ifdef windows}
        {$ifdef cpu32}
          if Mother^.Debug.Verbose then AddLog('Calling timeBeginPeriod(1)...');

  //***DONE (for WinAPI framework, at least)
  //  forums.spacebattles.com/threads/chrome-processes-hogging-ram-after-close.338685/
  // We're talking about Chrome reducing battery life by 25-33% here,
  //    just by being open. For miniscule reductions to response time.
  //    It's shitty programming is what it is.

            if timeBeginPeriod(1) = TIMERR_NOERROR
            then begin
              if Mother^.Debug.Verbose then AddLogOk;
              Mother^.Timer.ActiveTBP1:= true;
            end
            else Die(RuEn(
              'Не удалось переключить системный таймер на разрешение в 1 мс.',
              'Unable to switch the system timer to 1 milisecond precision.'));
          SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
        {$endif}
        _starttick:= GetTickCount();
      {$else}
      _startnow:= Now();
      {$endif}
      if Mother^.Debug.Verbose then AddLog('Measuring TSC frequency...');
      Mother^.Timer.RDTSCFrequency:= 1;
      Mother^.Timer.RdtscFactor:= 1000000.0 / Mother^.Timer.RdtscFrequency;
      _startTSC:= GetTimeStamp();
      _PrevTSC:= _startTSC;
      Mother^.Timer.StartupDateTime:= Now();
      repeat until RecheckTscFreq(0.5);
      {$if defined(windows) and defined(cpu32)}
         SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
      {$endif}
      if Mother^.Debug.Verbose then AddLog('  ..is %0',[Mother^.Timer.RDTSCFrequency]);
    {$endif cpuarm}

    LastHeartbeatMoment:= Mother^.Timer.StartupDateTime;
  end;