;;;; and internal error handling) the extra runtime cost should be
;;;; negligible.
+(declaim (inline context-pc-addr))
(define-alien-routine ("os_context_pc_addr" context-pc-addr) (* unsigned-int)
;; (Note: Just as in CONTEXT-REGISTER-ADDR, we intentionally use an
;; 'unsigned *' interpretation for the 32-bit word passed to us by
;; the C code, even though the C code may think it's an 'int *'.)
(context (* os-context-t)))
+(declaim (inline context-pc))
(defun context-pc (context)
(declare (type (alien (* os-context-t)) context))
(let ((addr (context-pc-addr context)))
(declare (type (alien (* unsigned-int)) addr))
(int-sap (deref addr))))
+(declaim (inline context-register-addr))
(define-alien-routine ("os_context_register_addr" context-register-addr)
(* unsigned-int)
;; (Note the mismatch here between the 'int *' value that the C code
(context (* os-context-t))
(index int))
+(declaim (inline context-register))
(defun context-register (context index)
(declare (type (alien (* os-context-t)) context))
(let ((addr (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.
-#!-linux
+#!-(or linux sunos)
(defun context-floating-point-modes (context)
;; FIXME: As of sbcl-0.6.7 and the big rewrite of signal handling for
;; POSIXness and (at the Lisp level) opaque signal contexts,
;; alien function.
(declare (ignore context)) ; stub!
(warn "stub CONTEXT-FLOATING-POINT-MODES")
-
- ;; old code for Linux:
- #+nil
- (let ((cw (slot (deref (slot context 'fpstate) 0) 'cw))
- (sw (slot (deref (slot context 'fpstate) 0) 'sw)))
- ;;(format t "cw = ~4X~%sw = ~4X~%" cw sw)
- ;; NOT TESTED -- Clear sticky bits to clear interrupt condition.
- (setf (slot (deref (slot context 'fpstate) 0) 'sw) (logandc2 sw #x3f))
- ;;(format t "new sw = ~X~%" (slot (deref (slot context 'fpstate) 0) 'sw))
- ;; Simulate floating-point-modes VOP.
- (logior (ash (logand sw #xffff) 16) (logxor (logand cw #xffff) #x3f)))
-
0)
-#!+linux
+#!+(or linux sunos)
(define-alien-routine ("os_context_fp_control" context-floating-point-modes)
(sb!alien:unsigned 32)
(context (* os-context-t)))