Also reduce OAOOMity of GET-MACHINE-VERSION.
Patch by Josh Elsasser.
open coding of ARRAY-RANK.
* improvement: SBCL now emits a compiler note where stack allocation was
requested but could not be provided.
+ * improvement: better MACHINE-VERSION responses. (thanks to Josh Elsasser)
* improvement: pretty-printing loop has been implemented properly. (thanks
to Tobias Rittweiler)
* documentation: CLOS slot typechecing policy has been documented.
"FUN-WORD-OFFSET" "GENERALIZED-BOOLEAN"
"GET-CLOSURE-LENGTH" "GET-HEADER-DATA"
"GET-LISP-OBJ-ADDRESS" "LOWTAG-OF" "WIDETAG-OF"
- "GET-MACHINE-VERSION" "HAIRY-DATA-VECTOR-REF"
+ "HAIRY-DATA-VECTOR-REF"
"HAIRY-DATA-VECTOR-REF/CHECK-BOUNDS" "HAIRY-DATA-VECTOR-SET"
"HAIRY-DATA-VECTOR-SET/CHECK-BOUNDS""HAIRY-TYPE"
"HAIRY-TYPE-CHECK-TEMPLATE-NAME" "HAIRY-TYPE-SPECIFIER"
"FOREIGN-SYMBOL-SAP"
"FOREIGN-SYMBOL-ADDRESS"
"FOREIGN-SYMBOL-DATAREF-SAP"
- "GET-PAGE-SIZE" "GET-SYSTEM-INFO"
+ "GET-MACHINE-VERSION" "GET-PAGE-SIZE" "GET-SYSTEM-INFO"
"IGNORE-INTERRUPT"
"IN-INTERRUPTION"
"INTERACTIVE-INTERRUPT"
;;; See x86-vm.lisp for a description of this.
(define-alien-type os-context-t (struct os-context-t-struct))
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
"Return a string describing the type of the local machine."
"Alpha")
-
-;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
-(defun get-machine-version ()
- nil)
\f
(defun fixup-code-object (code offset value kind)
(unless (zerop (rem offset n-word-bytes))
;;;; Carnegie Mellon University, and has been placed in the public
;;;; domain.
-(in-package "SB!SYS")
+(in-package "SB!IMPL")
;;;; Check that target machine features are set up consistently with
;;;; this file.
(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))
+
+(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)))))))))
+
(defun software-type ()
#!+sb-doc
"Return a string describing the supporting software."
- (the string ; (to force error in case of unsupported BSD variant)
- #!+FreeBSD "FreeBSD"
- #!+OpenBSD "OpenBSD"
- #!+NetBSD "NetBSD"
- #!+Darwin "Darwin"))
+ (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 *software-version*
- (setf *software-version*
- (string-trim '(#\newline)
- (with-output-to-string (stream)
- (sb!ext:run-program "/usr/bin/uname" `("-r")
- :output stream))))))
+ (or sb!sys::*software-version*
+ (setf sb!sys::*software-version*
+ (sysctl :str ctl-kern kern-osrelease))))
\f
;;; Return system time, user time and number of page faults.
(defun get-system-info ()
;;; Return the system page size.
(defun get-page-size ()
- ;; FIXME: probably should call getpagesize()
- 4096)
+ (sysctl :int ctl-hw hw-pagesize))
+
+;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
+(defun get-machine-version ()
+ ;; FIXME: on Darwin we would prefer machdep.cpu.brand_string -- but I can't
+ ;; seem to grab it using sysctl() -- but the shell tool finds it. When
+ ;; someone has the time, check out how Darwin shell sysctl does it.
+ (sysctl :str ctl-hw hw-model))
\f
(define-alien-type os-context-t (struct os-context-t-struct))
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
"Returns a string describing the type of the local machine."
"HPPA")
-
-;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
-(defun get-machine-version ()
- nil)
\f
;;;; FIXUP-CODE-OBJECT
;FIX-lav: unify code with genesis.lisp fixup
(error "Unix system call getrusage failed: ~A." (strerror utime)))
(values utime stime majflt)))
+;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
+(defun get-machine-version ()
+ nil)
;;; Return the system page size.
(defun get-page-size ()
sb!c:*backend-page-bytes*)
+
+;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
+(defun get-machine-version ()
+ (or
+ #!+(and mips little-endian)
+ "little-endian"
+ #!+(and mips big-endian)
+ "big-endian"
+ (let ((marker
+ ;; hoping "cpu" exists and gives something useful in
+ ;; all relevant Linuxen...
+ ;;
+ ;; from Lars Brinkhoff sbcl-devel 26 Jun 2003:
+ ;; I examined different versions of Linux/PPC at
+ ;; http://lxr.linux.no/ (the file that outputs
+ ;; /proc/cpuinfo is arch/ppc/kernel/setup.c, if
+ ;; you want to check), and all except 2.0.x
+ ;; seemed to do the same thing as far as the
+ ;; "cpu" field is concerned, i.e. it always
+ ;; starts with the (C-syntax) string "cpu\t\t: ".
+ #!+ppc "cpu"
+ ;; The field "model name" exists on kernel 2.4.21-rc6-ac1
+ ;; anyway, with values e.g.
+ ;; "AMD Athlon(TM) XP 2000+"
+ ;; "Intel(R) Pentium(R) M processor 1300MHz"
+ ;; which seem comparable to the information in the example
+ ;; in the MACHINE-VERSION page of the ANSI spec.
+ #!+(or x86 x86-64) "model name"))
+ (when marker
+ (with-open-file (stream "/proc/cpuinfo"
+ ;; Even on Linux it's an option to build
+ ;; kernels without /proc filesystems, so
+ ;; degrade gracefully.
+ :if-does-not-exist nil)
+ (loop with line while (setf line (read-line stream nil))
+ when (eql (search marker line) 0)
+ return (string-trim " " (subseq line (1+ (position #\: line))))))))))
(define-alien-type os-context-register-t unsigned-long-long)
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
"Returns a string describing the type of the local machine."
"MIPS")
-
-;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
-(defun get-machine-version ()
- #!+little-endian "little-endian"
- #!-little-endian "big-endian")
-
\f
;;;; FIXUP-CODE-OBJECT
;; FIXME: Or we could just get rid of this, since the uses of it look
;; disposable.
4096)
+
+;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
+(defun get-machine-version ()
+ nil)
(define-alien-type os-context-t (struct os-context-t-struct))
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
"Returns a string describing the type of the local machine."
"PowerPC")
-
-;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
-(defun get-machine-version ()
- #!+linux
- (with-open-file (stream "/proc/cpuinfo"
- ;; /proc is optional even in Linux, so
- ;; fail gracefully.
- :if-does-not-exist nil)
- (loop with line while (setf line (read-line stream nil))
- ;; hoping "cpu" exists and gives something useful in
- ;; all relevant Linuxen...
- ;;
- ;; from Lars Brinkhoff sbcl-devel 26 Jun 2003:
- ;; I examined different versions of Linux/PPC at
- ;; http://lxr.linux.no/ (the file that outputs
- ;; /proc/cpuinfo is arch/ppc/kernel/setup.c, if
- ;; you want to check), and all except 2.0.x
- ;; seemed to do the same thing as far as the
- ;; "cpu" field is concerned, i.e. it always
- ;; starts with the (C-syntax) string "cpu\t\t: ".
- when (eql (search "cpu" line) 0)
- return (string-trim " " (subseq line (1+ (position #\: line))))))
- #!-linux
- nil)
\f
;;;; FIXUP-CODE-OBJECT
;;; See x86-vm.lisp for a description of this.
(define-alien-type os-context-t (struct os-context-t-struct))
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
"Returns a string describing the type of the local machine."
"SPARC")
-
-;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
-(defun get-machine-version ()
- nil)
\f
(defun fixup-code-object (code offset fixup kind)
(declare (type index offset))
;; FIXME II: this could well be wrong
#!+sparc 8192
#!+(or x86 x86-64) 4096)
+
+;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
+(defun get-machine-version ()
+ nil)
;; FIXME: Or we could just get rid of this, since the uses of it look
;; disposable.
4096)
+
+;;; support for CL:MACHINE-VERSION defined OAOO elsewhere
+(defun get-machine-version ()
+ nil)
;;; some other package, perhaps SB-KERNEL.
(define-alien-type os-context-t (struct os-context-t-struct))
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
#!+sb-doc
"Return a string describing the type of the local machine."
"X86-64")
-
-;;; arch-specific support for CL:MACHINE-VERSION, defined OAOO elsewhere
-(defun get-machine-version ()
- #!+linux
- (with-open-file (stream "/proc/cpuinfo"
- ;; Even on Linux it's an option to build
- ;; kernels without /proc filesystems, so
- ;; degrade gracefully.
- :if-does-not-exist nil)
- (loop with line while (setf line (read-line stream nil))
- ;; The field "model name" exists on kernel 2.4.21-rc6-ac1
- ;; anyway, with values e.g.
- ;; "AMD Athlon(TM) XP 2000+"
- ;; "Intel(R) Pentium(R) M processor 1300MHz"
- ;; which seem comparable to the information in the example
- ;; in the MACHINE-VERSION page of the ANSI spec.
- when (eql (search "model name" line) 0)
- return (string-trim " " (subseq line (1+ (position #\: line))))))
- #!-linux
- nil)
\f
;;;; :CODE-OBJECT fixups
;;; some other package, perhaps SB-KERNEL.
(define-alien-type os-context-t (struct os-context-t-struct))
\f
-;;;; MACHINE-TYPE and MACHINE-VERSION
+;;;; MACHINE-TYPE
(defun machine-type ()
#!+sb-doc
"Return a string describing the type of the local machine."
"X86")
-
-;;; arch-specific support for CL:MACHINE-VERSION, defined OAOO elsewhere
-(defun get-machine-version ()
- #!+linux
- (with-open-file (stream "/proc/cpuinfo"
- ;; Even on Linux it's an option to build
- ;; kernels without /proc filesystems, so
- ;; degrade gracefully.
- :if-does-not-exist nil)
- (loop with line while (setf line (read-line stream nil))
- ;; The field "model name" exists on kernel 2.4.21-rc6-ac1
- ;; anyway, with values e.g.
- ;; "AMD Athlon(TM) XP 2000+"
- ;; "Intel(R) Pentium(R) M processor 1300MHz"
- ;; which seem comparable to the information in the example
- ;; in the MACHINE-VERSION page of the ANSI spec.
- when (eql (search "model name" line) 0)
- return (string-trim " " (subseq line (1+ (position #\: line))))))
- #!-linux
- nil)
\f
;;;; :CODE-OBJECT fixups
#include <sys/bsdtty.h> /* for TIOCGPGRP */
#endif
+#ifdef LISP_FEATURE_BSD
+ #include <sys/param.h>
+ #include <sys/sysctl.h>
+#endif
+
#include "wrap.h"
#define DEFTYPE(lispname,cname) { cname foo; \
defconstant("fpe-fltsub", -1);
#endif
#endif // !WIN32
+
+#ifdef LISP_FEATURE_BSD
+ printf(";;; sysctl(3) names\n");
+ printf("(in-package \"SB!IMPL\")\n\n");
+ defconstant("ctl-kern", CTL_KERN);
+ defconstant("ctl-hw", CTL_HW);
+ defconstant("ctl-maxname", CTL_MAXNAME);
+ defconstant("kern-ostype", KERN_OSTYPE);
+ defconstant("kern-osrelease", KERN_OSRELEASE);
+ defconstant("hw-model", HW_MODEL);
+ defconstant("hw-pagesize", HW_PAGESIZE);
+ printf("\n");
+#endif
return 0;
}
"dlerror"
"dlopen"
"dlsym")
+ #!+bsd
+ '("sysctl")
#!+os-provides-dladdr
'("dladdr")
#!-sunos ;; !defined(SVR4)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.43"
+"1.0.28.44"
projects / sbcl.git / commitdiff