(without-interrupts %suspend-current-thread))
(define (%suspend-current-thread)
+ (%trace ";%suspend-current-thread: "first-running-thread"\n")
(call-with-current-thread #f
(lambda (thread)
- (let ((fp-env (flo:environment))
- (block-events? (thread/block-events? thread)))
+ (let ((block-events? (thread/block-events? thread)))
(set-thread/block-events?! thread #f)
(maybe-signal-io-thread-events)
(let ((any-events? (handle-thread-events thread)))
;; 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 (flo:environment)))
+ (%trace ";thread-timer: interrupt in "first-running-thread"\n")
+ (let ((fp-env (enter-default-float-environment first-running-thread)))
+ (flo:set-environment! (flo:default-environment))
(set! next-scheduled-timeout #f)
(set-interrupt-enables! interrupt-mask/gc-ok)
(deliver-timer-events)
(run-thread thread))
((not (eq? 'RUNNING-WITHOUT-PREEMPTION
(thread/execution-state thread)))
+ (%trace ";thread-timer: yielding "thread" to "(thread/next thread)"\n")
(yield-thread thread fp-env))
(else
- (flo:set-environment! fp-env)
+ (%trace ";thread-timer: continuing with "thread"\n")
+ (restore-float-environment-from-default fp-env)
(%resume-current-thread thread))))))
+(define %trace? #f)
+
+(define-syntax %trace
+ (syntax-rules ()
+ ((_ . MSG)
+ (if %trace? ((lambda () (outf-error . MSG)))))))
+
(define (yield-current-thread)
(without-interrupts
(lambda ()