home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / SYSINFO.ZIP / CPUTYP.PAS next >
Pascal/Delphi Source File  |  1996-01-11  |  6KB  |  174 lines
  1. unit Cputyp;
  2.  
  3. { This code comes from Intel, and has been modified for Delphi's
  4.   inline assembler.  Since Intel made the original code freely
  5.   available, I am making my changes freely available.
  6.  
  7.   Share and enjoy!
  8.  
  9.   Ray Lischner
  10.   Tempest Software
  11.   6/18/95
  12. }
  13.  
  14. interface
  15.  
  16. type
  17.   { All the types currently known.  As new types are created,
  18.     add suitable names, and extend the case statement in
  19.     CpuTypeString. }
  20.   TCpuType = (cpu8086, cpu80286, cpu386, cpu486, cpuPentium);
  21.  
  22. { Return the type of the current CPU }
  23. function CpuType: TCpuType;
  24.  
  25. { Return the type as a short string }
  26. function CpuTypeString: String;
  27.  
  28. implementation
  29.  
  30. uses SysUtils;
  31.  
  32. function CpuType: TCpuType; assembler;
  33. asm
  34.   push DS
  35.  
  36. { First check for an 8086 CPU }
  37. { Bits 12-15 of the FLAGS register are always set on the }
  38. { 8086 processor. }
  39.   pushf                       { save EFLAGS }
  40.   pop        bx               { store EFLAGS in BX }
  41.   mov        ax,0fffh           { clear bits 12-15 }
  42.   and        ax,bx               { in EFLAGS }
  43.   push          ax               { store new EFLAGS value on stack }
  44.   popf                        { replace current EFLAGS value }
  45.   pushf                       { set new EFLAGS }
  46.   pop        ax               { store new EFLAGS in AX }
  47.   and        ax,0f000h           { if bits 12-15 are set, then CPU }
  48.   cmp        ax,0f000h           { is an 8086/8088 }
  49.   mov             ax, cpu8086            { turn on 8086/8088 flag }
  50.   je        @@End_CpuType
  51.  
  52.   { 80286 CPU check }
  53.   { Bits 12-15 of the FLAGS register are always clear on the }
  54.   { 80286 processor. }
  55.   or        bx,0f000h            { try to set bits 12-15 }
  56.   push          bx
  57.   popf
  58.   pushf
  59.   pop        ax
  60.   and        ax,0f000h          { if bits 12-15 are cleared, CPU=80286 }
  61.   mov             ax, cpu80286          { turn on 80286 flag }
  62.   jz        @@End_CpuType
  63.  
  64.   { To test for 386 or better, we need to use 32 bit instructions,
  65.     but the 16-bit Delphi assembler does not recognize the 32 bit opcodes
  66.     or operands.  Instead, use the 66H operand size prefix to change
  67.     each instruction to its 32-bit equivalent. For 32-bit immediate
  68.     operands, we also need to store the high word of the operand immediately
  69.     following the instruction.  The 32-bit instruction is shown in a comment
  70.     after the 66H instruction. }
  71.  
  72.   { i386 CPU check }
  73.   { The AC bit, bit #18, is a new bit introduced in the EFLAGS }
  74.   { register on the i486 DX CPU to generate alignment faults. }
  75.   { This bit can not be set on the i386 CPU. }
  76.  
  77.   db    66h                    { pushfd }
  78.   pushf
  79.   db    66h                    { pop eax }
  80.   pop    ax                   { get original EFLAGS }
  81.   db    66h                    { mov ecx, eax }
  82.   mov    cx,ax               { save original EFLAGS }
  83.   db    66h                    { xor eax,40000h }
  84.   xor    ax,0h                  { flip AC bit in EFLAGS }
  85.   dw    0004h
  86.   db    66h                    { push eax }
  87.   push  ax               { save for EFLAGS }
  88.   db    66h                    { popfd }
  89.   popf                   { copy to EFLAGS }
  90.   db    66h                    { pushfd }
  91.   pushf                              { push EFLAGS }
  92.   db    66h                    { pop eax }
  93.   pop    ax                     { get new EFLAGS value }
  94.   db    66h                    { xor eax,ecx }
  95.   xor    ax,cx                   { can't toggle AC bit, CPU=Intel386 }
  96.   mov   ax,cpu386              { turn on 386 flag }
  97.   je @@End_CpuType
  98.  
  99. { i486 DX CPU / i487 SX MCP and i486 SX CPU checking }
  100. { Checking for ability to set/clear ID flag (Bit 21) in EFLAGS }
  101. { which indicates the presence of a processor }
  102. { with the ability to use the CPUID instruction. }
  103.   db   66h                     { pushfd }
  104.   pushf                       { push original EFLAGS }
  105.   db   66h                     { pop eax }
  106.   pop  ax               { get original EFLAGS in eax }
  107.   db   66h                     { mov ecx, eax }
  108.   mov  cx,ax               { save original EFLAGS in ecx }
  109.   db   66h                     { xor eax,200000h }
  110.   xor  ax,0h                   { flip ID bit in EFLAGS }
  111.   dw   0020h
  112.   db   66h                     { push eax }
  113.   push ax               { save for EFLAGS }
  114.   db   66h                     { popfd }
  115.   popf                   { copy to EFLAGS }
  116.   db   66h                     { pushfd }
  117.   pushf                        { push EFLAGS }
  118.   db   66h                     { pop eax }
  119.   pop  ax               { get new EFLAGS value }
  120.   db   66h                     { xor eax, ecx }
  121.   xor  ax, cx
  122.   mov  ax, cpu486              { turn on i486 flag }
  123.   je @@End_CpuType           { if ID bit cannot be changed, CPU=486
  124. }
  125.                    { without CPUID instruction functionality }
  126.  
  127. { Execute CPUID instruction to determine vendor, family, }
  128. { model and stepping.  The use of the CPUID instruction used }
  129. { in this program can be used for B0 and later steppings }
  130. { of the P5 processor. }
  131.   db  66h                      { mov eax, 1 }
  132.   mov ax, 1               { set up for CPUID instruction }
  133.   dw  0
  134.   db  66h                      { cpuid }
  135.   db  0Fh                   { Hardcoded opcode for CPUID
  136. instruction }
  137.   db  0a2h
  138.   db  66h                      { and eax, 0F00H }
  139.   and ax, 0F00H                   { mask everything but family }
  140.   dw  0
  141.   db  66h                      { shr eax, 8 }
  142.   shr ax, 8                    { shift the cpu type down to the low byte }
  143.   sub ax, 1                    { subtract 1 to map to TCpuType }
  144.  
  145. @@End_CpuType:
  146.   pop ds
  147. end;
  148.  
  149. function CpuTypeString: String;
  150. var
  151.   kind: TCpuType;
  152. begin
  153.   kind := CpuType;
  154.   case kind of
  155.   cpu8086:
  156.     Result := '8086';
  157.   cpu80286:
  158.     Result := '80286';
  159.   cpu386:
  160.     Result := '386';
  161.   cpu486:
  162.     Result := '486';
  163.   cpuPentium:
  164.     Result := 'Pentium';
  165.   else
  166.     { Try to be flexible for future cpu types, e.g., P6. }
  167.     Result := Format('P%d', [Ord(kind)]);
  168.   end;
  169. end;
  170.  
  171. end.
  172.  
  173.  
  174.