From 470929b8edf74fa55e0beef4af81c66f9060a036 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 17 Dec 2014 02:12:58 -0700
Subject: [PATCH] smp: Add copy-select-registry!.

---
 src/runtime/io.scm      | 22 +++++++++++++++-------
 src/runtime/runtime.pkg |  1 +
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/runtime/io.scm b/src/runtime/io.scm
index 93f23e891..70cca085f 100644
--- a/src/runtime/io.scm
+++ b/src/runtime/io.scm
@@ -544,6 +544,14 @@ USA.
    descriptor
    (encode-select-registry-mode mode))
   (set-select-registry-length! registry #f))
+
+(define (get-select-registry-length registry)
+  (or (select-registry-length registry)
+      (let ((rl
+	     ((ucode-primitive select-registry-length 1)
+	      (select-registry-handle registry))))
+	(set-select-registry-length! registry rl)
+	rl)))
 
 (define (test-for-io-on-channel channel mode #!optional block?)
   (test-for-io-on-descriptor (channel-descriptor-for-select channel)
@@ -655,13 +663,7 @@ USA.
 
 (define (allocate-select-registry-result-vectors registry)
   (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((n
-	   (or (select-registry-length registry)
-	       (let ((rl
-		      ((ucode-primitive select-registry-length 1)
-		       (select-registry-handle registry))))
-		 (set-select-registry-length! registry rl)
-		 rl))))
+    (let ((n (get-select-registry-length registry)))
       (let loop ((rv select-registry-result-vectors))
 	(if (pair? rv)
 	    (let ((vfd (caar rv))
@@ -692,6 +694,12 @@ USA.
 	  (set! select-registry-result-vectors
 		(cons (cons vfd vmode) select-registry-result-vectors))))
     (set-interrupt-enables! interrupt-mask)))
+
+(define (copy-select-registry! from to)
+  ((ucode-primitive copy-select-registry 2)
+   (select-registry-handle from)
+   (select-registry-handle to))
+  (set-select-registry-length! to (get-select-registry-length from)))
 
 ;;;; Interface to dynamic loader
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 4ecd6737a..c02f25f61 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3286,6 +3286,7 @@ USA.
 	  have-select?)
   (export (runtime thread)
 	  add-to-select-registry!
+	  copy-select-registry!
 	  have-select?
 	  make-select-registry
 	  remove-from-select-registry!
-- 
2.25.1