Use default io waiters in the thread pool

To allow creating thread pools from fibers.

1 files changed, 12 insertions, 3 deletions

diff --git a/knots/thread-pool.scm b/knots/thread-pool.scm
index 24260cd..9f3dd2d 100644
--- a/knots/thread-pool.scm
+++ b/knots/thread-pool.scm
@@ -32,6 +32,7 @@
   #:use-module (fibers timers)
   #:use-module (fibers channels)
   #:use-module (fibers operations)
+  #:use-module (knots)
   #:export (set-thread-name
             thread-name
 
@@ -161,7 +162,8 @@ from there, or #f if that would be an empty string."
                            thread-lifetime
                            (log-exception? (const #t))
                            (expire-on-exception? #f)
-                           (name "unnamed"))
+                           (name "unnamed")
+                           (use-default-io-waiters? #t))
   "Return a channel used to offload work to a dedicated thread.  ARGS are the
 arguments of the thread pool procedure."
   (define param
@@ -293,7 +295,7 @@ arguments of the thread pool procedure."
                           #f)))
               (loop #f))))))
 
-  (let ((channel (make-channel)))
+  (define (start-threads channel)
     (for-each
      (lambda (thread-index)
        (call-with-new-thread
@@ -323,7 +325,14 @@ arguments of the thread pool procedure."
               (destructor/safe args))
 
             (init (initializer/safe))))))
-     (iota size))
+     (iota size)))
+
+  (let ((channel (make-channel)))
+    (if use-default-io-waiters?
+        (call-with-default-io-waiters
+         (lambda ()
+           (start-threads channel)))
+        (start-threads channel))
 
     (thread-pool channel
                  param