type
  TTicks64 = type Int64; // signed, so that deltas can be represented cleanly

  /// ////////////////////////////////////////////////////////////////////////////////////////////////
  // CPUID implements a full barrier; it doesn't influence the timing as it is called before RDTSC.
  // Full story: ia-32-ia-64-benchmark-code-execution-paper.pdf

function RdTSC0: TTicks64; // the 'before' tick
asm
  {$IFDEF CPUX64}
  xor   rax, rax
  push  rbx          // Delphi requires EBX/RBX to be preserved
  cpuid              // full fence
  pop   rbx
  rdtsc
  shl   rdx, 32
  or    rax, rdx
  {$ELSE}
  xor   eax, eax
  push  ebx
  cpuid
  pop   ebx
  rdtsc
  {$ENDIF}
end;

// --------------------------------------------------------------------------------------------------
// RDTSCP implements a sort of read fence: it waits until all preceding instructions in the stream
// have been executed but it doesn't keep later instruction from jumping the queue. That's why the
// RDTSCP is bracketed by CPUID from behind.

function RdTSC1: TTicks64; // the 'after' tick
asm
  {$IFDEF CPUX64}
  {$IFDEF ZX_dont_use_RDTSCP}
  rdtsc
  {$ELSE}
  rdtscp
  {$ENDIF}
  shl   rdx, 32
  or    rdx, rax
  xor   rax, rax
  push  rbx
  push  rdx
  cpuid
  pop   rax
  pop   rbx
  {$ELSE}
  {$IFDEF ZX_dont_use_RDTSCP}
  rdtsc
  {$ELSE}
  db    $0F, $01, $F9  // rdtscp; X2 understands the mnemonic for x64 but not for x86
  {$ENDIF}
  push  eax
  xor   eax, eax
  push  edx
  push  ebx
  cpuid
  pop   ebx
  pop   edx
  pop   eax
  {$ENDIF}
end;

// -------------------------------------------------------------------------------------------------
// for flank-to-flank measurements

function rdtscp: TTicks64;
asm
  {$IFDEF CPUX64}
  {$IFDEF ZX_dont_use_RDTSCP}
  rdtsc
  {$ELSE}
  rdtscp
  {$ENDIF}
  shl   rdx, 32
  or    rax, rdx
  {$ELSE}
  {$IFDEF ZX_dont_use_RDTSCP}
  rdtsc
  {$ELSE}
  db    $0F, $01, $F9  // rdtscp; X2 understands the mnemonic for x64 but not for x86
  {$ENDIF}
  {$ENDIF}
end;

function CallNtPowerInformation(InformationLevel: Byte; lpInputBuffer: Pointer; nInputBufferSize: Longint; lpOutputBuffer: Pointer; nOutputBufferSize: Longint): Byte; stdcall; external 'PowrProf.dll';
type
  TPINFO = record
    Number: UINT;
    MaxMh: UINT;
    CurrentMhz: UINT;
    MhzLimit: UINT;
    MaxIdleState: UINT;
    CurrentIdleState: UINT;
  end;

  Function DummyThread(Param:pointer):Cardinal;stdcall;
  var x:integer; y:real;
  begin
    x:=0;
    while true do begin
    y:=cos(x);
    inc(x);
    if x>100000 then x:=0;
    end;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SI:_SYSTEM_INFO;
  NumberOfProcessors:Cardinal;
  PINFO: Array of TPINFO;
  res: Byte;
  resBool:Boolean;
  PID:Cardinal;
  ProcessAffinityMask: Cardinal;
  hProcess,hThread:THandle;
begin
  hProcess:=GetCurrentProcess();
  ProcessAffinityMask:=0;
  ProcessAffinityMask:=ProcessAffinityMask or (1 shl 1);
  resBool:=SetProcessAffinityMask(hProcess,ProcessAffinityMask);
  if resBool=false then begin
    ShowMessage(_GetErrorMsg(GetLastError));
    exit;
  end;
  GetSystemInfo(SI);
  NumberOfProcessors:=SI.dwNumberOfProcessors;
  hThread:=CreateThread(nil,0,@DummyThread,nil,0,PID);
  sleep(3000);
  SetLength(PINFO, NumberOfProcessors);
  ZeroMemory(@PINFO[0], sizeOf(TPINFO) * NumberOfProcessors);
  res := CallNtPowerInformation(11, nil, 0, @PINFO[0], sizeOf(TPINFO) * NumberOfProcessors);
  ShowMessage('CurrentMhz:'+inttostr(PINFO[0].CurrentMhz)+'//MaxMh:'+inttostr(PINFO[0].MaxMh));
  TerminateThread(hThread,0);
end;