;;;
(in-package "SB!VM")
-(defvar *number-of-signals* 64)
-(defvar *bits-per-word* 32)
-
(define-alien-type os-context-t (struct os-context-t-struct))
\f
"Returns a string describing the type of the local machine."
"PowerPC")
-(defun machine-version ()
- "Returns a string describing the version of the local machine."
- "who-knows?")
-
-
+;;; 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
(declare (type (alien (* os-context-t)) context))
(deref (context-register-addr context index)))
+(define-alien-routine ("os_context_lr_addr" context-lr-addr) (* unsigned-long)
+ (context (* os-context-t)))
+
+(defun context-lr (context)
+ (declare (type (alien (* os-context-t)) context))
+ (int-sap (deref (context-lr-addr context))))
+
(defun %set-context-register (context index new)
(declare (type (alien (* os-context-t)) context))
(setf (deref (context-register-addr context index))
;;; Given a signal context, return the floating point modes word in
;;; the same format as returned by FLOATING-POINT-MODES.
+;;;
+;;; FIXME: surely this must be accessible somewhere under Darwin?
+#!-darwin
(define-alien-routine ("os_context_fp_control" context-floating-point-modes)
(sb!alien:unsigned 32)
(context (* os-context-t)))
sb!vm:vector-data-offset)
(* length sb!vm:n-byte-bits))
(let* ((index 0)
- (error-number (sb!c::read-var-integer vector index)))
+ (error-number (sb!c:read-var-integer vector index)))
(collect ((sc-offsets))
(loop
(when (>= index length)
(return))
- (sc-offsets (sb!c::read-var-integer vector index)))
+ (sc-offsets (sb!c:read-var-integer vector index)))
(values error-number (sc-offsets))))))