From 83dcf806feb364919a51e686910cd3d892affb37 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 1 Jul 2013 15:15:25 +0000 Subject: [PATCH] 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. --- src/runtime/floenv.scm | 13 +++++++++++-- src/runtime/thread.scm | 2 +- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/runtime/floenv.scm b/src/runtime/floenv.scm index 29b3cae54..df05a585d 100644 --- 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 7cc203009..218365943 100644 --- 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) -- 2.25.1