UNIT _CpuId;

     {*****************************************************************}
     {******* _CpuId.pas (c)2001 Dutra de Lacerda <dulac@ip.pt> *******}
     {*******     CPU Identification Unit for general Usage     *******}
     {*******       Adapted from Borland's CPUID routines       *******}
     {*****************************************************************}

INTERFACE

Type
      TCpuTypeStr  = String[12];     {'PentiumClass ' has 12 chars}
      TVendorStr   = String[12];     {EBX,EDX,ECX regs -> 12 chars}

Const
      _8086       = 0 ;
      _80186      = 1 ;
      _286        = 2 ;
      _386        = 3 ;
      _486        = 4 ;
      _Pentium    = 5 ;

      CpuTypeArray : Array[0..5] of TCpuTypeStr =
                   ('8088/8086','80188','286','386','486','PentiumClass');

Type

      TVendor      = RECORD
                       CASE Boolean OF
                         True  : ( Str  : TVendorStr );
                         False : (
                                   Size : byte;
                                   Tag  : Array [0..5] of word;
                                 );
                     END;

      TCpuId       = OBJECT
                        Constructor Init;
                        Procedure   Test;
                        Function    GetType      : Byte;
                        Function    GetFamily    : Byte;
                        Function    GetModel     : Byte;
                        Function    GetStep      : Byte;
                        Function    GetVendor    : TVendorStr;
                        Function    GetTypeStr   : TCpuTypeStr;
                        Function    GetFamilyStr : TCpuTypeStr;
                        Destructor  Done;
                     Private
                        { Main Variables for Get_??? Functions }
                        _CpuType      : Byte;
                        _SavedCpuId   : integer;
                        _CpuFamily    : Byte;
                        _CpuModel     : Byte;
                        _CpuStep      : Byte;
                        _CpuTypeStr   : TCpuTypeStr;
                        _Vendor       : TVendor;
                        { Main Procedures called by TestCPU }
                        Procedure _GetCpuId;    VIRTUAL;
                     END;

IMPLEMENTATION

{ ========================== TCpuId Object ======================== }



Constructor TCpuId.Init;
   Begin
   Test;
   End;


Procedure   TCpuId.Test;
   Begin
   _Vendor.Size := 0;
   _GetCpuId;
   End;


Function    TCpuId.GetType    : Byte;
   Begin
   GetType := _CpuType;
   End;


Function    TCpuId.GetFamily    : Byte;
   Begin
   GetFamily := _CpuFamily;
   End;


Function    TCpuId.GetModel     : Byte;
   Begin
   GetModel := _CpuModel;
   End;


Function    TCpuId.GetStep      : Byte;
   Begin
   GetStep := _CpuStep;
   End;


Function    TCpuId.GetVendor    : TVendorStr;
   Begin
   GetVendor := _Vendor.Str;
   End;


Function    TCpuId.GetTypeStr : TCpuTypeStr;
   Begin
   GetTypeStr := CpuTypeArray[_CpuType];
   End;


Function    TCpuId.GetFamilyStr : TCpuTypeStr;
   Var S : TCpuTypeStr;
   Begin
   S := CpuTypeArray[_CpuType];
   If _CpuType >= 5 then
      Begin
      S := '?86';
      S[1] := chr(_CpuFamily + ord('0'));
      End;
   GetFamilyStr := S;
   End;


Procedure   TCpuId._GetCpuId;
   Var

   CpuType    : Byte;
   CpuTypeStr : TCpuTypeStr;
   SavedCpuId : integer;

   CpuFamily  : Byte;
   CpuModel   : Byte;
   CpuStep    : Byte;

   VStr       : TVendorStr;
   pVStr      : ^TVendorStr;

   Begin
     pVStr := @VStr;
     ASM
   (*
    *   8086 CPU check
    *   Bits 12-15 are always set on the 8086 processor
    *)

   @Check_8086:
     { and     sp, not 3              ; align stack to avoid AC fault }
     mov    CpuType, al             (*  save the CPU type              *)

     pushf                          (* save FLAGS                      *)
     pop    bx                      (* store FLAGS in BX               *)
     mov    ax, 0fffh               (* clear bits 12-15                *)
     and    ax, bx                  (*   in FLAGS                      *)
     push   ax                      (* store new FLAGS calue on stack  *)
     popf                           (* replace current FLAGS value     *)
     pushf                          (* set new flags                   *)
     pop    ax                      (* store new flags in AX           *)
     and    ax, 0f000h              (* if bits 12-15 are set, then CPU *)
     cmp    ax, 0f000h              (*   is an 8086/8088               *)

     jne    @check_286
     jmp    @Terminate


   (*
    *   Intel 286 CPU check
    *   Bits 12-15 are always clear on the Intel processor.
    *)

   @Check_286:
     { and     sp, not 3              ; align stack to avoid AC fault }
     or      bx, 0f000h              (* try to set bits 12-15           *)
     push    bx
     popf
     pushf
     pop     ax
     and     ax, 0f000h              (*  if bits 12-15 are cleared,     *)
                                     (*        CPU=Intel 286            *)
     mov     CpuType, 2              (*  turn on Intel 286 Cpu flag     *)
     jne     @check_386              (*  if CPU is intel 286, check     *)
     jmp     @Terminate              (*  for Intel 287 math coprocessor *)


   (*
    *   Intel386 CPU check
    *   The AC bit (bit 18), is a new bit introduced in the EFLAGS
    *   register on the Intel486 DX CPU to generate alignment faults.
    *   This bit can not be set on the Intel386 CPU.
    *)

   @Check_386:
     { and     sp, not 3              ; align stack to avoid AC fault }

     { pushfd }
     db 66h
     pushf

     { pop     eax                   ; get original EFLAGS }
     dd 66h
     pop ax

     { mov     ecx,eax               ; save original EFLAGS }
     db 66h
     mov cx,ax

     { xor     eax,00040000h         ; flip AC bit in EFLAGS }
     db 66h
     xor ax,0000h
     dw     0004h

     { push    eax                   ; save for EFLAGS }
     db 66h
     push ax

     { popfd                         ; copy to EFLAGS }
     db 66h
     popf

     { pushfd                        ; push EFLAGS }
     db 66h
     pushf

     { pop     eax                   ; get new EFLAGS value }
     db 66h
     pop ax

     { xor     eax,ecx               ; can't toggle AC bit, CPU=386 }
     db 66h
     xor ax,cx

     jne     @check_486              (*  if CPU is Intel386, now check    *)
     mov     CpuType, 3              (*  turn on Intel386 CPU flag        *)
     jmp     @Terminate              (*  for an Intel 287 or Intel387 MCP *)


   (*
    *   Intel486 DX CPU, Intel 487 SX MCP, and Intel486 SX CPU checking
    *
    *   Checking for the ability to set/clear the ID flag (bit 21) in EFLAGS
    *   which diferentiates between Pentium (or greater) and the Intel486.
    *   If the ID flag is set then the CPUID instruction can be used to
    *   determine the final version of the chip, else it's a 486
    *)

   @Check_486:
     { and     sp, not 3             ; align stack to avoid AC fault }

     { pushfd                        ; push original EFLAGS }
     db 66h
     pushf

     { pop     eax                   ;  get original EFLAGS in eax }
     db 66h
     pop ax

     { mov     ecx,eax               ; save original EFLAGS in ecx }
     db 66h
     mov cx,ax

     { or      eax,00200000h         ; flip ID bit in EFLAGS }
     db 66h
     or ax,0000h
     dw    0020h

     { push    eax                   ; save for EFLAGS }
     db 66h
     push ax

     { popfd                         ; copy to EFLAGS }
     db 66h
     popf

     { pushfd                        ; push EFLAGS }
     db 66h
     pushf

     { pop     eax                   ; get new EFLAGS value }
     db 66h
     pop ax

     { xor     eax,ecx }
     db 66h
     xor ax,cx

     jne    @check_Pentium           (* if ID bit cannot be changed, *)
     mov    CpuType, 4               (* turn on Intel486 CPU flag     *)
     jmp    @Terminate               (* CPU=Intel486 without CPUID   *)


   (*
    *   Otherwise, execute CPUID instruction to determine vendor,
    *   family, model and stepping.
    *)

   @Check_Pentium:
     { and     sp, not 3             ; align stack to avoid AC fault }
     mov     CpuType, 5              { By exclusion this is a Pentium }

     { mov     eax, 0                ; set up for CPUID instruction }
     db 66h
     mov ax, 0000h                   { Prepare CPUID with EAX=0 }
     dw      0000h                   { -> Vendor Id Tag         }

     { cpuid }
     db      0Fh                     { New Pentium CPUID instruction }
     db      0A2h

     { "Genuine?????" vendor id. }
     LES     DI, pVStr
     mov     byte ptr [ES:DI + 0], 12  {String has 12 chars}

     mov     word ptr [ES:DI + 1], bx
     db      066h, 0C1h, 0EBh, 010h          {shr ebx, 16}
     mov     word ptr [ES:DI + 3], bx

     mov     word ptr [ES:DI + 5], dx
     db      066h, 0C1h, 0EAh, 010h          {shr edx, 16}
     mov     word ptr [ES:DI + 7], dx

     mov     word ptr [ES:DI + 9], cx
     db      066h, 0C1h, 0E9h, 010h          {shr ecx, 16}
     mov     word ptr [ES:DI + 11], cx

     { mov     eax, 1 }
     db 66h
     mov ax, 0001h                   { Prepare CPUID with EAX=1 }
     dw      0000h                   { -> CPU family data       }

     { cpuid }
     db      0Fh                     { New Pentium CPUID instruction }
     db      0A2h

     { mov     saved_cpuid, eax      ; save for future use }
     db 66h
     mov SavedCpuId, ax

     { and     eax, 0F00H            ; mask everything but family }
     db 66h
     and ax, 0f00h
     db      0000h

     { shr     eax, 8 }
     db 66h
     db 0C1h, 0E8h, 08h

     mov     CpuFamily, al           (* set cpu type with family *)

     { mov     eax, SavedCpuId       ; restore data }
     db 66h
     mov ax, SavedCpuId

     mov     CpuModel, al
     and     CpuModel, 0F0H          (* isolate model info *)
     { shr     CpuModel, 4 }
     shr     CpuModel,1
     shr     CpuModel,1
     shr     CpuModel,1
     shr     CpuModel,1

     { mov     eax,_SavedCpuId       ; restore data }
     db 66h
     mov ax, SavedCpuId

     mov     CpuStep, al
     and     CpuStep, 0FH            (* isolate stepping info *)

   @Terminate:
     End;

     _CpuType    := CpuType;
     _CpuTypeStr := CpuTypeStr;
     _SavedCpuId := SavedCpuId;
     _CpuFamily  := CpuFamily;
     _CpuModel   := CpuModel;
     _CpuStep    := CpuStep;
     _Vendor.Str := VStr;

   End; (* _GetCpuId *)


Destructor  TCpuId.Done;
   Begin
   End;


{ *** UNIT INIT *** }

BEGIN
END.