Unit L2Cache;
Interface
Function GetL2CacheSize :
String;
Implementation
uses
sysutils;
Function CheckForCPUID : Boolean;
Assembler;
Asm
push ebx
push ecx
pushfd
// save EFLAGS
pop eax
// store EFLAGS in EAX
mov ebx, eax
// save in EBX for later testing
xor eax, 00200000h
// toggle bit 21
push eax
// put to stack
popfd
// save changed EAX to ELFAGS
pushfd
// push EFLAGS on stack
pop ecx
// store EFLAGS in EAX
mov Result, False
cmp ecx, ebx
// see if bit 21 has changed
jz @@no_CPUID
// if no change, no CPUID
mov Result, True
// set flag
@@no_CPUID:
pop ecx
pop ebx
End;
Function GetL2CacheSize :
String;
Var
CPUID_VendorID :
Array[0..11]
Of Char;
MaxStdLevel,
MaxExtLevel : LongWord;
Function GetIntelCacheInfo :
String;
Var
CallCtr : Byte;
Regs :
array[0..3]
Of LongWord;
i : Integer;
KBSize : Word;
Function CacheInfo(CacheID : Byte): Word;
Begin
Case CacheID
Of
$39, $3B,
$41, $79 : Result := 128;
$3C, $42,
$7A, $82 : Result := 256;
$43, $7B,
$83, $86 : Result := 512;
$44, $7C,
$84, $87 : Result := 1024;
$85, $45 : Result := 2048;
Else
Result := 0;
End;
End;
Begin
Asm
push eax
push ebx
push ecx
push edx
mov eax, 2
db 00fh, 0a2h
mov CallCtr, al
mov Regs[0].longword, eax
mov Regs[1].longword, ebx
mov Regs[2].longword, ecx
mov Regs[3].longword, edx
pop edx
pop ecx
pop ebx
pop eax
End;
// CallCtr lass ich mal aussen vor, wird bisher noch nicht benutzt von Intel (also noch nicht > 1)
KBSize := 0;
If ( Regs[0]
And $80000000 ) = 0
Then
Begin
If ( ( Regs[0]
Shr 8 )
And $ff ) > 0
Then
Inc(KBSize, CacheInfo(( Regs[0]
Shr 8 )
And $ff));
If ( ( Regs[0]
Shr 16 )
And $ff ) > 0
Then
Inc(KBSize, CacheInfo(( Regs[0]
Shr 16 )
And $ff));
If ( ( Regs[0]
Shr 24 )
And $ff ) > 0
Then
Inc(KBSize, CacheInfo(( Regs[0]
Shr 24 )
And $ff));
End;
For i := 1
To 3
Do
Begin
If ( Regs[i]
And $80000000 ) = 0
Then
Begin
If ( ( Regs[i]
Shr 8 )
And $ff ) > 0
Then
Inc(KBSize, CacheInfo(( Regs[i]
Shr 8 )
And $ff));
If ( ( Regs[i]
Shr 16 )
And $ff ) > 0
Then
Inc(KBSize, CacheInfo(( Regs[i]
Shr 16 )
And $ff));
If ( ( Regs[i]
Shr 24 )
And $ff ) > 0
Then
Inc(KBSize, CacheInfo(( Regs[i]
Shr 24 )
And $ff));
End;
End;
If ( KBSize > 1000 )
Then
Result := IntToStr(KBSize) + '
KB'
Else
Result := IntToStr(KBSize
Div 1024) + '
MB';
End;
Function GetAMDCacheInfo :
String;
Var
KBSize : Word;
Begin
Asm
push eax
push ebx
push ecx
push edx
mov eax, 080000006h
db 00fh, 0a2h
shr ecx, 16
mov KBSize, cx
pop edx
pop ecx
pop ebx
pop eax
End;
If ( KBSize > 1000 )
Then
Result := IntToStr(KBSize) + '
KB'
Else
Result := IntToStr(KBSize
Div 1024) + '
MB';
End;
Begin
If ( CheckForCPUID )
Then
Begin
// Get Vendor
Asm
push eax
push ebx
push ecx
push edx
xor eax, eax
db 00fh, 0a2h
// CPUID
mov MaxStdLevel, eax
push edi
lea edi, CPUID_VendorID
cld
// bx, dx, cx
mov eax, ebx
stosd
mov eax, edx
stosd
mov eax, ecx
stosd
pop edi
mov eax, 080000000h
db 00fh, 0a2h
// CPUID
mov MaxExtLevel, eax
pop edx
pop ecx
pop ebx
pop eax
End;
If (
String(CPUID_VendorID) = '
GenuineIntel' )
Then
Begin
If ( MaxStdLevel >= 2 )
Then
Result := GetIntelCacheInfo
Else
Result := '
unkown';
End
Else If (
String(CPUID_VendorID) = '
AuthenticAMD' )
Then
Begin
If ( MaxExtLevel >= $80000006 )
Then // ab K6-III
Result := GetAMDCacheInfo
Else
Result := '
unkown';
End
Else If (
String(CPUID_VendorID) = '
CyrixInstead' )
Then
Begin
// habe die M2 doku nicht mehr gefunden und zum C2/C3 habe ich noch keine...
Result := '
no cache info';
End;
// Transmeta und weitere erstmal wegfallen lassen...
End
Else
Result := '
no CPUID support';
End;
End.