unit cpuinfo;

{Author: Guido GYBELS, april 2001, All rights reserved.
 This unit offers some types and a global instance that
 uses the features of the CPUID instruction as it is
 implemented on modern Intel processors.
 By using the properties of the global CPUID object,
 application builders can quickly evaluate the features
 of the CPU their program is running on. This allows to
 optimise routines for specific CPU's.
 REVISION HISTORY:
 - april 2001, First version}

interface

uses Windows, Sysutils;

type
  {The TCPUIDResult record type contains fields that
   stores the values returned by the various levels of
   the CPUID instruction.}
  TCPUIDResult = packed record
   IsValid: ByteBool;
   HighestLevel: dWord;
   GenuineIntel: ByteBool;
   VendorID: packed array[0..11] of Char;
   ProcessorSignature: dWord;
   MiscInfo: dWord;
   FeatureFlags: packed array[0..1] of dWord;
   Stepping: Byte;
   Model: Byte;
   Family: Byte;
   ProcessorType: Byte;
   ExtendedModel: Byte;
   ExtendedFamily: Byte;
   FPUPresent: ByteBool;
   TimeStampCounter: ByteBool;
   CX8Supported: ByteBool;
   FastSystemCallSupported: ByteBool;
   CMOVSupported: ByteBool;
   FCOMISupported: ByteBool;
   MMXSupported: ByteBool;
   SSESupported: ByteBool;
   SSE2Supported: ByteBool;
   SerialNumberEnabled: ByteBool;
   CacheDescriptors: packed array[0..47] of Byte;
   SerialNumber: packed array[0..1] of dWord;
  end;
  TCPUType = (ctOriginal, ctOverDrive, ctDualProcessor, ctUnknown);
  TCPUFamily = (cfUnknown, cf486, cfPentium, cfPentiumPro, cfPentium4);
  TCPUFeature = (ftFPU, ftTSC, ftCX8, ftFSC, ftCMOV, ftFCOMI, ftMMX, ftSSE, ftSSE2, ftSerialNumber);
  TCacheSize = (caSizeUnknown, caNoCache, Ca128K, Ca256K, ca512K, ca1M, ca2M);
  TCPUBrandID = (brUnsupported, brCeleron, brP3, brP3Xeon, brP4);

  {The TCPUID class is the class for the global CPUID instance
   that is created by this unit and that offers several properties
   usefull in identifying the CPU your application is running on.
   Application builders should use the global CPUID object since
   there is no need to create new, additional, instances of this
   class (because they would simply return an identical object).
   All properties are read-only since it is impossible to change
   the CPU characteristics.}
  TCPUID = class
  private
   FCPUIDResult: TCPUIDResult;
   function GetBooleanField(Index: Integer): Boolean;
   function GetCPUBrand: TCPUBrandID;
   function GetCPUFamily: TCPUFamily;
   function GetCPUType: TCPUType;
   function GetFeature(Index: TCPUFeature): Boolean;
   function GetIntegerField(Index: Integer): Integer;
   function GetLevel2Cache: TCacheSize;
   function GetProcessor: String;
   function GetSerialNumber: String;
   function GetVendorID: String;
  public
   constructor Create;
   property BrandID: TCPUBrandID read GetCPUBrand;
   property CanIdentify: Boolean index 0 read GetBooleanField;
   property CPUFamily: TCPUFamily read GetCPUFamily;
   property CPUID: TCPUIDResult read FCPUIDResult;
   property CPUType: TCPUType read GetCPUType;
   property Family: Integer index 3 read GetIntegerField;
   property Features[Index: TCPUFeature]: Boolean read GetFeature;
   property GenuineIntel: Boolean index 1 read GetBooleanField;
   property HighestIDLevel: Integer index 0 read GetIntegerField;
   property CacheSize: TCacheSize read GetLevel2Cache;
   property Model: Integer index 2 read GetIntegerField;
   property Processor: String read GetProcessor;
   property SerialNumber: String read GetSerialNumber;
   property Stepping: Integer index 1 read GetIntegerField;
   property VendorID: String read GetVendorID;
  end;

var
  CPUID: TCPUID;

implementation

const
  SizeOfTCPUIDResult = SizeOf(TCPUIDResult);

{GetCPUIDResult is a basm routine that performs the actual
CPUID calls and stores the results in a record of type
TCPUIDResult. If the CPUID instruction is supported by the
processor, this routine will call it for every value of
eax allowed for that processor, making one call for each
value and storing the results in the record. Only for eax=2
is it possible that multiple calls are performed in order
to get to all the cache descriptors.
More information about the CPUID function can be found in
the Intel Application Note AP-485.}
function GetCPUIDResult: TCPUIDResult;
var
 Counter: Byte;
asm
 push ebx  {changes all general registers...}
 push edi  {...so, make sure we save what needs to be preserved}
 push esi
 mov edi,eax {pointer to result in edi}
 mov ecx,SizeOfTCPUIDResult
 mov esi,edi {zero the entire record out}
 add esi,ecx
 neg ecx
@loop:
 mov BYTE PTR [esi+ecx],0
 inc ecx
 jnz @loop
 pushfd {test if bit 21 of extended flags}
 pop eax {can toggle. If yes, then cpuid is supported}
 mov ebx,eax
 xor eax,1 shl 21
 push eax
 popfd
 pushfd
 pop eax
 xor eax,ebx
 and eax,1 shl 21 {Only if bit 21 can toggle...}
 setnz TCPUIDResult(edi).IsValid {...are the results valid}
 jz @ending {don't continue if cpuid is not supported}
 xor eax,eax {eax=0: get highest value and Vendor ID}
 db $0f,$a2 {cpuid}
 mov DWORD PTR TCPUIDResult(edi).VendorID,ebx
 mov DWORD PTR TCPUIDResult(edi).VendorID+4,edx
 mov DWORD PTR TCPUIDResult(edi).VendorID+8,ecx
 xor ebx,$756e6547 {Check if Vendor is Intel...}
 xor edx,$49656e69
 xor ecx,$6c65746e
 or ebx,edx
 or ebx,ecx
 test ebx,ebx
 setz TCPUIDResult(edi).GenuineIntel {...and set boolean accordingly}
 mov TCPUIDResult(edi).HighestLevel,eax {also save highest level...}
 cmp eax,0
 setnz TCPUIDResult(edi).IsValid {...and if it is 0, results not valid}
 jz @ending {if level 1 is not supported, bail out}
 mov eax,1
 db $0f,$a2 {cpuid} {else get processor signature and feature flags}
 mov TCPUIDResult(edi).ProcessorSignature,eax
 mov TCPUIDResult(edi).MiscInfo,ebx
 mov DWORD PTR TCPUIDResult(edi).FeatureFlags,ecx
 mov DWORD PTR TCPUIDResult(edi).FeatureFlags+4,edx
 mov ebx,eax {Then isolate the various items from...}
 and al,$0f {...the processor signature into their fields}
 mov TCPUIDResult(edi).Stepping,al
 mov eax,ebx
 shr eax,4
 and al,$0f
 mov TCPUIDResult(edi).Model,al
 mov eax,ebx
 shr eax,8
 and al,$0f
 mov TCPUIDResult(edi).Family,al
 mov eax,ebx
 shr eax,12
 and al,$03
 mov TCPUIDResult(edi).ProcessorType,al
 mov eax,ebx
 shr eax,16
 and al,$0f
 mov TCPUIDResult(edi).ExtendedModel,al
 mov eax,ebx
 shr eax,20
 mov TCPUIDResult(edi).ExtendedFamily,al
 test edx,1 {Next, check various feature bits and set their...}
 setnz TCPUIDResult(edi).FPUPresent {...respective flags in the record}
 test edx,1 shl 4
 setnz TCPUIDResult(edi).TimeStampCounter
 test edx,1 shl 8
 setnz TCPUIDResult(edi).CX8Supported
 test edx,1 shl 11
 setnz TCPUIDResult(edi).FastSystemCallSupported
 test edx,1 shl 15
 setnz TCPUIDResult(edi).CMOVSupported
 mov eax,edx
 and eax,(1 shl 15) or 1
 cmp eax,(1 shl 15) or 1
 setz TCPUIDResult(edi).FCOMISupported
 test edx,1 shl 18
 setnz TCPUIDResult(edi).SerialNumberEnabled
 test edx,1 shl 23
 setnz TCPUIDResult(edi).MMXSupported
 test edx,1 shl 25
 setnz TCPUIDResult(edi).SSESupported
 test edx,1 shl 26
 setnz TCPUIDResult(edi).SSE2Supported
 cmp TCPUIDResult(edi).HighestLevel,2 {If eax=2 is not supported...}
 jl @ending {...then bail out}
 lea esi,TCPUIDResult(edi).CacheDescriptors
 mov eax,2 {else get the cache descriptors}
 db $0f,$a2 {cpuid}
 and al,3 {first time, al will hold a counter...}
 mov [Counter],al {...that tells us how often we should...}
 xor al,al {...call with eax=2 to get all descriptors...}
@nextdescriptor:
 test eax,1 shl 31 {If bit 31 is set, then no valid descriptors...}
 jnz @invalidA {...so skip this register}
 mov DWORD PTR [esi],eax
@invalidA:
 test ebx,1 shl 31
 jnz @invalidB
 mov DWORD PTR [esi+4],ebx
@invalidB:
 test ecx,1 shl 31
 jnz @invalidC
 mov DWORD PTR [esi+8],ecx
@invalidC:
 test edx,1 shl 31
 jnz @invalidD
 mov DWORD PTR [esi+12],edx
@invalidD:
 add esi,16
 dec [Counter] {...see if there are more descriptors...}
 jz @descriptorsfull {...if not, continue with next step}
 db $0f,$a2 {cpuid} {...else, get next serie of descriptors}
 jmp @nextdescriptor
@descriptorsfull:
 cmp TCPUIDResult(edi).HighestLevel,3 {see if serial number...}
 jl @ending {...is supported. If not, bail out.}
 mov eax,3 {else get lower 64 bits of serial number...}
 db $0f,$a2 {cpuid} {upper 32 bits = processor signature}
 mov DWORD PTR TCPUIDResult(edi).SerialNumber,ecx {...and store them}
 mov DWORD PTR TCPUIDResult(edi).SerialNumber+4,edx
@ending:
 pop esi
 pop edi
 pop ebx
end;

{TCPUID}
resourcestring
 rsUnknownVendor = 'UnknownVendor';

constructor TCPUID.Create;
begin
 inherited;
 FCPUIDResult:=GetCPUIDResult;
end;

function TCPUID.GetBooleanField(Index: Integer): Boolean;
begin
  case Index of
   0: {CanIdentify} Result:=FCPUIDResult.IsValid;
   1: {GenuineIntel} Result:=FCPUIDResult.GenuineIntel;
  else
   Result:=False;
  end;
end;

function TCPUID.GetIntegerField(Index: Integer): Integer;
begin
  case Index of
   0: {HighestLevel} Result:=FCPUIDResult.HighestLevel;
   1: {Stepping} Result:=FCPUIDResult.Stepping;
   2: {Model} if FCPUIDResult.Model=15 then Result:=FCPUIDResult.ExtendedModel
        else Result:=FCPUIDResult.Model;
   3: {Family} if FCPUIDResult.Family=15 then Result:=15+FCPUIDResult.ExtendedFamily
        else Result:=FCPUIDResult.Family;
  else
   Result:=0;
  end;
end;

function TCPUID.GetVendorID: String;
begin
 if CanIdentify then Result:=FCPUIDResult.VendorID
 else Result:=rsUnknownVendor;
end;

function TCPUID.GetCPUType: TCPUType;
begin
 case FCPUIDResult.Processortype of
  1: Result:=ctOverdrive;
  2: Result:=ctDualProcessor;
  3: Result:=ctUnknown;
 else
  Result:=ctOriginal;
 end;
end;

function TCPUID.GetCPUFamily: TCPUFamily;
begin
 case FCPUIDResult.Family of
  4: Result:=cf486;
  5: Result:=cfPentium;
  6: Result:=cfPentiumPro;
  15: case FCPUIDResult.ExtendedFamily of
       0: Result:=cfPentium4;
      else
       Result:=cfUnknown;
      end;
 else
  Result:=cfUnknown;
 end;
end;

function TCPUID.GetFeature(Index: TCPUFeature): Boolean;
begin
 case Index of
  ftFPU: Result:=FCPUIDResult.FPUPresent;
  ftTSC: Result:=FCPUIDResult.TimeStampCounter;
  ftCX8: Result:=FCPUIDResult.CX8Supported;
  ftFSC: Result:=FCPUIDResult.FastSystemCallSupported;
  ftCMOV: Result:=FCPUIDResult.CMOVSupported;
  ftFCOMI: Result:=FCPUIDResult.FCOMISupported;
  ftMMX: Result:=FCPUIDResult.MMXSupported;
  ftSSE: Result:=FCPUIDResult.SSESupported;
  ftSSE2: Result:=FCPUIDResult.SSE2Supported;
  ftSerialNumber: Result:=FCPUIDResult.SerialNumberEnabled;
 else
  Result:=False;
 end;
end;

function TCPUID.GetProcessor: String;
begin
 if GenuineIntel then Result:='Intel ' else Result:='';
 case CPUFamily of
  cf486: case Model of
    0..1: Result:=Result+'80486DX';
    2: Result:=Result+'80486SX';
    3: Result:=Result+'80486DX2';
    4: Result:=Result+'80486SL';
    5: Result:=Result+'80486SX2';
    7: Result:=Result+'80486DX2/WB-Enh';
    8: Result:=Result+'80486DX4';
   else
    Result:=Result+'80486';
   end;
  cfPentium: if Features[ftMMX] then Result:=Result+'Pentium MMX' else Result:=Result+'Pentium';
  cfPentiumPro: case Model of
    1: Result:=Result+'Pentium Pro';
    3..4: Result:=Result+'Pentium II, Model '+IntToStr(Model);
    5: case CacheSize of
        caNoCache: Result:='Celeron, Model 5';
        ca1M, ca2M: Result:='Pentium II Xeon, Model 5';
       else
        Result:=Result+'Pentium II, Model 5';
       end;
    6: Result:=Result+'Celeron, Model 6';
    7: case CacheSize of
        ca1M, ca2M: Result:=Result+'Pentium III Xeon, Model 7';
       else
        Result:=Result+'Pentium III, Model 7';
       end;
    8: case BrandID of
        brCeleron: Result:=Result+'Celeron, Model 8';
        brP3Xeon: Result:=Result+'Pentium III Xeon, Model 8';
       else
        Result:=Result+'Pentium III, Model 8';
       end;
    9: Result:=Result+'Pentium III Xeon, Model A';
   else
    Result:=Result+'Pentium Pro';
   end;
  cfPentium4: Result:=Result+'Pentium 4';
 else
  Result:=Result+'Unknown CPU';
 end;
 case CPUType of
  ctOverDrive: Result:=Result+' OverDrive';
  ctDualProcessor: Result:=Result+' Dual CPU';
 end;
 Result:=Result+' (Stepping '+IntToStr(Stepping)+')';
end;

function TCPUID.GetLevel2Cache: TCacheSize;
var
 I,M,S: Integer;
 F: Boolean;
begin
 Result:=caSizeUnknown;
 M:=0;
 S:=0;
 F:=False;
 for I:=Low(FCPUIDResult.CacheDescriptors) to High(FCPUIDResult.CacheDescriptors) do begin
  if FCPUIDResult.CacheDescriptors[I]<>0 then F:=True;
  case FCPUIDResult.CacheDescriptors[I] of
   $40: begin
         M:=0;
         break;
        end;
   $41,$79: S:=128;
   $42,$7a,$82: S:=256;
   $43,$7b: S:=512;
   $44,$7c,$84: S:=1024;
   $45,$85: S:=2048;
  end;
  if S>M then M:=S;
 end;
 if F then case M of
  0: Result:=caNoCache;
  128: Result:=ca128K;
  256: Result:=ca256K;
  512: Result:=ca512K;
  1024: Result:=ca1M;
  2048: Result:=ca2M;
 end;
end;

function GetNibbleGroup(I: Integer): String;
var
 T: Integer;
begin
 T:=(I and $FFFF0000) shr 16;
 Result:=IntToHex(T,4);
 T:=(I and $FFFF);
 Result:=Result+'-'+IntToHex(T,4);
end;

function TCPUID.GetSerialNumber: String;
begin
 if Features[ftSerialNumber] then begin
  Result:=GetNibbleGroup(FCPUIDResult.ProcessorSignature);
  Result:=Result+'-'+GetNibbleGroup(FCPUIDResult.SerialNumber[1]);
  Result:=Result+'-'+GetNibbleGroup(FCPUIDResult.SerialNumber[0]);
 end else Result:='';
end;

function TCPUID.GetCPUBrand: TCPUBrandID;
var
 I: Integer;
begin
 if (Family>6) or ((Family=6) and (Model>7)) then begin
   I:=FCPUIDResult.MiscInfo and 255;
   case I of
    1: Result:=brCeleron;
    2: Result:=brP3;
    3: Result:=brP3Xeon;
    8: Result:=brP4;
   else
    Result:=brUnsupported;
   end;
 end else Result:=brUnsupported;
end;

initialization
 CPUID:=TCPUID.Create;
finalization
 CPUID.Free;

end.
