Èñïîëüçîâàíèå àññåìáëåðà â Äåëüôè
Ìîäóëü CpuInfo
Çäåñü ïðèâåäåíà ÷àñòü ïðîåêòà, ìîäóëü CpuInfo. Ïîëíîñòüþ ïðîåêò íàõîäèòñÿ íà ñàéòå Ãóéäî Ãàéáåëñà http://www.optimalcode.com/Guido/cpuinfo.html è â âèäå àðõèâà cpuinfo.zip âìåñòå ñ ýòîé êíèãîé.
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.
