No replies to this topic

[DeveloperX]

3 different functions to getting real CPU speed.

First.

function GetCPUSpeed: real; 

  function IsCPUID_Available: Boolean; assembler; register; 
  asm 
			PUSHFD				
			POP	EAX			{ Flags to EAX } 
			MOV	EDX,EAX		{ store current flags }
			XOR	EAX,$200000	{ w/o ID bit }
			PUSH	EAX		   { to EAX } 
			POPFD				{ to flags } 
			PUSHFD				{ return }
			POP	EAX			{ return to EAX } 
			XOR	EAX,EDX		{ check ID }
			JZ	  @exit		 { no, CPUID not accessable }
			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		   { returns 64-bit Integer } 
			MOV	TimerLo,EAX 
			MOV	TimerHi,EDX 
  end; 

  SleepEx(DELAY, FALSE); 

  asm 
			DB	  $0F		   { $0F31 op-code для RDTSC Pentium } 
			DB	  $31		   {  returns 64-bit 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;

Second. Returns speed in MHz.

Program ....; 
  .. 
.. 
   

const 
ID_BIT=$200000; // EFLAGS ID bit 

function GetCPUSpeed: Double; 
const 
  DelayTime = 500; 
var 
  TimerHi, TimerLo: DWORD; 
  PriorityClass, Priority: Integer; 
begin 
try 
  PriorityClass := GetPriorityClass(GetCurrentProcess); 
  Priority := GetThreadPriority(GetCurrentThread); 

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); 
SetThreadPriorit(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL); 

  Sleep(10); 
  asm 
	dw 310Fh // rdtsc 
	mov TimerLo, eax 
	mov TimerHi, edx 
  end; 
  Sleep(DelayTime); 
  asm 
	dw 310Fh // rdtsc 
	sub eax, TimerLo 
	sbb edx, TimerHi 
	mov TimerLo, eax 
	mov TimerHi, edx 
  end; 

  SetThreadPriority(GetCurrentThread, Priority); 
  SetPriorityClass(GetCurrentProcess, PriorityClass); 

  Result := TimerLo / (1000.0 * DelayTime); 
  except end; 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
var cpuspeed:string; 
begin 
cpuspeed:=Format('%f MHz', [GetCPUSpeed]); 
edit1.text := cpuspeed; 
end;

Third (WinApi).

function RdTSC : int64; register; 
asm 
  db   $0f, $31 
end;												  

function GetCyclesPerSecond : int64; 
var 
  hF, T, et, sc : int64; 
begin 
  QueryPerformanceFrequency(hF);						  // HiTicks / second 
  QueryPerformanceCounter(T);						// Determine start HiTicks 
  et := T + hF;		   // (Cycles are passing, but we can still USE them!) 
  sc := RdTSC;														  // Get start cycles 
  repeat									// Use Hi Perf Timer to loop for 1 second 
	QueryPerformanceCounter(T);							// Check ticks NOW 
  until (T >= et);					//  Break the moment we equal or exceed et 
  Result := RdTSC - sc;				// Get stop cycles and calculate result 
end;

Choose yours...