diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index 90b463a7f8400617873f09407fcaddb274721ead..8de9533337f428a8cfc0016b4b07d94b9e8b240f 100644 --- a/src/code/x86-vm.lisp +++ b/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 diff --git a/src/general-info/release-21d.md b/src/general-info/release-21d.md index 8bd416f70e1a06cef0e795635871cadf2e5aa0e5..569e2fad4a3b432d34b843a18fbb2f31c22a08b6 100644 --- a/src/general-info/release-21d.md +++ b/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: