Hа боpтy самолёта: "Здpавствyйте, дамы и господа, говоpит командиp экипажа. Мы благодаpим вас за то, что вы выбpали нашy авиакомпанию для пеpвого полёта в пеpвый день нового 2000 года. Мы находимся на высоте 3 тыс. фyтов, наша скоpость... ваy!... ох мля!... вот фак!... Извините за те неyдобства, котоpые вы испытываете, находясь вниз головой, надеюсь все были пpистёгнyты. Есть ли сpеди пассажиpов на боpтy пpогpаммист?"
function GetCPUSpeed: real;
function IsCPUID_Available: Boolean; assembler; register;
asm
PUSHFD { прямой доступ к флагам невозможен, только через стек }
POP EAX { флаги в EAX }
MOV EDX,EAX { сохраняем текущие флаги }xor EAX,$200000 { бит ID не нужен }
PUSH EAX { в стек }
POPFD { из стека в флаги, без бита ID }
PUSHFD { возвращаем в стек }
POP EAX { обратно в EAX }xor EAX,EDX { проверяем, появился ли бит ID }
JZ @exit { нет, CPUID не доступен }
MOV AL,True { Result=True }
@exit:
end;
function hasTSC: Boolean;
var
Features: Longword;
beginasm
MOV Features,0 { Features = 0 }
PUSH EBX
xor EAX,EAX
DW $A20F
POP EBX
CMP EAX,$01
JL @Fail
xor EAX,EAX
MOV EAX,$01
PUSH EBX
DW $A20F
MOV Features,EDX
POP EBX
@Fail:
end;
hasTSC := (Features and $10) <> 0;
end;
const
DELAY = 500;
var
TimerHi, TimerLo: Integer;
PriorityClass, Priority: Integer;
begin
Result := 0;
ifnot (IsCPUID_Available and hasTSC) then
Exit;
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread,
THREAD_PRIORITY_TIME_CRITICAL);
SleepEx(10, FALSE);
asm
DB $0F { $0F31 op-code for RDTSC Pentium инструкции }
DB $31 { возвращает 64-битное целое (Integer) }
MOV TimerLo,EAX
MOV TimerHi,EDX
end;
SleepEx(DELAY, FALSE);
asm
DB $0F { $0F31 op-code для RDTSC Pentium инструкции }
DB $31 { возвращает 64-битное целое (Integer) }
SUB EAX,TimerLo
SBB EDX,TimerHi
MOV TimerLo,EAX
MOV TimerHi,EDX
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000 * DELAY);
end;
Статья Как определить скорость процессора раздела ОС и Железо Процессор может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.