[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-28-g70181ee
Raymond Toy
rtoy at common-lisp.net
Sun Nov 30 05:00:48 UTC 2014
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 70181ee7553a350eedd7acb2815b98dde6ce846c (commit)
from 1e4040f32e973a1debcec908e4e69147c31a67ec (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 70181ee7553a350eedd7acb2815b98dde6ce846c
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Sat Nov 29 21:00:38 2014 -0800
Partially addresses ticket:91 by allowing the test suite to finish.
The tests still fail (along with others), but the test suite will
finish.
* code/float-trap.lisp:
* Update SET-FLOATING-POINT-MODES:
* When we clear out bits in float-invalid-op-1-byte, clear out the
float-invalid-op-2-byte. Not necessary for this fix, but those
bits signal other invalid operations from sqrt and such.
* When clearing the exceptions, clear the sticky exceptions
summary bit too.
* Fix SIGFPE-HANDLER:
* As above, clear out the bit in float-invalid-op-2-byte and the
exceptions summary bit.
* Only clear out the new exception bits, as done for SSE2.
* Mask out the float-invalid-op-2-byte and the summary bit before
setting the new modes.
* compiler/ppc/parms.lisp
* Define float-exceptions-summary-byte.
* code/exports.lisp:
* Export FLOAT-INVALID-OP-2-BYTE
diff --git a/src/code/exports.lisp b/src/code/exports.lisp
index 99e0762..a6dcc0b 100644
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -1164,6 +1164,7 @@
(:export "SIGCONTEXT-LR"
"COMPATIBLE-FUNCTION-TYPES-P"
"FLOAT-INVALID-OP-1-BYTE"
+ "FLOAT-INVALID-OP-2-BYTE"
"GET-FP-OPERANDS"
"FUSED-MULTIPLY-ADD"
"FUSED-MULTIPLY-SUBTRACT")
diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp
index a736e0d..d67a4ff 100644
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -193,7 +193,8 @@
#+(and darwin ppc)
(when (member :invalid current-exceptions)
;; Clear out the bits for the detected invalid operation
- (setf (ldb vm:float-invalid-op-1-byte modes) 0)))
+ (setf (ldb vm:float-invalid-op-1-byte modes) 0)
+ (setf (ldb vm:float-invalid-op-2-byte modes) 0)))
(when accrued-x-p
(setf (ldb float-sticky-bits modes)
@@ -201,12 +202,18 @@
#+(and darwin ppc)
(when (member :invalid current-exceptions)
;; Clear out the bits for the detected invalid operation
- (setf (ldb vm:float-invalid-op-1-byte modes) 0)))
+ (setf (ldb vm:float-invalid-op-1-byte modes) 0)
+ (setf (ldb vm:float-invalid-op-2-byte modes) 0)))
+
+ #+(and darwin ppc)
+ (when (or accrued-x-p current-x-p)
+ (setf (ldb vm:float-exceptions-summary-byte modes) 0))
(when fast-mode-p
(if fast-mode
(setq modes (logior float-fast-bit modes))
(setq modes (logand (lognot float-fast-bit) modes))))
+
(setf (floating-point-modes) modes))
(values))
@@ -261,7 +268,12 @@
(traps (logand (ldb float-exceptions-byte modes)
(ldb float-traps-byte modes))))
#+(and darwin ppc)
- (let ((new-modes modes))
+ (let* ((new-modes modes)
+ (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes)
+ traps)))
+ ;; (format t "sigfpe: modes = #B~32,'0b~%" modes)
+ ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions)
+ (setf (ldb float-exceptions-byte new-modes) new-exceptions)
;; Clear out all exceptions and save them to the context.
;;
;; XXX: Should we just clear out the bits for the traps that are
@@ -273,6 +285,9 @@
;; XXX: Should we only do that if the invalid trap is enabled?
(setf (ldb float-invalid-op-1-byte new-modes) 0)
(setf (ldb float-invalid-op-2-byte new-modes) 0)
+ ;; Clear the FP exception summary bit too.
+ (setf (ldb float-exceptions-summary-byte new-modes) 0)
+ ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes)
(setf (floating-point-modes) new-modes)
(setf (sigcontext-floating-point-modes
(alien:sap-alien scp (* unix:sigcontext)))
@@ -371,7 +386,10 @@
;; an exception.
#+ppc
(invalid-mask (if (member :invalid traps)
- (dpb 0 vm:float-invalid-op-1-byte #xffffffff)
+ (dpb 0
+ (byte 1 31)
+ (dpb 0 vm::float-invalid-op-2-byte
+ (dpb 0 vm:float-invalid-op-1-byte #xffffffff)))
#xffffffff))
(orig-modes (gensym)))
`(let ((,orig-modes (floating-point-modes)))
@@ -387,4 +405,4 @@
,(logand trap-mask exception-mask)
#+ppc
,invalid-mask
- #+mips ,(dpb 0 float-exceptions-byte #xffffffff))))))))
+ #+mips ,(dpb 0 float-exceptions-byte #xffffffff))))))))
diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp
index dab5ce5..cc2c5ba 100644
--- a/src/compiler/ppc/parms.lisp
+++ b/src/compiler/ppc/parms.lisp
@@ -66,7 +66,8 @@
float-underflow-trap-bit float-overflow-trap-bit
float-imprecise-trap-bit float-invalid-trap-bit
float-divide-by-zero-trap-bit
- float-invalid-op-1-byte))
+ float-invalid-op-1-byte
+ float-invalid-op-2-byte))
#+double-double
(export '(double-double-float-digits))
@@ -152,6 +153,10 @@
;; operation such as some software request, invalid square root, or
;; invalid integer convert.
(defconstant float-invalid-op-2-byte (byte 3 8))
+;; FP exception summary bit. This is set if an FP instruction causes
+;; any of the FP exception bits to transition from 0 to 1 (meaning
+;; that exception occurred.)
+(defconstant float-exceptions-summary-byte (byte 1 31))
(defconstant float-fast-bit (ash 1 2)) ; Non-IEEE mode
); eval-when
-----------------------------------------------------------------------
Summary of changes:
src/code/exports.lisp | 1 +
src/code/float-trap.lisp | 28 +++++++++++++++++++++++-----
src/compiler/ppc/parms.lisp | 7 ++++++-
3 files changed, 30 insertions(+), 6 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list