[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

sunos machine type/version



Docs/bugs.txt in the distribution only mentions two bugs, and here's a
sort-of sunos-specific fix for the first one.  The information is probably
around in Mach on a sun too (I think it comes from a prom), but I don't what
you'd replace %machine-type-code with -- gethostid seems to just return the
internet address.

Maybe some other people can fill in the various symbolic names I didn't
know...

-Miles

--
Miles Bader  --  HCRC, University of Edinburgh  --  Miles.Bader@ed.ac.uk
Ich bin ein Virus. Mach' mit und kopiere mich in Deine .signature.
94% of everything is grunge

;;; I suppose this should go in sparc-vm.lisp -- the information isn't
;;; *really* sunos-specific, although it isn't *really* sparc-specific either.

;;; You could put everything except %machine-type-code into sparc-vm.lisp and
;;; put this %machine-type-code into sunos-os.lisp, putting a version of
;;; %machine-type-code that just returns 0 (#+sparc, perhaps) into
;;; mach-os.lisp until you can figure out how to do it for real...
;;; Or something like that.

(in-package :SPARC)

(defvar *sun-machine-ids*
    '((1 "sun3"
	 (1 . "160") (2 . "50") (3 . "260") (4 . "110") (7 . "60") (8. "E"))
      (4 "sun3x"
	 (1 . "170") (2 . "80"))
      (2 "sun4"
	 (1 . "260") (2 . "110") (3 . "330") (4 . "470"))
      (5 "sun4c"
	 (1 . "60 (SS1)") (2 . "40 (IPC)") (3 . "65") (4 . "20 (SLC)")
	 (5 . "75") (6 . "30 (ELC)") (7 . "50") (8 . "70") (9 . "80")
	 (10 . "10") (11 . "45") (12 . "05") (13 . "85") (14 . "32")
	 (15 . "hike"))
      ))

;;; Change as necessary
(defvar *default-machine-type* "sun4")

(defun %machine-type-code ()
  (logand (ash (mach:unix-gethostid) -24) #xFF))

(defun %machine-type ()
  (let* ((machine-type-code (%machine-type-code))
	 (arch-code (ash machine-type-code -4))
	 (model-code (logand machine-type-code #xF)))
    (let ((arch-entry (assoc arch-code *sun-machine-ids*)))
      (if (null arch-entry)
	  (values nil nil)
	  (let ((model-entry (assoc model-code (cddr arch-entry))))
	    (values (second arch-entry)
		    (cdr model-entry)))))))

(defun machine-type ()
  "Returns a string describing the type of the local machine."
  (values (or (%machine-type) *default-machine-type*)))

(defun machine-version ()
  "Returns a string describing the version of the local machine."
  (or (nth-value 1 (%machine-type)) "unknown"))