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

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 669 • TDictionary Custom Sort 5 800 • Fast Watermark Sources 5 603 • 3D Designer 8 215 • Sik Screen Capture 5 913 • Patch Maker 6 388 • Айболит (remote control) 6 378 • ListBox Drag & Drop 5 237 • Доска для игры Реверси 94 551 • Графические эффекты 6 570 • Рисование по маске 5 643 • Перетаскивание изображений 4 759 • Canvas Drawing 5 135 • Рисование Луны 4 863 • Поворот изображения 4 411 • Рисование стержней 3 116 • Paint on Shape 2 360 • Генератор кроссвордов 3 228 • Головоломка Paletto 2 551 • Теорема Монжа об окружностях 3 328 • Пазл Numbrix 2 200 • Заборы и коммивояжеры 2 849 • Игра HIP 1 820 • Игра Go (Го) 1 740 • Симулятор лифта 2 072 • Программа укладки плитки 1 798 • Генератор лабиринта 2 240 • Проверка числового ввода 1 925 • HEX View 2 225 • Физический маятник 1 911