Листинг 1

unit timer_dw;

interface

function GetTimer_1:dword;    {счетчик в 1 мкс (0,5 ч.)}
function GetTimer_50:dword;   {счетчик в 50 мкс (1 сут.)}
function GetTimer_1000:dword; {счетчик в 1 мс (20 сут.) }
function GetCPUtick:int64;    {счетчик в тактах проц. }
function GetCPUfreq:dword;    {частота процессора в кГц}
function GetDelta:dword;      {погрешность частоты в кГц }
procedure InitTimer;          {реинициализация таймера}

implementation
uses WinDos;

var
  b1,b50,b1000,delta : longint; {коэффициенты деления}
  C1,c50,c1000       : longint; {маски}

function GetCPUfreq:dword;    {частота процессора в кГц}
begin
  GetCPUfreq := b1000;
end;

function GetDelta:dword;      {погрешность частоты в кГц }
begin
  GetDelta := delta;
end;

function GetTimer_1:dword; assembler;
asm
  db $0f,$31 {rdtsc}
  and edx,c1
  div b1
end;

function GetTimer_50:dword; assembler;
asm
  db $0f,$31 {rdtsc}
  and edx,c50
  div b50
end;

function GetTimer_1000:dword; assembler;
asm
  db $0f,$31 {rdtsc}
  and edx,c1000
  div b1000
end;

function GetCPUtick:int64;
var q : int64;
begin
  asm
    db $0f,$31 {rdtsc}
    mov dword ptr [q],eax
    mov dword ptr [q+4],edx
  end;
  getCPUtick := q;
end;

function GetLessFF(n:longint):longint;{возвращение бинарное}
          {число вида 00...0011...11 меньшее заданного}
var i,j : longint;
begin
  j := 1;
  repeat
    i := j;
    j := j*2;
  until j > n;
  GetLessFF := i-1;
end;

procedure InitTimer;
const
  n = 8;                         {количество измерений}
  Const1 : extended = 0.0182; {част.стнд.таймера в кГц}
var
  i,j : longint;
  t : array[0..n]of extended; {результаты измерения тактов}
  d : array[0..n]of extended; {результаты измерения времени, мс}
  t0,t1 : extended;
  h_,m_,s_,d_,d1_ : word;     {для определения времени}
  sti,sta : extended; {сумма тиков; сумма тактов}
begin
  t0 := getCPUtick;
  sti := 0;
  for i := 0 to n do begin {формируем массив измерений}
    GetTime(h_,m_,s_,d_);
    repeat
      GetTime(h_,m_,s_,d1_);
    until d1_ <> d_;
    t[i] := getCPUtick-t0;
    if d1_ > d_ then
      d[i] := (d1_-d_)*10
    else
      d[i] := ((d1_+100)-d_)*10;
    sti := sti + d[i];
  end;
  sti    := sti  - d[0]; {время измерения в мс}
  sta    := t[n] - t[0]; {время измерения в тактах}
  if ((n/sti*0.8) > Const1) or          { если Const1 }
     ((n/sti*1.2) < Const1) then        {  отличается }
    Const1 := n/sti;                    {  более 20%  }
  for i := 0 to n-1 do begin {вычисляем за 1 тик}
    t[i] := (t[i+1]-t[i]);
  end;

  for i := 1 to n-1 do               {сортируем массив}
    for j := n-1 downto i do
      if t[j] < t[j-1] then
        begin
          t0 := t[j];  t[j] := t[j-1];  t[j-1] := t0;
        end;
  j := n div 4; {отбрасываем ~ по 1/4 с каждой стороны}
  t0 := 0;
  for i := j to n-1-j do   {     берем середину       }
    t0 := t0 + t[i];       { отсортированного массива }
  t0 := t0 / (n-j-j); {ср.кол-во тактов за тик}
  t1 := t0 * Const1;  {ср.кол-во тактов за мс}
  b1000 := round(t1);                  {   вычисляем  }
  b50   := round(t1 / 20);             { коэффициенты }
  b1    := round(t1 / 1000);           {    деления   }
  c1    := GetLessFF(   b1);  { вычисляем }
  c50   := GetLessFF(  b50);  {  значения }
  c1000 := GetLessFF(b1000);  {   маски   }
  t1 := 0;
  for i := j to n-1-j do                  { оцениваем }
    t1 := t1 + sqr(t[i]-t0);              {погрешность}
  delta := round(sqrt(t1/(n-j-j))*Const1);{ измерения }
end;

begin
  InitTimer;
end.