Fix two bugs in floating-point environment.

1. Don't cache it in the current thread.

   We can't mark everywhere the cache needs to be invalidated --
   i.e., every floating-point instruction -- and it's not clear
   there's any performance benefit to the cache anyway.  The main
   performance cost, as I recall, was swapping environments on every
   thread switch, which we avoid for all threads in the default
   environment.

2. The default environment initialization left the machine in a wacky
   state after reset-package!, which caused many spurious exception
   traps once I undid the cache.  There's no need to preserve the
   machine environment here; we are setting up the default
   environment, after all, so the environment we're in when done
   should be the default one.

diff --git a/src/runtime/floenv.scm b/src/runtime/floenv.scm
index 78cfb0dc58de3eb481826d22e645d95c79167e5b..e24656d0c147c77aaa2c98346863b0fa04329aed 100644 (file)
--- a/src/runtime/floenv.scm
+++ b/src/runtime/floenv.scm
@@ -38,14 +38,12 @@ USA.
 ;;; even if it is operationally equivalent to the default environment.
 ;;;
 ;;; The floating-point environment is stored on the physical machine,
-;;; saved in the thread records of threads that are not running, and
-;;; cached in the thread record of the thread that is running.
+;;; and saved in the thread records of threads that are not running.
 ;;;
-;;; When the physical machine is updated, we invalidate the cache by
-;;; setting the current thread's floating-point environment to #T.
 ;;; When switching threads, if the old thread's floating-point
-;;; environment is #T, we grab the environment from the machine and
-;;; stash it in that thread before entering the new thread.  During
+;;; environment is #T meaning it cared about the floating-point
+;;; environment, we grab the environment from the machine and stash
+;;; it in that thread before entering the new thread.  During
 ;;; thread-switching, we need to be in the default floating-point
 ;;; environment so that the thread system logic doesn't get confused.
 ;;;
@@ -62,12 +60,16 @@ USA.
 (define (enter-default-float-environment interrupted-thread)
   (let ((fp-env
         (if interrupted-thread
-            (let ((fp-env (thread-float-environment interrupted-thread)))
-              (if (eqv? fp-env #t)
+            (let ((fp-env? (thread-float-environment interrupted-thread)))
+              ;; If the thread was just interrupted, it can't have a
+              ;; saved environment -- only a marker indicating
+              ;; whether it is in use or not.
+              (assert (or (eqv? fp-env? #t) (eqv? fp-env? #f)))
+              (if fp-env?
                   (let ((fp-env ((ucode-primitive float-environment 0))))
                     (set-thread-float-environment! interrupted-thread fp-env)
                     fp-env)
-                  fp-env))
+                  #f))
             ;; No idea what environment we're in.  Assume the worst.
             ((ucode-primitive float-environment 0)))))
     (if fp-env
@@ -103,51 +105,48 @@ USA.
           fp-env))))
 \f
 (define-integrable (using-floating-point-environment?)
-  (and (thread-float-environment (current-thread)) #t))
+  (thread-float-environment (current-thread)))
 
 (define-integrable (use-floating-point-environment!)
   (set-thread-float-environment! (current-thread) #t))
 
 (define (flo:environment)
-  (let ((fp-env (thread-float-environment (current-thread))))
-    (if (eqv? fp-env #t)
-       (let ((fp-env ((ucode-primitive float-environment 0))))
-         ;; Cache it now so we don't need to ask the machine again
-         ;; when we next switch threads.  There is a harmless race
-         ;; here if we are preempted.
-         (set-thread-float-environment! (current-thread) fp-env)
-         fp-env)
-       fp-env)))
+  (if (using-floating-point-environment?)
+      ((ucode-primitive float-environment 0))
+      #f))
 
 (define (flo:set-environment! fp-env)
-  (let ((old-fp-env (thread-float-environment (current-thread))))
-    (if (not (eqv? fp-env old-fp-env))
-       (begin
-         ;; Update the thread cache first; if we updated the machine
-         ;; first, then we might be preempted after that but before
-         ;; updating the thread cache, and the thread starts running
-         ;; again, there would be nothing to set the machine straight.
-         (set-thread-float-environment! (current-thread) fp-env)
-         ((ucode-primitive set-float-environment 1)
-          (or fp-env default-environment))))))
+  ;; If we are transitioning back to the default environment, do it
+  ;; once while the thread is still considered to be using the
+  ;; environment so that the thread system will take care to set the
+  ;; machine to the default environment.
+  (if (not fp-env)
+      ((ucode-primitive set-float-environment 1) default-environment))
+  ;; Next, if we are transitioning back to the default environment,
+  ;; mark the thread as not using the floating-point environment;
+  ;; otherwise mark the thread as using it -- but do this _before_ we
+  ;; set the machine state so that if we are preempted, the scheduler
+  ;; will know to save and restore it.
+  (set-thread-float-environment! (current-thread) (if fp-env #t #f))
+  ;; Finally, set the machine state if we are transitioning to a
+  ;; nondefault environment.
+  (if fp-env
+      ((ucode-primitive set-float-environment 1) fp-env)))
 
 (define (flo:update-environment! fp-env)
-  (let ((old-fp-env (thread-float-environment (current-thread))))
-    (if (not (eqv? fp-env old-fp-env))
-       ;; We need to prevent thread-switching between saving the
-       ;; floating-point environment in the thread record and updating
-       ;; the machine's state because we need the *old* state to be
-       ;; still in place when the update happens so that exceptions
-       ;; will be trapped.
-       ;;
-       ;; XXX We could just disable preemption, but we'd have to do
-       ;; that in DYNAMIC-WIND in case UPDATE-FLOAT-ENVIRONMENT
-       ;; signals an error, and DYNAMIC-WIND is super-expensive.
-       (without-interrupts
-        (lambda ()
-          (set-thread-float-environment! (current-thread) fp-env)
-          ((ucode-primitive update-float-environment 1)
-           (or fp-env default-environment)))))))
+  ;; Prevent thread-switching between when we notify the thread
+  ;; scheduler that the environment has changed and when we actually
+  ;; trigger the update, which must happen when the machine is in the
+  ;; *old* environment.
+  ;;
+  ;; XXX We could just disable preemption, but we'd have to do that
+  ;; in DYNAMIC-WIND in case UPDATE-FLOAT-ENVIRONMENT signals an
+  ;; error, and DYNAMIC-WIND is super-expensive.
+  (without-interrupts
+   (lambda ()
+     (set-thread-float-environment! (current-thread) (if fp-env #t #f))
+     ((ucode-primitive update-float-environment 1)
+      (or fp-env default-environment)))))
 
 (define default-environment)
 
@@ -158,18 +157,15 @@ USA.
   (set! default-environment
        (without-interrupts
         (lambda ()
-          (let ((fp-env ((ucode-primitive float-environment 0))))
-            ((ucode-primitive set-float-rounding-mode 1)
-             (%mode-name->number
-              (flo:default-rounding-mode)
-              '|#[(runtime floating-point-environment)reset-package!]|))
-            ((ucode-primitive clear-float-exceptions 1)
-             (flo:supported-exceptions))
-            ((ucode-primitive set-trapped-float-exceptions 1)
-             (flo:default-trapped-exceptions))
-            (let ((fp-env* ((ucode-primitive float-environment 0))))
-              ((ucode-primitive set-float-environment 1) fp-env)
-              fp-env*)))))
+          ((ucode-primitive set-float-rounding-mode 1)
+           (%mode-name->number
+            (flo:default-rounding-mode)
+            '|#[(runtime floating-point-environment)reset-package!]|))
+          ((ucode-primitive clear-float-exceptions 1)
+           (flo:supported-exceptions))
+          ((ucode-primitive set-trapped-float-exceptions 1)
+           (flo:default-trapped-exceptions))
+          ((ucode-primitive float-environment 0)))))
   (initialize-flonum-infinities!)
   unspecific)
 

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 1f0adb5fd7db5fad0651ef7bafe36cdd04e3e0b0..7a7006c8f3242ee8cfc611307295e5ba059ceb32 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -75,10 +75,12 @@ USA.
   ;; unwind the thread's state space when it is exited.
 
   (floating-point-environment #f)
-  ;; A floating-point environment descriptor, or #T if the thread is
-  ;; running and has modified its floating-point environment since it
-  ;; was last cached.  While a thread is running, this is a cache of
-  ;; the machine's floating-point environment.
+  ;; For the current thread: #t if the thread is using the
+  ;; floating-point environment, via flo:use-environment or
+  ;; flo:preserving-environment; #f if not.
+  ;;
+  ;; For any other thread: a floating-point environment descriptor if
+  ;; the floating-point environment is in use; #f if not.
 
   (mutexes '())
   ;; List of mutexes that this thread owns or is waiting to own.  Used

diff --git a/tests/runtime/test-floenv.scm b/tests/runtime/test-floenv.scm
index 4339e390c497f06f5640901dcad3a518b09c133c..d00b64ad156c892a07b9eb75c204d34ef7cf3dda 100644 (file)
--- a/tests/runtime/test-floenv.scm
+++ b/tests/runtime/test-floenv.scm
@@ -591,4 +591,4 @@ USA.
     (assert-eqv x0 0)
     (assert-eqv x1 0)
     (assert-eqv x2 (flo:exception:divide-by-zero))
-    (expect-failure (lambda () (assert-eqv x3 0)))))
\ No newline at end of file
+    (assert-eqv x3 0)))
\ No newline at end of file