Guard against other threads unwinding block-on-io-descriptor.

This only arises when another thread uses within-continuation to
unwind block-on-io-descriptor.  Such an unwinding can leave the
console-thread waiting for nothing.  With no other io-registrations
nor runnable threads, the runtime busy-waits.

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 5dd6f48f52733386c029b80633b4dedadcb3dd08..6c8ab61955f28095cd05df25b7ed2833dc568f14 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -524,9 +524,14 @@ 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)))
 \f
 (define (permanently-register-io-thread-event descriptor mode thread event)
   (register-io-thread-event-1 descriptor mode thread event