Определение частоты процессора: Как делает это Windows

Определение частоты процессора: Как делает это Windows

Колобок
17.11.2005, 11:45
По воле случая, отлаживая одну прогу, наткнулся на метод определения частоты процессора используемый в Windows. По этому методу написал программу на Делфи.

program PerfCounter;

{$APPTYPE CONSOLE}

uses
Windows,
SysUtils;

const
MAX_ATTEMPTS = 32;

type
TPerfData = record
PerfStart, PerfEnd, PerfFreq, PerfDelta: Int64;
TSCStart, TSCEnd, TSCDelta: Int64;
Mhz: Cardinal;
end;

// Read TSC Counter
function RDTSC():Int64;assembler;
asm
rdtsc;
end;

var
PerfData: array [0..MAX_ATTEMPTS] of TPerfData;
Index: Cardinal;
Average: Cardinal;
begin
Index := 0;
while true do
begin

//
// Collect a new sample
// Delay the thread a "long" amount and time it with
// a time source and RDTSC.
//

QueryPerformanceCounter(PerfData.PerfStart);
PerfData.TSCStart := RDTSC();
PerfData[Index].PerfFreq := -50000;

Sleep(500);

QueryPerformanceCounter(PerfData[Index].PerfEnd);
QueryPerformanceFrequency(PerfData[Index].PerfFreq);
PerfData[Index].TSCEnd := RDTSC();

[I]// calculation MHz
with PerfData[Index] do
begin
PerfDelta := PerfEnd - PerfStart;
TSCDelta := TSCEnd - TSCStart;
Mhz := Trunc((TSCDelta * PerfFreq + 500000) / (PerfDelta * 1000000));
end;

[I]// if last 2 samplesmatches within a MHz done
if Boolean(Index) then
if (PerfData.Mhz = PerfData.Mhz) or
(PerfData[Index].Mhz = PerfData[Index-1].Mhz + 1) or
(PerfData[Index].Mhz = PerfData[Index-1].Mhz - 1) then break;

[I]// advance to next sample
Inc(Index);

[I]// if too many samples, then smth is wrong
if Index >= MAX_ATTEMPTS then
begin
Average := 0;
for Index := 0 to MAX_ATTEMPTS do
Inc(Average, PerfData.Mhz);

[I]// We got a warning below this line, but is not critical
PerfData[Index - 1].Mhz := Trunc(Average / MAX_ATTEMPTS);
break;
end;

end;

WriteLn(' CPU Frequency: ' + IntToStr(PerfData[Index-1].Mhz) + ' MHz');
ReadLn;
end.

Эта запись была добавлена в Четверг, 29 мая, 2008 - 16:04 В разделы Аппаратные средства, Процессор. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.