diff options
Diffstat (limited to 'guix-build-coordinator/utils/fibers.scm')
| -rw-r--r-- | guix-build-coordinator/utils/fibers.scm | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm index 93626c7..a064175 100644 --- a/guix-build-coordinator/utils/fibers.scm +++ b/guix-build-coordinator/utils/fibers.scm @@ -51,6 +51,8 @@ (name "unnamed")) "Return a channel used to offload work to a dedicated thread. ARGS are the arguments of the worker thread procedure." + (define thread-proc-vector + (make-vector parallelism #f)) (define (initializer/safe) (let ((args @@ -103,7 +105,7 @@ arguments of the worker thread procedure." (sleep 1) (destructor/safe args))))) - (define (process channel args) + (define (process thread-index channel args) (let loop ((current-lifetime lifetime)) (let ((exception? (match (get-message channel) @@ -124,6 +126,9 @@ arguments of the worker thread procedure." internal-time-units-per-second) exn)) (lambda () + (vector-set! thread-proc-vector + thread-index + proc) (with-throw-handler #t (lambda () (call-with-values @@ -149,6 +154,10 @@ arguments of the worker thread procedure." (put-message reply response) + (vector-set! thread-proc-vector + thread-index + #f) + (match response (('worker-thread-error duration _) (when duration-logger @@ -188,7 +197,7 @@ arguments of the worker thread procedure." "worker-thread-channel: exception: ~A\n" exn)) (lambda () (parameterize ((%worker-thread-args args)) - (process channel args))) + (process thread-index channel args))) #:unwind? #t) (when destructor @@ -196,7 +205,9 @@ arguments of the worker thread procedure." (init (initializer/safe)))))) (iota parallelism)) - channel)) + + (values channel + thread-proc-vector))) (define &worker-thread-timeout (make-exception-type '&worker-thread-timeout |