From: Stas Boukarev <stassats@gmail.com>
Date: Sat, 16 Nov 2013 10:23:08 +0000 (+0400)
Subject: Inherit FP modes for new threads on Windows.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b14a61c6af3e3005c94e633e727177346240066e;p=sbcl.git

Inherit FP modes for new threads on Windows.

Newly created threads have all the traps cleared, while on other
platforms they are inherited from the parent thread.
---

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index d037f45..402fe68 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -1453,8 +1453,15 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
            (arguments     (if (listp arguments)
                               arguments
                               (list arguments)))
+           #!+win32
+           (fp-modes (dpb 0 sb!vm::float-sticky-bits ;; clear accrued bits
+                          (sb!vm:floating-point-modes)))
            (initial-function
              (named-lambda initial-thread-function ()
+               ;; Win32 doesn't inherit parent thread's FP modes,
+               ;; while it seems to happen everywhere else
+               #!+win32
+               (setf (sb!vm:floating-point-modes) fp-modes)
                ;; As it is, this lambda must not cons until we are
                ;; ready to run GC. Be very careful.
                (initial-thread-function-trampoline
diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 5da2c1b..788862b 100644
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -1565,3 +1565,22 @@
    (sb-thread:make-thread
     (lambda ()
       (alien-funcall (extern-alien "alloca_test" (function void)))))))
+
+(with-test (:name :fp-mode-inheritance-threads)
+  (flet ((test ()
+           (let ((thread-fp-mode)
+                 (fp-mode (dpb 0 sb-vm::float-sticky-bits (sb-vm:floating-point-modes))))
+             (sb-thread:join-thread
+              (sb-thread:make-thread
+               (lambda ()
+                 (setf thread-fp-mode
+                       (dpb 0 sb-vm::float-sticky-bits (sb-vm:floating-point-modes))))))
+             (assert (= fp-mode thread-fp-mode)))))
+    (test)
+    (sb-int:with-float-traps-masked (:divide-by-zero)
+      (test))
+    (setf (sb-vm:floating-point-modes)
+          (dpb sb-vm:float-divide-by-zero-trap-bit
+               sb-vm::float-traps-byte
+               (sb-vm:floating-point-modes)))
+    (test)))