ccpuinfo.pas

pipe类 pipe类 pipe类 pipe类 pipe类

//----------------------------------------------------------------------------//
//     This unit is a part of an OpenSource project OverSoft CPU Informer     //
//     cCPUinfo.pas - contain cpuid program engine                            //
//                                                                            //
//                                                                            //
//   Written by Dmitriy Arekhta(Daemon) (c) 2005-2006                         //
//   OverSoft Team (c) 2005-2006                                              //
//----------------------------------------------------------------------------//
unit cCPUinfo;

interface

uses Classes, Math, CommonTypes, ProcessorConsts, rvsfunctions, OMCDrv, CmnTnC,
     hPCI, WinVer;

type
  cCPUid = class
  private
    oHWIO: tOMCDrv;

    WinVer: byte;
    DelayTime: Word;

    ProcNum: DWord;
    fFlagBrand: tFlagBrand;
    fCPUdata: tCPUdata;
    fCPUid_m: tCPUid_m;
    fCPUfeatures: tCPUfeatures;
    fClocks: tClocks;
    fFeaturesFlags: tFeaturesFlags;
    fPManagement: tPManagement;
    fTransmetaSpecific: tTransmetaSpecific;
    flevel1: tlevel1;
    flevel2: tlevel2;
    flevel3: tlevel3;
    cnameinfo: tnameinfo;
    HyperTransport: tPCIDevice;
    FIDVIDEnable: boolean;

    function cpuid(Inst: DWord; var regs: tCPUidRegs): boolean;
    function GetCPUdata(var fCPUdata: tCPUdata): boolean;
    function GetCPUCount: byte;
    function DetectCPUVendor(var fFlagBrand: tFlagBrand): boolean;
    function GetExtInfo: boolean;
    function GetCPUfeatures: boolean;
    function GetFeaturesFlags: boolean;
    function GetPowerManag: boolean;
    function FillCacheInfo: boolean;

    procedure GetCPUString(var tmp: string48); 
    function GetStdVendorIDString: ShortString;
    function GetExtVendorIDString: ShortString;

    //Getting advanced data [begin]
    function GetCPUAdvData: boolean;
    procedure GetAMDAdvData;
    procedure GetIntelAdvData;
    procedure GetTransmetaAdvData;
    procedure GetVIAAdvData;
    procedure GetUMCAdvData;
    procedure GetNexgenAdvData;
    procedure GetRiseAdvData;
    procedure GetSisAdvData;
    procedure GetNSCAdvData;
    //Getting advanced data [end]
    //Multipliers [begin]
    function GetCpuTSCFrequency: Double;
    function GetK6Multiplier: boolean;
    function GetK7Multiplier: boolean;
    function GetK8Multiplier: boolean;
    function GetCoppermineMultiplier: boolean;
    function GetTualatinMultiplier: boolean;
    function GetP4WillametteMultiplier: boolean;
    function GetP4NorthWoodMultiplier: boolean;
    function GetDothanBaniasMultiplier: boolean;
    function GetMultiplier: boolean;
    //Multipliers [end]
    //Rating [begin]
    procedure GetAthlonXPInfo;
    procedure GetPentiumMInfo;
    procedure GetCoreSoloInfo;
    procedure GetCoreDuoInfo;
    procedure GetCoreInfo;
    procedure GetCeleronDInfo;
    procedure GetPentiumDInfo;
    procedure GetPentium4Info;
    //Rating [end]
    //Transmeta specific [begin]
    function GetTransmetaInfo: ShortString;
    procedure GetTransmetaFeat;
    //Transmeta specific [end]
    function GetA64HTRate(fPCIDevice: tPCIDevice): single;
    procedure LoadAPIfunctions;
  public
    CPUCount: byte;

    constructor Create(Num: DWord);
    destructor Destroy; override;

    procedure FillCPUinfo;
    procedure UpdateClocks;
    //Power Management [begin]
    function CheckODCM: Word;
    procedure SetODCM(Cycle: Word);
    function CheckTM: byte;
    procedure SetTM(TMtype: byte);
    procedure EnableFIDVIDControl;
    procedure DisableFIDVIDControl;
    function EnableK8FIDVID: boolean;
    function DisableK8FIDVID: boolean;

    procedure SetFID(Data: DWord);
    procedure SetVID(Data: DWord);
    function GetFID: DWord;
    function GetVID: DWord;
    //Power Management [end]

    property FlagBrand: tFlagBrand read fFlagBrand;
    property CPUdata: tCPUdata read fCPUdata;
    property CPUid_m: tCPUid_m read fCPUid_m;
    property CPUfeatures: tCPUfeatures read fCPUfeatures;
    property Clocks: tClocks read fClocks;
    property FeaturesFlags: tFeaturesFlags read fFeaturesFlags;
    property PManagement: tPManagement read fPManagement;
    property TransmetaSpecific: tTransmetaSpecific read fTransmetaSpecific;
    property level1: tlevel1 read flevel1;
    property level2: tlevel2 read flevel2;
    property level3: tlevel3 read flevel3;
    property nameinfo: tnameinfo read cnameinfo;
  end;

implementation

uses MyUtils, SysUtils, Windows;   

type
  tSetThreadAffinityMask = function (hThread: THandle; dwThreadAffinityMask: DWORD): DWORD; stdcall;
  tSetProcessAffinityMask = function (hProcess: THandle; dwProcessAffinityMask: DWORD): BOOL; stdcall;
  tGetProcessAffinityMask = function (hProcess: THandle; var lpProcessAffinityMask, lpSystemAffinityMask: DWORD): BOOL; stdcall;

var
  IsNT: boolean;
  DMISkip: boolean;
  ifStart: boolean;
  MultMethod: byte;

  SetThreadAffinityMask: tSetThreadAffinityMask;
  SetProcessAffinityMask: tSetProcessAffinityMask;
  GetProcessAffinityMask: tGetProcessAffinityMask;
  Kernel32: THandle;

{$I Cpuinfo.inc}
{$I CpuInfoEx.inc}
{$I CPUcache.inc}
{$I Multipliers.inc}
{$I PManagement.inc}

{$I AMDinfo.inc}
{$I Intelinfo.inc}
{$I Transmetainfo.inc}
{$I VIAinfo.inc}
{$I Otherinfo.inc}

//Class constructor
constructor cCPUid.Create(Num: DWord);
const
  HTVenID=$1022;
  HTDevID=$1100;
var
  ArLen: byte;
begin
  inherited Create;
  LoadAPIfunctions;
  oHWIO := GetInstance;
  IsNT:=IsNTfunc;
  ifStart:=true;
  CPUCount:=GetCPUCount;
  FIDVIDEnable:=false;
  WinVer:=GetWinVer;
  DelayTime:=250;
  ProcNum:=Num;
  //Scaning PCI bus to find HyperTransport device
  oHWIO.IPCIIORef.FindDevice(HTVenID, HTDevID, HyperTransport);
  FillCPUinfo;
  //DMI
  DMISkip := true;  //TO-DO: REMOVE ME
end;

procedure cCPUid.LoadAPIfunctions;
begin
  try
    Kernel32:=LoadLibrary('kernel32.dll');
    @SetThreadAffinityMask:=GetProcAddress(Kernel32,'SetThreadAffinityMask');
    @SetProcessAffinityMask:=GetProcAddress(Kernel32,'SetProcessAffinityMask');
    @GetProcessAffinityMask:=GetProcAddress(Kernel32,'GetProcessAffinityMask');
    FreeLibrary(Kernel32);
  except
    @SetThreadAffinityMask:=nil;
    @SetProcessAffinityMask:=nil;
    @GetProcessAffinityMask:=nil;
  end;
end;

//Performing cpuid instruction
function cCPUid.cpuid(Inst: DWord; var regs: tCPUidRegs): boolean;
var
  A, B, C, D: DWord;
begin
  result:=true;
  try
  asm
    pushad
    pushf
    xor ebx, ebx
    xor ecx, ecx
    xor edx ,edx
 	  mov eax, Inst
	  cpuid
	  mov A, eax
	  mov B, ebx
	  mov C, ecx
	  mov D, edx
    popf
    popad
  end;
	regs.regEAX:=A;
	regs.regEBX:=B;
	regs.regECX:=C;
	regs.regEDX:=D;
  except
    result:=false;
  end;
end;

//Dump cpuid flags for cpu with #index
function cCPUid.GetCPUdata(var fCPUdata: tCPUdata): boolean;
var
  i: byte;
begin
  result:=true;
  try
    for i:=0 to 5 do
      cpuid($00000000+i, fCPUdata.Standart[i]);
    for i:=0 to 8 do
      cpuid($80000000+i, fCPUdata.Extended[i]);
    for i:=0 to 7 do
      cpuid($80860000+i, fCPUdata.Transmeta[i]);
    for i:=0 to 1 do
      cpuid($C0000000+i, fCPUdata.Centaur[i]);
    for i:=$E to $F do
      cpuid($8FFFFFF0+i, fCPUdata.Mystery[i]);
  except
    result:=false;
  end;
end;

//Getting all system logical cpu count
function cCPUid.GetCPUCount: byte;
var
  si: _system_info; //System info for determination of cpu count
begin
  GetSystemInfo(si);
  result:=si.dwNumberOfProcessors; //Getting logical cpu count
end;

procedure cCPUid.UpdateClocks;
var
  TmpProcAff, TmpSysAff: DWord;
begin
  //Getting Current Affinity Mask
  if IsNT then GetProcessAffinityMask(GetCurrentThread, TmpProcAff, TmpSysAff);
  //Setting Affinity Mask
  if IsNT then SetThreadAffinityMask(GetCurrentThread, 1 shl ProcNum);

  fClocks.lpCpuFrequency:=GetCpuTSCFrequency;
  //Windows rdtsc bug
  //if (fClocks.lpCpuFrequency < 90) and (fCPUid_m.std_family in [6, 15]) and (oHWIO.isLoad) then fClocks.lpCpuFrequency:=GetCpuTSCMSRFrequency;

  GetMultiplier;

  if (fFlagBrand=amd) and (fCPUid_m.std_family=15) then  //A64
                                                           fClocks.DataRate:=GetA64HTRate(HyperTransport);

  if (fCPUid_m.std_family=15) and (fFlagBrand=intel) then //Enhanced Hall State
    begin
      if (fClocks.Multiplier <> 0) and (fClocks.MultiplierModulate <> 0) then
            fClocks.lpCpuFrequency:=fClocks.lpCpuFrequency*fClocks.Multiplier/fClocks.MultiplierOriginal;
    end;

  if fClocks.Multiplier<>0 then fClocks.Bus:=fClocks.lpCpuFrequency/fClocks.Multiplier
                           else fClocks.Bus:=0;

  fClocks.FSB:=fClocks.Bus*fClocks.DataRate;

  if IsNT then SetThreadAffinityMask(GetCurrentThread, TmpProcAff);
end;

procedure cCPUid.FillCPUInfo;
var
  TmpProcAff, TmpSysAff: DWord; //Affinity masks: process, system, and provisional PAM
begin
  //Getting Current Affinity Mask
  if IsNT then GetProcessAffinityMask(GetCurrentThread, TmpProcAff, TmpSysAff);
  //Setting Affinity Mask
  if IsNT then SetThreadAffinityMask(GetCurrentThread, 1 shl ProcNum);

  //ModulateCl:=true; //Make our CPU hotter :-)
  GetCPUdata(fCPUdata);
  DetectCPUVendor(fFlagBrand);
  GetExtInfo;
  GetPowerManag;
  GetCPUfeatures;
  GetFeaturesFlags;
  FillCacheInfo;
  GetCPUAdvData;
  //ModulateCl:=false;

  //Restoring Affinity Mask
  if IsNT then SetThreadAffinityMask(GetCurrentThread, TmpProcAff);
  ifStart:=false;
end;

//Getting advanced processor #index data
function cCPUid.GetCPUAdvData: boolean;
begin
  result:=true;
  try
    begin
      case fFlagBrand of
        amd: GetAMDAdvData;
        intel: GetIntelAdvData;
        transmeta: GetTransmetaAdvData;
        cyrix: GetVIAAdvData;
        umc: GetUMCAdvData;
        nexgen: GetNexgenAdvData;
        rise: GetRiseAdvData;
        sis: GetSisAdvData;
        national: GetNSCAdvData;
      end;
    end;
  except
    result:=false;
  end;
end;

//Class destructor
destructor cCPUid.Destroy;
begin
  @SetThreadAffinityMask:=nil;
  @SetProcessAffinityMask:=nil;
  @GetProcessAffinityMask:=nil;
  inherited Destroy;
end;

end.