Как определить скорость процессора

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;
begin
  asm
    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;
  if not (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;

Недавно добавленные исходники
• DeLiKaTeS Tetris (Тетрис) 3 915 • TDictionary Custom Sort 6 019 • Fast Watermark Sources 5 805 • 3D Designer 8 618 • Sik Screen Capture 6 144 • Patch Maker 6 579 • Айболит (remote control) 6 570 • ListBox Drag & Drop 5 428 • Доска для игры Реверси 95 324 • Графические эффекты 6 780 • Рисование по маске 5 944 • Перетаскивание изображений 4 950 • Canvas Drawing 5 325 • Рисование Луны 5 052 • Поворот изображения 4 595 • Рисование стержней 3 254 • Paint on Shape 2 494 • Генератор кроссвордов 3 379 • Головоломка Paletto 2 692 • Теорема Монжа об окружностях 3 468 • Пазл Numbrix 2 289 • Заборы и коммивояжеры 2 971 • Игра HIP 1 938 • Игра Go (Го) 1 854 • Симулятор лифта 2 191 • Программа укладки плитки 1 919 • Генератор лабиринта 2 362 • Проверка числового ввода 2 047 • HEX View 2 367 • Физический маятник 2 002