Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/code/x86-vm.lisp
    ... ... @@ -60,14 +60,56 @@
    60 60 
     #-cross-compiler
    61 61 
     (defun machine-type ()
    62 62 
       _N"Returns a string describing the type of the local machine."
    63 
    -  "X86")
    63 
    +  ;; Use cpuid to get the processor type.
    64 
    +  (with-output-to-string (s)
    65 
    +    (multiple-value-bind (max-input ebx ecx edx)
    66 
    +	(x86::cpuid 0)
    67 
    +      (declare (ignore max-input))
    68 
    +      (flet ((int-to-string (int)
    69 
    +	       (dotimes (k 4)
    70 
    +		 (let ((code (ldb (byte 8 (* 8 k)) int)))
    71 
    +		   ;; Don't print out null chars.  We're
    72 
    +		   ;; assuming this only happens at the end
    73 
    +		   ;; of the brand string.
    74 
    +		   (unless (zerop code)
    75 
    +		     (write-char (code-char code) s))))))
    76 
    +	(int-to-string ebx)
    77 
    +	(int-to-string edx)
    78 
    +	(int-to-string ecx)))))
    64 79
    65 80
    66 81 
     #-cross-compiler
    67 82 
     (defun machine-version ()
    68 83 
       _N"Returns a string describing the version of the local machine."
    69 
    -  "X86")
    70 
    -
    84 
    +  ;; UWe use the processor brand string method to get more detailed
    85 
    +  ;; information about the processor.  If it's not available, just
    86 
    +  ;; give up, even though we could use the brand index (CPUID with
    87 
    +  ;; EAX=1) to get an identifier.
    88 
    +  (let ((max-cpuid (x86::cpuid #x80000000)))
    89 
    +    (cond ((or (not (logbitp 31 max-cpuid))
    90 
    +	       (< max-cpuid #x80000004))
    91 
    +	   ;; Processor brand string not supported, just give up.
    92 
    +	   "X86")
    93 
    +	  (t
    94 
    +	   (with-output-to-string (s)
    95 
    +	     (labels ((int-to-string (int)
    96 
    +			(dotimes (k 4)
    97 
    +			  (let ((code (ldb (byte 8 (* 8 k)) int)))
    98 
    +			    ;; Don't print out null chars.  We're
    99 
    +			    ;; assuming this only happens at the end
    100 
    +			    ;; of the brand string.
    101 
    +			    (unless (zerop code)
    102 
    +			      (write-char (code-char code) s)))))
    103 
    +		      (cpuid-to-string (input)
    104 
    +			(multiple-value-bind (eax ebx ecx edx)
    105 
    +			    (x86::cpuid input)
    106 
    +			  (int-to-string eax)
    107 
    +			  (int-to-string ebx)
    108 
    +			  (int-to-string ecx)
    109 
    +			  (int-to-string edx))))
    110 
    +	       (cpuid-to-string #x80000002)
    111 
    +	       (cpuid-to-string #x80000003)
    112 
    +	       (cpuid-to-string #x80000004)))))))
    71 113
    72 114
    73 115 
     ;;; Fixup-Code-Object -- Interface

  • src/general-info/release-21d.md
    ... ... @@ -27,6 +27,7 @@ public domain.
    27 27 
           * The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences.
    28 28 
         * Updated CLX to telent clx version 06e39a0d.
    29 29 
         * New functions `SET-GC-ASSERTIONS` and `GET-GC-ASSERTIONS`.  See the docstrings for more information and also ~~#69~~.
    30 
    +    * `MACHINE-TYPE` and `MACHINE-VERSION` return more information about thep rocessor cmucl is running on, using information from the `cpuid` instruction.
    30 31 
       * ANSI compliance fixes:
    31 32 
       * Bug fixes:
    32 33 
       * Gitlab tickets:

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. If you'd like to receive fewer emails, you can adjust your notification settings.