diff --git a/code/exports.lisp b/code/exports.lisp index 263bea75836af795498a5d6dcaae1a8c31a70488..d3561cfb750672cb9e02d6fd03959a0aab063b6a 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.254 2006/07/07 18:22:57 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.255 2006/12/02 15:22:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1090,7 +1090,8 @@ "COMPATIBLE-FUNCTION-TYPES-P") #+ppc (:export "SIGCONTEXT-LR" - "COMPATIBLE-FUNCTION-TYPES-P") + "COMPATIBLE-FUNCTION-TYPES-P" + "FLOAT-INVALID-OP-1-BYTE") #+heap-overflow-check (:export "DYNAMIC-SPACE-OVERFLOW-ERROR-TRAP" "DYNAMIC-SPACE-OVERFLOW-WARNING-TRAP") diff --git a/code/float-trap.lisp b/code/float-trap.lisp index 1b9cf72249395af2ff8dd0780e1a2305425584e1..2450e5bc0322e06b978100e547b63cefc4d3ef45 100644 --- a/code/float-trap.lisp +++ b/code/float-trap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.28 2006/11/16 04:34:55 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.29 2006/12/02 15:22:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -115,10 +115,19 @@ (error "Unknown rounding mode: ~S." rounding-mode)))) (when current-x-p (setf (ldb float-exceptions-byte modes) - (float-trap-mask current-exceptions))) + (float-trap-mask current-exceptions)) + #+darwin + (when (member :invalid current-exceptions) + ;; Clear out the bits for the detected invalid operation + (setf (ldb vm:float-invalid-op-1-byte modes) 0))) + (when accrued-x-p (setf (ldb float-sticky-bits modes) - (float-trap-mask accrued-exceptions))) + (float-trap-mask accrued-exceptions)) + #+darwin + (when (member :invalid current-exceptions) + ;; Clear out the bits for the detected invalid operation + (setf (ldb vm:float-invalid-op-1-byte modes) 0))) (when fast-mode-p (if fast-mode (setq modes (logior float-fast-bit modes)) @@ -304,6 +313,15 @@ float-traps-byte #xffffffff)) (exception-mask (dpb (lognot (vm::float-trap-mask traps)) float-sticky-bits #xffffffff)) + ;; On ppc if we are masking the invalid trap, we need to make + ;; sure we wipe out the various individual sticky bits + ;; representing the invalid operation. Otherwise, if we + ;; enable the invalid trap later, these sticky bits will cause + ;; an exception. + #+ppc + (invalid-mask (if (member :invalid traps) + (dpb 0 vm:float-invalid-op-1-byte #xffffffff) + #xffffffff)) (orig-modes (gensym))) `(let ((,orig-modes (floating-point-modes))) (unwind-protect @@ -316,4 +334,6 @@ (logior (logand ,orig-modes ,(logior traps exceptions)) (logand (floating-point-modes) ,(logand trap-mask exception-mask) + #+ppc + ,invalid-mask #+mips ,(dpb 0 float-exceptions-byte #xffffffff)))))))) diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp index 44e1965c1d30feb73d0534e05e4f14e29ada6f13..3431ac9c112c7250d560e662a8439518d61379ce 100644 --- a/compiler/ppc/parms.lisp +++ b/compiler/ppc/parms.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.15 2006/11/14 02:41:25 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.16 2006/12/02 15:22:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -58,7 +58,8 @@ float-underflow-trap-bit float-overflow-trap-bit float-imprecise-trap-bit float-invalid-trap-bit - float-divide-by-zero-trap-bit)) + float-divide-by-zero-trap-bit + float-invalid-op-1-byte)) #+double-double (export '(double-double-float-digits)) @@ -129,8 +130,13 @@ ;; separate field for current exceptions, so we make this the same as ;; the (sticky) accrued exceptions. (defconstant float-exceptions-byte (byte 5 25)) -;; Various sticky invalid operation bits +;; Sticky invalid operation bits that indicates what kind of invalid +;; exception occurred, like SNaN, inf - inf, inf / inf, 0/0, or an +;; invalid compare. (defconstant float-invalid-op-1-byte (byte 6 19)) +;; Sticky invalid operation bits that indicates some kind of invalid +;; operation such as some software request, invalid square root, or +;; invalid integer convert. (defconstant float-invalid-op-2-byte (byte 3 8)) (defconstant float-fast-bit (ash 1 2)) ; Non-IEEE mode