1 (defpackage :cpuid
(:use
:cl
))
5 (defvar +cpu-std-feat-fields
+
6 #(:fpu
:vme
:de
:pse
:tsc
:k86-msr
:pae
:mce
:cmpxchg8b
:apic
:res10
:sysenter
/exit
:mtrr
:gpe
:mca
:cmov
:pat
:pse-36
:psn
:clflush
:res20
:ds
:acpi
:mmx
:fxsave
/rstor
:sse
:sse2
:self-snoop
:htt
:tm
:res30
:pbe
))
8 (defvar +cpu-std-feat-fields-ecx
+
9 #(:sse3
:res1
:res2
:monitor
:ds-cpl
:res5
:res6
:eist
:tm2
:res9
:cid
:res11
:res12
:cmpxchg16b
:stpm
:res14
:res15
10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
12 ;; low bits are mostly same as in std-feat, so skip them..
13 (defvar +cpu-ext-feat-fields
+
14 #(0 1 2 3 4 5 6 7 8 9 10 :syscall
/ret
12 13 14 15 16 17 18 19 :nx
21 :mmx-ext
:mmx
24 25 26 27 28 :longmode
/em64t
:3dnow-ext
:3dnow
))
17 (defvar *cpu-features
* nil
)
18 (defvar *cpu-vendor
* nil
) ;; eg authenticamd
19 (defvar *cpu-name
* nil
) ;; eg AMD Athlon XP
20 (defvar *cpu-cache
* nil
)
25 (let ((array (make-array 8 :element-type
'(unsigned-byte 16) :initial-element
0)) c d
)
29 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x00000000 array
)
31 (let ((temp (make-array 12 :element-type
'(unsigned-byte 8) :initial-element
0)))
32 (flet ((load-word (i u v
) (setf (aref temp
(+ i
3)) (ash (aref array u
) -
8)
33 (aref temp
(+ i
2)) (logand (aref array u
) 255)
34 (aref temp
(+ i
1)) (ash (aref array v
) -
8)
35 (aref temp
(+ i
0)) (logand (aref array v
) 255))))
36 (loop for i from
0 below
12 by
4
37 for
(u v
) in
'((2 3) (6 7) (4 5))
40 (setq *cpu-vendor
* (map 'string
#'code-char temp
))))
44 (setq *cpu-features
* nil
)
46 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x00000001 array
)
49 ;; a (logior (ash (aref array 0) 16) (aref array 1))
50 ;; b (logior (ash (aref array 2) 16) (aref array 3))
51 c
(logior (ash (aref array
4) 16) (aref array
5))
52 d
(logior (ash (aref array
6) 16) (aref array
7)))
54 (loop for i from
0 below
32 do
55 (if (= (ldb (byte 1 i
) d
) 1)
56 (push (aref +cpu-std-feat-fields
+ i
) *cpu-features
*)))
58 (loop for i from
0 below
32 do
59 (if (= (ldb (byte 1 i
) c
) 1)
60 (push (aref +cpu-std-feat-fields-ecx
+ i
) *cpu-features
*))))
63 (defun inspect-cpu-ext ()
64 (let ((array (make-array 8 :element-type
'(unsigned-byte 16) :initial-element
0))
67 ;; determine max ext func
68 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000000 array
)
69 (setq max-ext-func
(logior (ash (aref array
0) 16) (aref array
1)))
71 ;; ext features (AMD/Intel)
72 (if (>= max-ext-func
#x80000001
)
74 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000001 array
)
75 (setq d
(logior (ash (aref array
6) 16) (aref array
7)))
77 (loop for i from
0 below
32 do
78 (let ((flag (ldb (byte 1 i
) d
))
79 (feat (aref +cpu-ext-feat-fields
+ i
)))
80 (if (and (= flag
1) (keywordp feat
))
81 (pushnew feat
*cpu-features
*))))))
83 ;; cpu name (AMD/Intel)
85 (if (>= max-ext-func
#x80000004
)
87 (temp (make-array 16 :element-type
'(unsigned-byte 8) :initial-element
0)))
88 (flet ((load-word (i u v
) (setf (aref temp
(+ i
3)) (ash (aref array u
) -
8)
89 (aref temp
(+ i
2)) (logand (aref array u
) 255)
90 (aref temp
(+ i
1)) (ash (aref array v
) -
8)
91 (aref temp
(+ i
0)) (logand (aref array v
) 255))))
93 (loop for i from
0 below
16 by
4
94 for
(u v
) in
'((0 1) (2 3) (4 5) (6 7))
97 (setq cpuname
(concatenate '(simple-array (unsigned-byte 8) (*)) cpuname temp
))))
99 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000002 array
) (conc-word)
100 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000003 array
) (conc-word)
101 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000004 array
) (conc-word)
105 (if (position 0 cpuname
)
106 (setq cpuname
(subseq cpuname
0 (position 0 cpuname
))))
108 (setq cpuname
(map 'string
#'code-char cpuname
))
109 (setq *cpu-name
* cpuname
)))
112 (setq *cpu-cache
* nil
)
113 (if (>= max-ext-func
#x80000005
)
115 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000005 array
)
116 (setq c
(logior (ash (aref array
4) 16) (aref array
5))
117 d
(logior (ash (aref array
6) 16) (aref array
7)))
119 (push (list :l1-data
:size
(* 1024 (ldb (byte 8 24) c
))) *cpu-cache
*)
120 (push (list :l1-inst
:size
(* 1024 (ldb (byte 8 24) d
))) *cpu-cache
*)))
123 (if (>= max-ext-func
#x80000006
)
125 (sb-sys:%primitive sb-vm
::%read-cpu
/x86
#x80000006 array
)
126 (setq c
(logior (ash (aref array
4) 16) (aref array
5)))
127 (push (list :l2
:size
(* 1024 (ldb (byte 16 16) c
))) *cpu-cache
*)))
136 (format t
"Vendor: ~A.~%" *cpu-vendor
*)
137 (format t
"Features: ~S.~%" *cpu-features
*)
138 (format t
"cpu: ~A, cache: ~S.~%" *cpu-name
* *cpu-cache
*)