Skip to content
Snippets Groups Projects
Commit 896812b8 authored by rtoy's avatar rtoy
Browse files

code/float-trap.lisp:

o Need to clear out the individual invalid operation bits when
  clearing the invalid exception bit.

code/exports.lisp:
compiler/ppc/parms.lisp:
o Export FLOAT-INVALID-OP-1-BYTE.  (Needs a better name.)
parent a48dd2d4
No related branches found
No related tags found
No related merge requests found
......@@ -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")
......
......@@ -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))))))))
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment