Re: sunos machine type/version

[Miles Bader <miles@cogsci.edinburgh.ac.uk>]

On second though, replace all those silly "%"s with "sun-"s:

*** systype.lisp.~2~	Thu Feb 13 11:39:53 1992
--- systype.lisp	Thu Feb 13 11:41:35 1992
***************
*** 1,11 ****
  ;;; 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)
  
--- 1,11 ----
  ;;; 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 sun-machine-type-code into sparc-vm.lisp
! ;;; and put this sun-machine-type-code into sunos-os.lisp, putting a version
! ;;; of sun-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)
  
***************
*** 26,37 ****
  ;;; 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)
--- 26,36 ----
  ;;; Change as necessary
  (defvar *default-machine-type* "sun4")
  
! (defun sun-machine-type-code ()
    (logand (ash (mach:unix-gethostid) -24) #xFF))
  
! (defun sun-machine-type (&optional (machine-type-code (sun-machine-type-code)))
!   (let* ((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)
***************
*** 42,49 ****
  
  (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"))
--- 41,48 ----
  
  (defun machine-type ()
    "Returns a string describing the type of the local machine."
!   (values (or (sun-machine-type) *default-machine-type*)))
  
  (defun machine-version ()
    "Returns a string describing the version of the local machine."
!   (or (nth-value 1 (sun-machine-type)) "unknown"))