⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fastcodecpuid.pas

📁 最快的Delphi快速处理源代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      (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 + -