[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"))