From: Alastair Bridgewater <lisphacker@users.sourceforge.net>
Date: Mon, 24 May 2010 02:23:15 +0000 (+0000)
Subject: 1.0.38.12: Fix FP traps on PPC/Linux.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cb427254703b615dc5d1e46a3dd8db7a8a9e6d55;p=sbcl.git

1.0.38.12: Fix FP traps on PPC/Linux.

  * Linux on most platforms, including PPC, kicks off its signal
handlers with a cleared FP control word.  We already have a hook to deal
with this, so enable it.

  * The implementation of said hook on PPC/Linux was broken, largely due
to a variable-size mismatch in a KLUDGE it uses.  Fixed and documented
the KLUDGE, added support for preserving the current rounding mode, and
enabled the actual restoration of the FP control word.

  * NetBSD isn't the only target which requires :INVALID exceptions to
be disabled, it also matters on PPC.  Fixed the default control mode.

  * Fix up the test suite to reflect the current expectations for
float.pure.lisp tests.
---

diff --git a/NEWS b/NEWS
index 6a5344e..ab73141 100644
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,7 @@ changes relative to sbcl-1.9.38:
     clisp.  (lp#576787, thanks to Josh Elsasser)
   * new platform: experimental support for ppc/openbsd (thanks to Josh
     Elsasser).
+  * bug fix: Floating-point traps now work on ppc/linux.
 
 changes in sbcl-1.0.38 relative to sbcl-1.0.37:
   * incompatible change: Thread names are now restricted to SIMPLE-STRINGs
diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp
index 897d310..4bd83cb 100644
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -158,7 +158,7 @@ sets the floating point modes to their current values (and thus is a no-op)."
 ;;; disabled by default. Joe User can explicitly enable them if
 ;;; desired.
 (defvar *saved-floating-point-modes*
-  '(:traps (:overflow #!-netbsd :invalid :divide-by-zero)
+  '(:traps (:overflow #!-(or netbsd ppc) :invalid :divide-by-zero)
     :rounding-mode :nearest :current-exceptions nil
     :accrued-exceptions nil :fast-mode nil
     #!+x86 :precision #!+x86 :53-bit))
diff --git a/src/runtime/ppc-linux-os.c b/src/runtime/ppc-linux-os.c
index fe22e41..eac1593 100644
--- a/src/runtime/ppc-linux-os.c
+++ b/src/runtime/ppc-linux-os.c
@@ -122,29 +122,21 @@ os_context_fp_control(os_context_t *context)
 void
 os_restore_fp_control(os_context_t *context)
 {
-    unsigned long control;
+    /* KLUDGE: mtfsf has to be run against a float register, so we
+     * construct the float we need to use as an integer, then cast
+     * a pointer to its storage to a double and load that.  For
+     * this to work, control must be the same width as a double,
+     * 64 bits.  And why aren't we using a union here, anyway? */
+    unsigned long long control;
     double d;
 
+    /* FIXME: We are only preserving enabled traps and rounding
+     * mode here.  Do we also want to preserve "fast mode"? */
     control = os_context_fp_control(context) &
-        /* FIXME: Should we preserve the user's requested rounding mode?
-
-        Note that doing
-
-        ~(FLOAT_STICKY_BITS_MASK | FLOAT_EXCEPTIONS_BYTE_MASK)
-
-        here leads to infinite SIGFPE for invalid operations, as
-        there are bits in the control register that need to be
-        cleared that are let through by that mask. -- CSR, 2002-07-16 */
-
-        FLOAT_TRAPS_BYTE_MASK;
+        (FLOAT_TRAPS_BYTE_MASK | FLOAT_ROUNDING_MODE_MASK);
 
     d = *((double *) &control);
-    /* Hmp.  Apparently the following doesn't work either:
-
     asm volatile ("mtfsf 0xff,%0" : : "f" (d));
-
-    causing segfaults at the first GC.
-    */
 }
 
 void
diff --git a/src/runtime/ppc-linux-os.h b/src/runtime/ppc-linux-os.h
index 3ae5596..714d40d 100644
--- a/src/runtime/ppc-linux-os.h
+++ b/src/runtime/ppc-linux-os.h
@@ -10,6 +10,7 @@ static inline os_context_t *arch_os_get_context(void **void_context)
 }
 
 unsigned long os_context_fp_control(os_context_t *context);
+#define RESTORE_FP_CONTROL_FROM_CONTEXT
 void os_restore_fp_control(os_context_t *context);
 
 #endif /* _PPC_LINUX_OS_H */
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index 0fcf284..289360f 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -93,7 +93,7 @@
 (assert (= 0.0d0 (scale-float 1.0d0 (1- most-negative-fixnum))))
 
 (with-test (:name (:scale-float-overflow :bug-372)
-            :fails-on '(or :ppc :darwin)) ;; bug 372
+            :fails-on :darwin) ;; bug 372
   (progn
     (assert (raises-error? (scale-float 1.0 most-positive-fixnum)
                            floating-point-overflow))
@@ -125,7 +125,7 @@
 (funcall (compile nil '(lambda () (tan (tan (round 0))))))
 
 (with-test (:name (:addition-overflow :bug-372)
-            :fails-on '(or :ppc :darwin (and :x86 :netbsd)))
+            :fails-on '(or (and :ppc :openbsd) :darwin (and :x86 :netbsd)))
   (assert (typep (nth-value
                   1
                   (ignore-errors
diff --git a/version.lisp-expr b/version.lisp-expr
index 9d3ff57..479921a 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.38.11"
+"1.0.38.12"