From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 24 Aug 2019 04:26:31 +0000 (+0000)
Subject: Fix two bugs in floating-point environment.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~72
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=29bcc8f3f6ffc1abdd13d775402d201b1c78c8fb;p=mit-scheme.git
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 78cfb0dc5..e24656d0c 100644
--- 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))))
(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 1f0adb5fd..7a7006c8f 100644
--- 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 4339e390c..d00b64ad1 100644
--- 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