Add io-waiter-registry, a copy of io-registry.

The io-waiter will apply test-select-registry to this copy while other
threads modify the original.

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 88cd53bf8ac417e09546044373cf8eff53037aa6..363d7f691070dd9eaee6278934d2baba901f7e32 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -211,6 +211,10 @@ USA.
   (set! io-registry (and have-select? (make-select-registry)))
   (set! io-registrations #f)
   (set! subprocess-registrations '())
+  (set! io-waiter-registry (and ((ucode-primitive have-select? 0))
+                               enable-smp?
+                               (make-select-registry)))
+  (set! io-waiter-registry-stale? #t)
   (set! io-waiter #f))
 
 (define (without-preemption thunk)
@@ -643,6 +647,8 @@ USA.
 ;;;; IO Waiter
 
 (define io-waiter)
+(define io-waiter-registry)
+(define io-waiter-registry-stale?)
 
 (define (%maybe-wake-idle-processor id)
   (%assert-locked '%maybe-wake-idle-processor)
@@ -659,7 +665,8 @@ USA.
 (define (%maybe-wake-io-waiter id)
   (%assert-locked '%maybe-wake-io-waiter)
   (if (and io-waiter
-          (not (eq? id io-waiter)))
+          (not (eq? id io-waiter))
+          io-waiter-registry-stale?)
       ((ucode-primitive smp-wake 1) io-waiter)))
 
 (define (wait-for-io id)
@@ -680,9 +687,23 @@ USA.
 (define (io-waiter-wait id)
   (%assert-locked 'io-waiter-wait)
   (%assert (not (%thread id)) "io-waiter-wait: still running a thread")
-  (let ((result (begin
-                 (%unlock)
-                 (test-select-registry io-registry #t))))
+  (let ((result
+        (let ((registry
+               (if enable-smp?
+                   (begin
+                     (if io-waiter-registry-stale?
+                         (begin
+                           (copy-select-registry! io-registry
+                                                  io-waiter-registry)
+                           (set! io-waiter-registry-stale? #f)))
+                     io-waiter-registry)
+                   io-registry)))
+          (%unlock)
+          (%assert (interrupt-mask-ok?)
+                   "io-waiter-wait: wrong interrupt mask")
+          ;; Will not block if there are ANY pending interrupts, as
+          ;; if we had set-interrupt-enables! to interrupt-mask/all.
+          (test-select-registry registry #t))))
     (%assert (interrupt-mask-ok?) "io-waiter-wait: interrupt enables clobbered")
     (%lock)
     (signal-select-result result)
@@ -823,6 +844,7 @@ USA.
             ((and (eqv? descriptor (dentry/descriptor dentry))
                   (eq? mode (dentry/mode dentry)))
              (remove-from-select-registry! io-registry descriptor mode)
+             (set! io-waiter-registry-stale? #t)
              (let ((prev (dentry/prev dentry))
                    (next (dentry/next dentry)))
                (if prev
@@ -863,6 +885,7 @@ USA.
           (remove-from-select-registry! io-registry
                                         (dentry/descriptor dentry)
                                         (dentry/mode dentry))
+          (set! io-waiter-registry-stale? #t)
           (let ((prev (dentry/prev dentry))
                 (next (dentry/next dentry)))
             (if prev
@@ -896,7 +919,8 @@ USA.
               (if io-registrations
                   (set-dentry/prev! io-registrations dentry))
               (set! io-registrations dentry)
-              (add-to-select-registry! io-registry descriptor mode)))
+              (add-to-select-registry! io-registry descriptor mode)
+              (set! io-waiter-registry-stale? #t)))
            ((and (eqv? descriptor (dentry/descriptor dentry))
                  (eq? mode (dentry/mode dentry)))
             (set-tentry/dentry! tentry dentry)
@@ -994,6 +1018,7 @@ USA.
          (remove-from-select-registry! io-registry
                                        (dentry/descriptor dentry)
                                        (dentry/mode dentry))
+         (set! io-waiter-registry-stale? #t)
          (let ((prev (dentry/prev dentry))
                (next (dentry/next dentry)))
            (if prev