Raymond Toy pushed to branch master at cmucl / cmucl
Commits: 0824e61e by Raymond Toy at 2018-12-06T22:42:16Z Fix #71: More info from machine-type/version on x86
- - - - - 3843a50c by Raymond Toy at 2018-12-06T22:42:16Z 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 - - - - -
2 changed files:
- src/code/x86-vm.lisp - src/general-info/release-21d.md
Changes:
===================================== src/code/x86-vm.lisp ===================================== @@ -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
===================================== src/general-info/release-21d.md ===================================== @@ -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:
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/b6faace8b52fa8ca8ce5c3ed3...