From fca68b8de88f65b2d34694c57a8dab0ad0c065b5 Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Sun, 5 Jan 2014 20:49:07 +0100 Subject: [PATCH] Check for CPUID availability, better parsing. Also added processor info parsing and checks against highest parameter levels (standard and extended). --- src/code/x86-cpuid.lisp | 110 ++++++++++++++++++++++++++++-------------- src/compiler/x86/system.lisp | 39 +++++++++++++-- 2 files changed, 110 insertions(+), 39 deletions(-) diff --git a/src/code/x86-cpuid.lisp b/src/code/x86-cpuid.lisp index f9d37f0..5607310 100644 --- a/src/code/x86-cpuid.lisp +++ b/src/code/x86-cpuid.lisp @@ -26,31 +26,46 @@ ("UMC UMC UMC " :umc) ("SiS SiS SiS " :sis) ("Geode by NSC" :nsc) - ("RiseRiseRise" :rise))) + ("RiseRiseRise" :rise) + ("VIA VIA VIA " :via) + ("Vortex86 SoC" :vortex) + ("KVMKVMKVMKVM" :kvm) + ("Microsoft Hv" :hyperv) + ("VMwareVMware" :vmware) + ("XenVMMXenVMM" :xen))) + +(defun %cpuid (eax &optional (ebx 0) (ecx 0) (edx 0)) + (%cpuid/4 eax ebx ecx edx)) + +(defun cpuid-highest-parameter () + (values (%cpuid 0))) + +(defun cpuid-highest-extended-parameter () + (values (%cpuid #x80000000))) (defun cpuid-vendor-id () (multiple-value-bind (eax ebx ecx edx) - (%cpuid/4 0 0 0 0) + (%cpuid 0) (let ((decoded (u32-to-string ebx edx ecx))) - (values eax (cadr (assoc decoded *cpuid-vendor-ids* :test #'string=)) decoded)))) + (values (cadr (assoc decoded *cpuid-vendor-ids* :test #'string=)) decoded eax)))) (defparameter *cpuid-feature-flags* - '((:sse3 :pclmul :dtes64 :mon - :dspcl :vmx :smx :est - :tm2 :ssse3 :cid NIL - :fma :cx16 :etprd :pdcm - NIL :pcid :dca :sse4.1 - sse4.2 :x2apic :movbe :popcnt - :tscd :aes :xsave :osxsave - :avx :f16c :rdrand NIL) - (:fpu :vme :de :pse - :tsc :msr :pae :mce - :cx8 :apic NIL :sep - :mtrr :pge :mca :cmov - :pat :pse36 :psn :clfl - NIL :dtes :acpi :mmx - :fxsr :sse :sse2 :ss - :htt :tm1 :ia-64 :pbe))) + '((:fpu :vme :de :pse + :tsc :msr :pae :mce + :cx8 :apic NIL :sep + :mtrr :pge :mca :cmov + :pat :pse36 :psn :clfl + NIL :dtes :acpi :mmx + :fxsr :sse :sse2 :ss + :htt :tm1 :ia-64 :pbe) + (:sse3 :pclmul :dtes64 :mon + :dspcl :vmx :smx :est + :tm2 :ssse3 :cid NIL + :fma :cx16 :etprd :pdcm + NIL :pcid :dca :sse4.1 + :sse4.2 :x2apic :movbe :popcnt + :tscd :aes :xsave :osxsave + :avx :f16c :rdrand NIL))) (defun decode-cpuid-feature-flags (value flags) (let (result (i 0)) @@ -59,27 +74,52 @@ (push flag result)) (incf i)))) -(defun cpuid-signature () +(defun decode-cpuid-processor-info (vendor eax) + (let ((stepping (ldb (byte 4 0) eax)) + (model (ldb (byte 4 4) eax)) + (family (ldb (byte 4 8) eax)) + (processor-type (ldb (byte 2 12) eax)) + (extended-model (ldb (byte 4 16) eax)) + (extended-family (ldb (byte 4 20) eax))) + (flet ((intel () + (list stepping + (+ model (ash extended-model 4)) + (+ family extended-family) + processor-type))) + (case vendor + ((:oldamd :amd) + (if (eql family 15) + (intel) + (list stepping model family processor-type))) + (T + (intel)))))) + +(defun cpuid-signature (&optional (vendor-id (cpuid-vendor-id))) + (when (< (cpuid-highest-parameter) 1) + (warn "Processor info feature unsupported by CPU.") + (return-from cpuid-signature)) (multiple-value-bind (eax ebx ecx edx) - (%cpuid/4 1 0 0 0) - (let (flags) - (values - ;; (ldb (byte 4 0) eax) ; stepping - ;; (ldb (byte 4 4) eax) ; model - ;; (ldb (byte 4 8) eax) ; family - (append (decode-cpuid-feature-flags ecx (car *cpuid-feature-flags*)) - (decode-cpuid-feature-flags edx (cadr *cpuid-feature-flags*))) - flags)))) + (%cpuid 1) + (values + (append (decode-cpuid-feature-flags edx (car *cpuid-feature-flags*)) + (decode-cpuid-feature-flags ecx (cadr *cpuid-feature-flags*))) + (decode-cpuid-processor-info vendor-id eax)))) (defun cpuid-processor-name () - (string-trim '(#\Space #\0) - (concatenate - 'string - (multiple-value-call #'u32-to-string (%cpuid/4 #x80000002 0 0 0)) - (multiple-value-call #'u32-to-string (%cpuid/4 #x80000003 0 0 0)) - (multiple-value-call #'u32-to-string (%cpuid/4 #x80000004 0 0 0))))) + (when (< (cpuid-highest-extended-parameter) #x80000004) + (warn "Processor name feature unsupported by CPU.") + (return-from cpuid-processor-name)) + (string-trim + '(#\Space #\Nul) + (multiple-value-call #'u32-to-string + (%cpuid #x80000002) + (%cpuid #x80000003) + (%cpuid #x80000004)))) (defun cpuid (what) + (unless (cpuid-available-p) + (warn "CPUID instruction unsupported by CPU.") + (return-from cpuid)) (ecase what (:vendor-id (cpuid-vendor-id)) (:signature (cpuid-signature)) diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index 9834711..8726a6e 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -288,6 +288,39 @@ (note-next-instruction vop :internal-error) (inst wait))) +;;;; CPUID detection + +(defknown %cpuid-available-p () (values boolean)) +(define-vop (%cpuid-available-p) + (:policy :fast-safe) + (:translate %cpuid-available-p) + (:results (result :scs (descriptor-reg))) + (:result-types *) ; should be BOOLEAN + (:temporary (:sc unsigned-reg :offset eax-offset :target result) eax) + (:temporary (:sc unsigned-reg :offset ecx-offset) ecx) + (:generator 15 + (inst pushf) + (inst pop eax) + (inst mov ecx eax) + (inst xor eax #x200000) + (inst push eax) + (inst popf) + (inst pushf) + (inst pop eax) + (inst push ecx) + (inst popf) + (inst xor eax ecx) + (inst test eax #x200000) + (inst jmp :z UNSUPPORTED) + (load-symbol result t) + (inst jmp DONE) + UNSUPPORTED + (inst mov result nil-value) + DONE)) + +(defun cpuid-available-p () + (%cpuid-available-p)) + ;;;; Miscellany ;;; the RDTSC instruction (present on Pentium processors and @@ -359,12 +392,10 @@ number of CPU cycles elapsed as secondary value. EXPERIMENTAL." (inst inc (make-ea-for-vector-data count-vector :offset index)))) ;;;; CPUID parsing + (defknown %cpuid/4 ((unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)) (values (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)) ()) -;; TODO: make argument-2-4 optional? -;; TODO: check eflags for cpuid? -;; TODO: guard against unavailable cpuid? (define-vop (%cpuid/4) (:policy :fast-safe) (:translate %cpuid/4) @@ -382,7 +413,7 @@ number of CPU cycles elapsed as secondary value. EXPERIMENTAL." (result-3 :scs (unsigned-reg)) (result-4 :scs (unsigned-reg))) (:result-types unsigned-num unsigned-num unsigned-num unsigned-num) - (:generator 3 + (:generator 9 (move eax argument-1) (move ebx argument-2) (move ecx argument-3) -- 1.7.10.4