Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Win Api / Скорость работы процессора, точный таймер

Скорость работы процессора, точный таймер

Данная тема уже обсуждалась, но у меня есть своя реализация сабжа. Начиная с Pentium MMX, Intel ввели в процессор счетчик тактов на 64 бита (Присутствуэт точно и в К6). Для того чтобы посотреть на его содержание, была введена команда "rdtsc" (подробное описание в интеловской мануале). Эту возможность можно использовать для реализации сабжа.
Посоку Делфя не вкурсе насчет rdtsc, то пришлось юзать опкод (0F31).
Привожу простенький примерчик юзания, Вы уж извините - немножко кривоват получился, да и ошибка компалера какая-то вылезла :( (V4 Bld5.104 Upd 2). Кому интересно, поделитесь своими соображениями по этому поводу. Особенно интерисует работа в режиме когда меняется частота процессора (Duty Cycle, StandBy).

Проверялось под еНТями на Пне 2 333.

// (C) 1999 ISV
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
  StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label4: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Counter:integer;      //Счетчик срабатывания таймера
    Start:int64;              //Начало роботы
    Previous:int64;        //Предыдущее значение
    PStart,PStop:int64; //Для примера выч. времени
    CurRate:integer;     //Текущая частота проца
    function GetCPUClick:int64;
    function GetTime(Start,Stop:int64):double;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
// Функция работает на пнях ММХ или выше а
// также проверялась на К6
function TForm1.GetCPUClick:int64;
begin
  asm
    db  0fh,31h   // Опкод для команды rdtsc
    mov dword ptr result,eax
    mov dword ptr result[4],edx
  end;
// Не смешно :(. Без ?той штуки
// Компайлер выдает Internal error C1079
  Result:=Result;
end;

// Время в секундах между старт и стоп
function TForm1.GetTime(Start,Stop:int64):double;
begin
  try
    result:=(Stop-Start)/CurRate
  except
    result:=0;
  end;
end;

// Обработчик таймера считает текущую частоту, выводит ее, а также
// усредненную частоту, текущий такт с момента старта процессора.
// При постоянной частоте процессора желательно интервал брать
побольше
// 1-5с для точного прощета частоты процессора.
procedure TForm1.Timer1Timer(Sender: TObject);
  var
    i:int64;
begin
  i:=GetCPUClick;
  if Counter=0
    then Start:=i
    else begin
      Label2.Caption:=Format('Частота общая:
%2f',[(i-Start)/(Counter*Timer1.Interval*1000)]);
      Label3.Caption:=Format('Частота текущая:
%2f',[(i-Previous)/(Timer1.Interval*1000)]);
      CurRate:=Round(((i-Previous)*1000)/(Timer1.Interval));
    end;
  Label1.Caption:='Такты: '+IntToStr(i);
  Previous:=i;
  Inc(Counter);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  Counter:=0;
end;

// Заносим стартовое время для примера
procedure TForm1.Button1Click(Sender: TObject);
begin
  PStart:=GetCPUClick;
end;

// Останавливаем отсчет времени и показуем соко
// прошло секунд
procedure TForm1.Button2Click(Sender: TObject);
begin
  PStop:=GetCPUClick;
  Label4.Caption:=Format('Время между нажатиями:
%gсек',[GetTime(PStart,PStop)])
end;

end.

Copyright ©   "Мастера DELPHI"   E-mail:   delphi@mastak.com  http://www.delphimaster.ru

Источник получения информации: http://www.delphimaster.ru