smp: Add copy-select-registry!.

diff --git a/src/runtime/io.scm b/src/runtime/io.scm
index 93f23e891ca1737ce913567c652301754793a52f..70cca085ffb52d8687884a269a49e5bcf66051ef 100644 (file)
--- 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)))
 \f
 (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)))
 \f
 ;;;; Interface to dynamic loader
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 4ecd6737a9fe9389cdbdbfb27792d36fdc391606..c02f25f610510d8d5e1a5d4b7ad10b81b720a9c4 100644 (file)
--- 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!