From faf4bfdfcb124306abe0d1a5be0176a286535c51 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 24 Jan 2020 19:13:39 +0000 Subject: Enable make-worker-thread-channel to create multiple worker threads. This will allow running multiple threads, that all listen on the same channel, enabling processing multiple jobs at one time. * src/cuirass/utils.scm (make-worker-thread-channel): Add a #:parallelism argument, and create as many threads as the given parallelism. --- src/cuirass/utils.scm | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index dfed4a9..f3ba18d 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -99,20 +99,24 @@ delimited continuations and fibers." (define %worker-thread-args (make-parameter #f)) -(define (make-worker-thread-channel initializer) +(define* (make-worker-thread-channel initializer + #:key (parallelism 1)) "Return a channel used to offload work to a dedicated thread. ARGS are the arguments of the worker thread procedure." (parameterize (((@@ (fibers internal) current-fiber) #f)) (let ((channel (make-channel))) - (let ((args (initializer))) - (call-with-new-thread - (lambda () - (parameterize ((%worker-thread-args args)) - (let loop () - (match (get-message channel) - (((? channel? reply) . (? procedure? proc)) - (put-message reply (apply proc args)))) - (loop)))))) + (for-each + (lambda _ + (let ((args (initializer))) + (call-with-new-thread + (lambda () + (parameterize ((%worker-thread-args args)) + (let loop () + (match (get-message channel) + (((? channel? reply) . (? procedure? proc)) + (put-message reply (apply proc args)))) + (loop))))))) + (iota parallelism)) channel))) (define (call-with-worker-thread channel proc) -- cgit v1.2.3