Начиная с pentium mmx, intel ввели в процессор счетчик тактов на 64 бита (Присутствуэт точно и в К6). Для того чтобы посотреть на его содержание, была введена команда "rdtsc" (подробное описание в интеловской мануале).
Эту возможность можно использовать для реализации сабжа.
Посоку Делфя не вкурсе насчет rdtsc, то пришлось юзать опкод (0f31).
Привожу простенький примерчик юзания, Вы уж извините - немножко кривоват получился,
да и ошибка компалера какая-то вылезла :( (v4 bld5.104 upd 2). Кому интересно, поделитесь своими соображениями по этому поводу. Особенно интерисует работа в режиме когда меняется частота процессора (duty cycle, standby).
Проверялось под еНТями на Пне 2 333.
// (c) 1999
isvunit unit1;
interfaceuses 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.cap примера
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.