Commit 0824e61e authored by Raymond Toy's avatar Raymond Toy

Fix #71: More info from machine-type/version on x86

parent b6faace8
......@@ -60,14 +60,56 @@
#-cross-compiler
(defun machine-type ()
_N"Returns a string describing the type of the local machine."
"X86")
;; Use cpuid to get the processor type.
(with-output-to-string (s)
(multiple-value-bind (max-input ebx ecx edx)
(x86::cpuid 0)
(declare (ignore max-input))
(flet ((int-to-string (int)
(dotimes (k 4)
(let ((code (ldb (byte 8 (* 8 k)) int)))
;; Don't print out null chars. We're
;; assuming this only happens at the end
;; of the brand string.
(unless (zerop code)
(write-char (code-char code) s))))))
(int-to-string ebx)
(int-to-string edx)
(int-to-string ecx)))))
#-cross-compiler
(defun machine-version ()
_N"Returns a string describing the version of the local machine."
"X86")
;; UWe use the processor brand string method to get more detailed
;; information about the processor. If it's not available, just
;; give up, even though we could use the brand index (CPUID with
;; EAX=1) to get an identifier.
(let ((max-cpuid (x86::cpuid #x80000000)))
(cond ((or (not (logbitp 31 max-cpuid))
(< max-cpuid #x80000004))
;; Processor brand string not supported, just give up.
"X86")
(t
(with-output-to-string (s)
(labels ((int-to-string (int)
(dotimes (k 4)
(let ((code (ldb (byte 8 (* 8 k)) int)))
;; Don't print out null chars. We're
;; assuming this only happens at the end
;; of the brand string.
(unless (zerop code)
(write-char (code-char code) s)))))
(cpuid-to-string (input)
(multiple-value-bind (eax ebx ecx edx)
(x86::cpuid input)
(int-to-string eax)
(int-to-string ebx)
(int-to-string ecx)
(int-to-string edx))))
(cpuid-to-string #x80000002)
(cpuid-to-string #x80000003)
(cpuid-to-string #x80000004)))))))
;;; Fixup-Code-Object -- Interface
......
......@@ -27,6 +27,7 @@ public domain.
* The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences.
* Updated CLX to telent clx version 06e39a0d.
* New functions `SET-GC-ASSERTIONS` and `GET-GC-ASSERTIONS`. See the docstrings for more information and also ~~#69~~.
* `MACHINE-TYPE` and `MACHINE-VERSION` return more information about thep rocessor cmucl is running on, using information from the `cpuid` instruction.
* ANSI compliance fixes:
* Bug fixes:
* Gitlab tickets:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment