X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fx86-vm.lisp;h=434f345e49a1ba11a3400134e3819b457c8bd34f;hb=07ab1e4811ab16f95a9a5e8d767426a0787f22c0;hp=041007b78c6c300056a453f94a9b1b2643ecc407;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index 041007b..434f345 100644 --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -203,18 +203,21 @@ ;;;; 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 @@ -226,6 +229,7 @@ (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))) @@ -255,7 +259,7 @@ ;;; 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, @@ -263,21 +267,9 @@ ;; 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)))