From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 18 Jul 2015 23:59:37 +0000 (-0700)
Subject: Add io-waiter-registry, a copy of io-registry.
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5aadd777fcf77bed06569d70b617f3914ffceb10;p=mit-scheme.git

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 88cd53bf8..363d7f691 100644
--- 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