From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Tue, 29 May 2012 20:14:09 +0000 (-0700)
Subject: Merge branch 'master' into Gtk.
X-Git-Tag: mit-scheme-pucked-9.2.12~592
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4399d71a55057d34c758b298a9b986bc25661932;p=mit-scheme.git

Merge branch 'master' into Gtk.
---

4399d71a55057d34c758b298a9b986bc25661932
diff --cc src/runtime/thread.scm
index cb9f7f97a,6c8ab6195..69aee3ad5
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@@ -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)))))))
  
  (define (permanently-register-io-thread-event descriptor mode thread event)
    (register-io-thread-event-1 descriptor mode thread event