Don't assume there is a current thread when interrupted.

Fixes error `No current thread!' when the thread timer interrupt
handler tries to find the interrupted thread's floating-point
environment and there is no current thread.

diff --git a/src/runtime/floenv.scm b/src/runtime/floenv.scm
index 29b3cae548cf93500f7fdd0ce54123a975514e65..df05a585d7b8edc6af606f9bbd5f8d61687bc726 100644 (file)
--- a/src/runtime/floenv.scm
+++ b/src/runtime/floenv.scm
@@ -59,8 +59,17 @@ USA.
 ;;; Save the floating-point environment and enter the default
 ;;; environment for the thread timer interrupt handler.
 
-(define (enter-default-float-environment)
-  (let ((fp-env (thread-float-environment (current-thread))))
+(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 ((ucode-primitive FLOAT-ENVIRONMENT 0))))
+                    (set-thread-float-environment! interrupted-thread fp-env)
+                    fp-env)
+                  fp-env))
+            ;; No idea what environment we're in.  Assume the worst.
+            ((ucode-primitive FLOAT-ENVIRONMENT 0)))))
     (if fp-env
        ((ucode-primitive SET-FLOAT-ENVIRONMENT 1) default-environment))
     fp-env))

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 7cc2030099c8169a6d45653c0e047c9f41556a60..218365943a5e598611ab90db134abc4d66aab4fa 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -296,7 +296,7 @@ USA.
   ;; Preserve the floating-point environment here to guarantee that the
   ;; thread timer won't raise or clear exceptions (particularly the
   ;; inexact result exception) that the interrupted thread cares about.
-  (let ((fp-env (enter-default-float-environment)))
+  (let ((fp-env (enter-default-float-environment first-running-thread)))
     (set! next-scheduled-timeout #f)
     (set-interrupt-enables! interrupt-mask/gc-ok)
     (deliver-timer-events)