From 0824e61eb104983fe93d75cf355795cfbc40b638 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 6 Dec 2018 22:42:16 +0000 Subject: [PATCH] Fix #71: More info from machine-type/version on x86 --- src/code/x86-vm.lisp | 48 ++++++++++++++++++++++++++++++--- src/general-info/release-21d.md | 1 + 2 files changed, 46 insertions(+), 3 deletions(-) diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index 90b463a7f..8de953333 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 8bd416f70..569e2fad4 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: -- GitLab