Code:

function PortInByte(PortAddress: Word): Byte;

asm

mov dx,ax

in al,dx

end;

procedure PortOutByte(PortAddress: Word; Data: Byte);

asm

xchg dx,ax

out dx,al

end;

Code:

function CountBits(const Value: Integer): Integer;

asm

mov ECX,EAX

xor EAX,EAX

test ECX,ECX

jz @@ending

@@counting:

shr ECX,1

adc EAX,0

test ECX,ECX

jnz @@counting

@@ending:

end;

Code:

function IsBit(Value, Pos: Integer): Boolean;

asm

mov ECX,EAX

xor EAX,EAX

and EDX,31

bt ECX,EDX

adc EAX,0

end;

Code:

function SetBit(const Value, Pos: Integer): Integer;

asm

and        EDX,31

bts        EAX,EDX

end;

Code:

function ClearBit(const Value, Pos: Integer): Integer;

asm

and        EDX,31

btr        EAX,EDX

end;

Code:

function ExtractBits(const Value, Start, Count: Integer): Integer;

const

Mask: array[0..31] of Integer =

                           ($01,$03,$07,$0F,$1F,$3F,$7F,$FF,

                            $01FF,$03FF,$07FF,$0FFF,$1FFF,$3FFF,$7FFF,$FFFF,

                            $01FFFF,$03FFFF,$07FFFF,$0FFFFF,

                            $1FFFFF,$3FFFFF,$7FFFFF,$FFFFFF,

                            $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,

                            $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);

asm

xchg ECX,EDX

test EDX,EDX

jnz @@isoke

xor EAX,EAX

jmp @@ending

@@isoke:

dec EDX

and EDX,31

shr EAX,cl

and EAX,dword ptr [Mask+EDX*4]

@@ending:

end;

Code:

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.