Merge branch 'master' into Gtk.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Tue, 29 May 2012 20:14:09 +0000 (13:14 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Tue, 29 May 2012 20:14:09 +0000 (13:14 -0700)
1  2 
src/runtime/runtime.pkg
src/runtime/thread.scm

Simple merge
index cb9f7f97af34a8fdabd4d80f46b985c6c241532f,6c8ab61955f28095cd05df25b7ed2833dc568f14..69aee3ad5357682d09a3b1d950cc66ee11c528cf
@@@ -555,32 -524,14 +555,37 @@@ USA
          (%suspend-current-thread)
          result)
        (lambda ()
-         (%deregister-io-thread-event registration-2)
-         (%deregister-io-thread-event registration-1)
+         (%maybe-deregister-io-thread-event registration-2)
+         (%maybe-deregister-io-thread-event registration-1)
          (%maybe-toggle-thread-timer)))))))
  
+ (define (%maybe-deregister-io-thread-event tentry)
+   ;; Ensure that another thread does not unwind our registration.
+   (if (eq? (current-thread) (tentry/thread tentry))
+       (delete-tentry! tentry)))
++
 +(define (block-on-process-status-change)
 +  (without-interrupts
 +   (lambda ()
 +     (let ((registration))
 +       (dynamic-wind
 +      (lambda ()
 +        (let ((thread (current-thread)))
 +          (set! registration
 +                (%register-io-thread-event
 +                 'PROCESS-STATUS-CHANGE
 +                 'READ
 +                 thread
 +                 (lambda (mode)
 +                   (declare (ignore mode))
 +                   unspecific)
 +                 #f #t)))
 +        (%maybe-toggle-thread-timer))
 +      (lambda ()
 +        (%suspend-current-thread))
 +      (lambda ()
 +        (%deregister-io-thread-event registration)
 +        (%maybe-toggle-thread-timer)))))))
  \f
  (define (permanently-register-io-thread-event descriptor mode thread event)
    (register-io-thread-event-1 descriptor mode thread event