[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 3/4] Enable make-worker-thread-channel to create multiple worker
From: |
Christopher Baines |
Subject: |
[PATCH 3/4] Enable make-worker-thread-channel to create multiple worker threads. |
Date: |
Fri, 24 Jan 2020 19:44:05 +0000 |
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)
--
2.24.1