[b8d578]: src / code / bsd-os.lisp Maximize Restore History

Download this file

bsd-os.lisp    108 lines (94 with data), 3.8 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
;;;; OS interface functions for SBCL under BSD Unix.
;;;; This code was written as part of the CMU Common Lisp project at
;;;; Carnegie Mellon University, and has been placed in the public
;;;; domain.
(in-package "SB!IMPL")
;;;; Check that target machine features are set up consistently with
;;;; this file.
#!-bsd
(eval-when (:compile-toplevel :load-toplevel :execute)
(error "The :BSD feature is missing, we shouldn't be doing this code."))
(define-alien-routine ("sysctl" %sysctl) int
(name (* int))
(namelen unsigned-int)
(oldp (* t))
(oldlenp (* sb!unix:size-t))
(newp (* t))
(newlen sb!unix:size-t))
#!+darwin
(define-alien-routine ("sysctlbyname" %sysctlbyname) int
(name c-string)
(oldp (* t))
(oldlenp (* sb!unix:size-t))
(newp (* t))
(newlen sb!unix:size-t))
(defun sysctl (type &rest name)
#!+sb-doc
"Retrieves an integer or string value with the given name."
(let ((name-len (length name)))
(when (> name-len ctl-maxname)
(error "sysctl name ~S is too long" name))
(with-alien ((name-array (array int #.ctl-maxname))
(result-len sb!unix:size-t))
(dotimes (off name-len)
(setf (deref name-array off) (elt name off)))
(ecase type
(:int
(with-alien ((result int))
(setf result-len (alien-size int :bytes))
(unless (minusp (%sysctl (cast name-array (* int)) name-len
(addr result) (addr result-len) nil 0))
result)))
(:str
(unless (minusp (%sysctl (cast name-array (* int)) name-len
nil (addr result-len) nil 0))
(with-alien ((result (* char) (make-alien char result-len)))
(if (minusp (%sysctl (cast name-array (* int)) name-len
result (addr result-len) nil 0))
(free-alien result)
(sb!unix::newcharstar-string result)))))))))
#!+darwin
(defun sysctlbyname (type name)
#!+sb-doc
"Retrieves an integer or string value with the given name."
(with-alien ((result-len sb!unix:size-t))
(ecase type
(:int
(with-alien ((result int))
(setf result-len (alien-size int :bytes))
(unless (minusp (%sysctlbyname name (addr result)
(addr result-len) nil 0))
result)))
(:str
(unless (minusp (%sysctlbyname name nil (addr result-len) nil 0))
(with-alien ((result (* char) (make-alien char result-len)))
(if (minusp (%sysctlbyname name result (addr result-len) nil 0))
(free-alien result)
(sb!unix::newcharstar-string result))))))))
(defun software-type ()
#!+sb-doc
"Return a string describing the supporting software."
(sysctl :str ctl-kern kern-ostype))
(defun software-version ()
#!+sb-doc
"Return a string describing version of the supporting software, or NIL
if not available."
(or sb!sys::*software-version*
(setf sb!sys::*software-version*
(sysctl :str ctl-kern kern-osrelease))))
;;; Return system time, user time and number of page faults.
(defun get-system-info ()
(multiple-value-bind (err? utime stime maxrss ixrss idrss
isrss minflt majflt)
(sb!unix:unix-getrusage sb!unix:rusage_self)
(declare (ignore maxrss ixrss idrss isrss minflt))
(unless err?
(simple-perror "Unix system call getrusage() failed" :errno utime))
(values utime stime majflt)))
;;; Return the system page size.
(defun get-page-size ()
(sysctl :int ctl-hw hw-pagesize))
;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
(defun get-machine-version ()
(or #!+darwin (sysctlbyname :str "machdep.cpu.brand_string")
(sysctl :str ctl-hw hw-model)))