Add copy-select-registry!.

diff --git a/src/runtime/io.scm b/src/runtime/io.scm
index c7fc931d13453ad45b3eebbe3c5558ca0b5271c5..523bc1aafb5f36daa274e2c2b2a840c953ef0eda 100644 (file)
--- a/src/runtime/io.scm
+++ b/src/runtime/io.scm
@@ -522,6 +522,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)
@@ -628,13 +636,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))
@@ -665,6 +667,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 5435bee1dc7c922e83a7c83ba3835293f5ff06b3..e9215e2f683ac867110015e297348c2e70c29e74 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3336,6 +3336,7 @@ USA.
          have-select?)
   (export (runtime thread)
          add-to-select-registry!
+         copy-select-registry!
          have-select?
          make-select-registry
          remove-from-select-registry!