From 29bcc8f3f6ffc1abdd13d775402d201b1c78c8fb Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 24 Aug 2019 04:26:31 +0000 Subject: [PATCH] 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. --- src/runtime/floenv.scm | 110 ++++++++++++++++------------------ src/runtime/thread.scm | 10 ++-- tests/runtime/test-floenv.scm | 2 +- 3 files changed, 60 insertions(+), 62 deletions(-) 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 -- 2.25.1