Merge branch 'master' into Gtk
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 11 Jul 2013 20:23:29 +0000 (13:23 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Thu, 11 Jul 2013 20:23:29 +0000 (13:23 -0700)
1  2 
src/Makefile.in
src/runtime/runtime.pkg
src/runtime/thread.scm

diff --cc src/Makefile.in
Simple merge
Simple merge
index c9b328f6d1ed4c931e68211b12fab908472dfdc8,218365943a5e598611ab90db134abc4d66aab4fa..c7a5a87fb2df8d423a60283c46d41e3f4a0f5690
@@@ -246,11 -244,9 +247,10 @@@ USA
    (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 ()