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