From: Alastair Bridgewater <nyef@virtdev-1.lisphacker.com>
Date: Mon, 24 Oct 2011 19:25:11 +0000 (-0400)
Subject: Fix FP traps on OSX/x86.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=182a7b8391d0abea3f08e06c263b1db25edbf526;p=sbcl.git

Fix FP traps on OSX/x86.

  * De-cripple SB-INT:SET-FLOATING-POINT-MODES for this platform.

  * Enable restoring the FPU control word during interrupt handling
on this platform (RESTORE_FP_CONTROL_FROM_CONTEXT).

  * Implement restoring the FPU control word on this platform
(os_restore_fp_control).

  * Update :FAILS-ON information for the now-passing tests.

  * Update the commentary on test float.pure.lisp /
(ADDITION-OVERFLOW BUG-372) to more accurately reflect when it will
provide useful data (only when running float.pure.lisp separately).
---

diff --git a/NEWS b/NEWS
index eaba678..8de2e09 100644
--- a/NEWS
+++ b/NEWS
@@ -11,7 +11,7 @@ changes relative to sbcl-1.0.52:
     GETF, LOGBITP, LDB, and MASK-FIELD now arrange for non-primary values
     of multiple-valued places to be set to NIL, instead of signalling an
     error (per a careful reading of CLHS 5.1.2.3).
-  * bug fix: floating-point traps now work on darwin/x86-64.
+  * bug fix: floating-point traps now work on darwin/x86 and /x86-64.
   * bug fix: repair crash in x86oid darwin signal handling emulation
     when built with certain compilers.
 
diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp
index 86f402e..6a02139 100644
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -118,7 +118,7 @@ in effect."
             (or (cdr (assoc precision *precision-mode-alist*))
                 (error "unknown precision mode: ~S" precision))))
     ;; FIXME: This apparently doesn't work on Darwin
-    #!-(and darwin (or ppc x86))
+    #!-(and darwin ppc)
     (setf (floating-point-modes) modes))
   (values))
 
diff --git a/src/runtime/x86-darwin-os.c b/src/runtime/x86-darwin-os.c
index f10d071..fb57da5 100644
--- a/src/runtime/x86-darwin-os.c
+++ b/src/runtime/x86-darwin-os.c
@@ -509,4 +509,16 @@ catch_exception_raise(mach_port_t exception_port,
     return ret;
 }
 
+void
+os_restore_fp_control(os_context_t *context)
+{
+    /* KLUDGE: The x87 FPU control word is some nasty bitfield struct
+     * thing.  Rather than deal with that, just grab it as a 16-bit
+     * integer. */
+    unsigned short fpu_control_word =
+        *((unsigned short *)&context->uc_mcontext->FS.FPU_FCW);
+    /* reset exception flags and restore control flags on x87 FPU */
+    asm ("fldcw %0" : : "m" (fpu_control_word));
+}
+
 #endif
diff --git a/src/runtime/x86-darwin-os.h b/src/runtime/x86-darwin-os.h
index 20caa8c..f3b7311 100644
--- a/src/runtime/x86-darwin-os.h
+++ b/src/runtime/x86-darwin-os.h
@@ -40,6 +40,8 @@ void set_data_desc_addr(data_desc_t* desc, void* addr);
 #define SS __ss
 #define GS __gs
 
+#define FPU_FCW __fpu_fcw
+
 #else
 
 #define CONTEXT_ADDR_FROM_STEM(stem) &context->uc_mcontext->ss.stem
@@ -60,8 +62,11 @@ void set_data_desc_addr(data_desc_t* desc, void* addr);
 #define SS ss
 #define GS gs
 
-#endif /* __DARWIN_UNIX03 */
+#define FPU_FCW fpu_fcw
 
+#endif /* __DARWIN_UNIX03 */
 
+#define RESTORE_FP_CONTROL_FROM_CONTEXT
+void os_restore_fp_control(os_context_t *context);
 
 #endif /* _X86_DARWIN_OS_H */
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index a7d8e34..35f8628 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 '(and :darwin (or :ppc :x86))) ;; bug 372
+            :fails-on '(and :darwin :ppc)) ;; bug 372
   (progn
     (assert (raises-error? (scale-float 1.0 most-positive-fixnum)
                            floating-point-overflow))
@@ -126,7 +126,7 @@
 
 (with-test (:name (:addition-overflow :bug-372)
             :fails-on '(or (and :ppc :openbsd)
-                           (and (or :ppc :x86) :darwin)
+                           (and :ppc :darwin)
                            (and :x86 :netbsd)))
   (assert (typep (nth-value
                   1
@@ -143,9 +143,12 @@
 ;; control word, which can happen if the kernel clears the FPU control
 ;; (a reasonable thing for it to do) and the runtime fails to
 ;; compensate for this (see RESTORE_FP_CONTROL_WORD in interrupt.c).
+;; Note that this only works when running float.pure.lisp alone, as
+;; the preceeding "pure" test files aren't as free of side effects as
+;; we might like.
 (with-test (:name (:addition-overflow :bug-372 :take-2)
             :fails-on '(or (and :ppc :openbsd)
-                           (and (or :ppc :x86) :darwin)
+                           (and :ppc :darwin)
                            (and :x86 :netbsd)))
   (assert (typep (nth-value
                   1