📄 fastcodecpuid.pas
字号:
(CPU.Signature and $0FFF3FFF < IntelLowestSEPSupportSignature) then
Exclude(CPU.InstructionSupport, isSEP);
end;
if cfCMOV in CpuFeatures then
Include(CPU.InstructionSupport, isCMOV);
if cfFXSR in CpuFeatures then
Include(CPU.InstructionSupport, isFXSR);
if cfMMX in CpuFeatures then
Include(CPU.InstructionSupport, isMMX);
if cfSSE in CpuFeatures then
Include(CPU.InstructionSupport, isSSE);
if cfSSE2 in CpuFeatures then
Include(CPU.InstructionSupport, isSSE2);
if cfSSE3 in CpuFeatures then
Include(CPU.InstructionSupport, isSSE3);
if (CPU.Vendor = cvIntel) and (cfMON in CpuFeatures) then
Include(CPU.InstructionSupport, isMONITOR);
if cfCX16 in CpuFeatures then
Include(CPU.InstructionSupport, isCX16);
end;
procedure GetCPUExtendedFeatures;
{preconditions: maximum extended CPUID >= $80000001}
var
Registers: TRegisters;
CpuExFeatures: TCpuExtendedFeatureSet;
begin
{call CPUID function $80000001}
GetCPUID($80000001, Registers);
{get CPU extended features}
CPUExFeatures := TCPUExtendedFeatureSet(Registers.EDX);
{get instruction support}
if cefLM in CpuExFeatures then
Include(CPU.InstructionSupport, isX64);
if cefExMMX in CpuExFeatures then
Include(CPU.InstructionSupport, isExMMX);
if cefEx3DNow in CpuExFeatures then
Include(CPU.InstructionSupport, isEx3DNow);
if cef3DNow in CpuExFeatures then
Include(CPU.InstructionSupport, is3DNow);
end;
procedure GetProcessorCacheInfo;
{preconditions: 1. maximum CPUID must be at least $00000002
2. GetCPUVendor must have been called}
type
TConfigDescriptor = packed array[0..15] of Byte;
var
Registers: TRegisters;
i, j: Integer;
QueryCount: Byte;
begin
{call CPUID function 2}
GetCPUID($00000002, Registers);
QueryCount := Registers.EAX and $FF;
for i := 1 to QueryCount do
begin
for j := 1 to 15 do
with CPU do
{decode configuration descriptor byte}
case TConfigDescriptor(Registers)[j] of
$06: CodeL1CacheSize := 8;
$08: CodeL1CacheSize := 16;
$0A: DataL1CacheSize := 8;
$0C: DataL1CacheSize := 16;
$22: L3CacheSize := 512;
$23: L3CacheSize := 1024;
$25: L3CacheSize := 2048;
$29: L3CacheSize := 4096;
$2C: DataL1CacheSize := 32;
$30: CodeL1CacheSize := 32;
$39: L2CacheSize := 128;
$3B: L2CacheSize := 128;
$3C: L2CacheSize := 256;
$40: {no 2nd-level cache or, if processor contains a valid 2nd-level
cache, no 3rd-level cache}
if L2CacheSize <> 0 then
L3CacheSize := 0;
$41: L2CacheSize := 128;
$42: L2CacheSize := 256;
$43: L2CacheSize := 512;
$44: L2CacheSize := 1024;
$45: L2CacheSize := 2048;
$60: DataL1CacheSize := 16;
$66: DataL1CacheSize := 8;
$67: DataL1CacheSize := 16;
$68: DataL1CacheSize := 32;
$70: if not (CPU.Vendor in [cvCyrix, cvNSC]) then
CodeL1CacheSize := 12; {K micro-ops}
$71: CodeL1CacheSize := 16; {K micro-ops}
$72: CodeL1CacheSize := 32; {K micro-ops}
$78: L2CacheSize := 1024;
$79: L2CacheSize := 128;
$7A: L2CacheSize := 256;
$7B: L2CacheSize := 512;
$7C: L2CacheSize := 1024;
$7D: L2CacheSize := 2048;
$7F: L2CacheSize := 512;
$80: if CPU.Vendor in [cvCyrix, cvNSC] then
begin {Cyrix and NSC only - 16 KB unified L1 cache}
CodeL1CacheSize := 8;
DataL1CacheSize := 8;
end;
$82: L2CacheSize := 256;
$83: L2CacheSize := 512;
$84: L2CacheSize := 1024;
$85: L2CacheSize := 2048;
$86: L2CacheSize := 512;
$87: L2CacheSize := 1024;
end;
if i < QueryCount then
GetCPUID(2, Registers);
end;
end;
procedure GetExtendedProcessorCacheInfo;
{preconditions: 1. maximum extended CPUID must be at least $80000006
2. GetCPUVendor and GetCPUFeatures must have been called}
var
Registers: TRegisters;
begin
{call CPUID function $80000005}
GetCPUID($80000005, Registers);
{get L1 cache size}
{Note: Intel does not support function $80000005 for L1 cache size, so ignore.
Cyrix returns CPUID function 2 descriptors (already done), so ignore.}
if not (CPU.Vendor in [cvIntel, cvCyrix]) then
begin
CPU.CodeL1CacheSize := Registers.EDX shr 24;
CPU.DataL1CacheSize := Registers.ECX shr 24;
end;
{call CPUID function $80000006}
GetCPUID($80000006, Registers);
{get L2 cache size}
if (CPU.Vendor = cvAMD) and (CPU.Signature and $FFF = K7DuronA0Signature) then
{workaround for AMD Duron Rev A0 L2 cache size erratum - see AMD Technical
Note TN-13}
CPU.L2CacheSize := 64
else if (CPU.Vendor = cvCentaur) and (CPU.EffFamily = 6) and
(CPU.EffModel in [C3Samuel2EffModel, C3EzraEffModel]) then
{handle VIA (Centaur) C3 Samuel 2 and Ezra non-standard encoding}
CPU.L2CacheSize := Registers.ECX shr 24
else {standard encoding}
CPU.L2CacheSize := Registers.ECX shr 16;
end;
procedure VerifyOSSupportForXMMRegisters;
begin
{try a SSE instruction that operates on XMM registers}
try
asm
DB $0F, $54, $C0 // ANDPS XMM0, XMM0
end
except
on E: Exception do
begin
{if it fails, assume that none of the SSE instruction sets are available}
Exclude(CPU.InstructionSupport, isSSE);
Exclude(CPU.InstructionSupport, isSSE2);
Exclude(CPU.InstructionSupport, isSSE3);
end;
end;
end;
procedure GetCPUInfo;
var
Registers: TRegisters;
MaxCPUID: Cardinal;
MaxExCPUID: Cardinal;
begin
{initialize - just to be sure}
FillChar(CPU, SizeOf(CPU), 0);
try
if not IsCPUID_Available then
begin
if IsFPU_Available then
Include(CPU.InstructionSupport, isFPU);
end
else
begin
{get maximum CPUID input value}
GetCPUID($00000000, Registers);
MaxCPUID := Registers.EAX;
{get CPU vendor - Max CPUID will always be >= 0}
GetCPUVendor;
{get CPU features if available}
if MaxCPUID >= $00000001 then
GetCPUFeatures;
{get cache info if available}
if MaxCPUID >= $00000002 then
GetProcessorCacheInfo;
{get maximum extended CPUID input value}
GetCPUID($80000000, Registers);
MaxExCPUID := Registers.EAX;
{get CPU extended features if available}
if MaxExCPUID >= $80000001 then
GetCPUExtendedFeatures;
{verify operating system support for XMM registers}
if isSSE in CPU.InstructionSupport then
VerifyOSSupportForXMMRegisters;
{get extended cache features if available}
{Note: ignore processors that only report L1 cache info,
i.e. have a MaxExCPUID = $80000005}
if MaxExCPUID >= $80000006 then
GetExtendedProcessorCacheInfo;
end;
except
on E: Exception do
{silent exception - should not occur, just ignore}
end;
end;
procedure GetFastCodeTarget;
{precondition: GetCPUInfo must have been called}
begin
{as default, select blended target if there is at least FPU, MMX, and CMOV
instruction support, otherwise select RTL Replacement target}
if [isFPU, isMMX, isCMOV] <= CPU.InstructionSupport then
FastCodeTarget := fctBlended
else
FastCodeTarget := fctRTLReplacement;
case CPU.Vendor of
cvIntel:
case CPU.EffFamily of
6: {Intel P6, P2, P3, PM}
if CPU.EffModel in [PMBaniasEffModel, PMDothanEffModel] then
FastCodeTarget := fctPM
else if CPU.EffModel >= P3LowestEffModel then
FastCodeTarget := fctP3;
$F: {Intel P4}
if isX64 in CPU.InstructionSupport then
FastCodeTarget := fctP4_64
else if isSSE3 in CPU.InstructionSupport then
FastCodeTarget := fctP4_SSE3
else
FastCodeTarget := fctP4;
end;
cvAMD:
case CPU.EffFamily of
6: {AMD K7}
if isSSE in CPU.InstructionSupport then
FastCodeTarget := fctK7_SSE
else
FastCodeTarget := fctK7;
$F: {AMD K8}
if isSSE3 in CPU.InstructionSupport then
FastCodeTarget := fctK8_SSE3
else
FastCodeTarget := fctK8;
end;
end;
end;
initialization
GetCPUInfo;
GetFastCodeTarget;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -