diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-04-20 22:07:35 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-04-20 22:07:35 +0100 |
| commit | df3b0021a23572001de9cc92c63feb9fb532ffe9 (patch) | |
| tree | 8de69c22935f70bb086cf285859b0913e1397177 | |
| parent | 6ea7eba938af6beb1dcbaff63206be5b706bfa71 (diff) | |
| download | build-coordinator-df3b0021a23572001de9cc92c63feb9fb532ffe9.tar build-coordinator-df3b0021a23572001de9cc92c63feb9fb532ffe9.tar.gz | |
Support destructors and lifetimes for worker threads
| -rw-r--r-- | guix-build-coordinator/utils/fibers.scm | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm index f6dba70..99941ad 100644 --- a/guix-build-coordinator/utils/fibers.scm +++ b/guix-build-coordinator/utils/fibers.scm @@ -16,18 +16,20 @@ (define* (make-worker-thread-channel initializer #:key (parallelism 1) - (delay-logger (lambda _ #f))) + (delay-logger (lambda _ #f)) + destructor + lifetime) "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))) (for-each (lambda _ - (let ((args (initializer))) - (call-with-new-thread - (lambda () + (call-with-new-thread + (lambda () + (let init ((args (initializer))) (parameterize ((%worker-thread-args args)) - (let loop () + (let loop ((current-lifetime lifetime)) (match (get-message channel) (((? channel? reply) sent-time (? procedure? proc)) (let ((time-delay @@ -53,7 +55,15 @@ arguments of the worker thread procedure." "worker-thread: exception: ~A ~A\n" key args) (backtrace)))) #:unwind? #t))))) - (loop))))))) + (if (number? current-lifetime) + (unless (< current-lifetime 0) + (loop (if current-lifetime + (- current-lifetime 1) + #f))) + (loop #f)))) + (when destructor + (apply destructor args) + (init (initializer)))))) (iota parallelism)) channel))) |