Skip to content
Snippets Groups Projects
Commit 3843a50c authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'rtoy-issue-71' into 'master'

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

Closes #71

See merge request cmucl/cmucl!42
parents b6faace8 0824e61e
No related branches found
No related tags found
No related merge requests found
...@@ -60,14 +60,56 @@ ...@@ -60,14 +60,56 @@
#-cross-compiler #-cross-compiler
(defun machine-type () (defun machine-type ()
_N"Returns a string describing the type of the local machine." _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 #-cross-compiler
(defun machine-version () (defun machine-version ()
_N"Returns a string describing the version of the local machine." _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 ;;; Fixup-Code-Object -- Interface
......
...@@ -27,6 +27,7 @@ public domain. ...@@ -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. * 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. * 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~~. * 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: * ANSI compliance fixes:
* Bug fixes: * Bug fixes:
* Gitlab tickets: * Gitlab tickets:
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment