Support naming the worker thread channel threads

1 files changed, 13 insertions, 2 deletions

diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm
index 4a7572d..d532960 100644
--- a/guix-build-coordinator/utils/fibers.scm
+++ b/guix-build-coordinator/utils/fibers.scm
@@ -6,6 +6,8 @@
   #:use-module (fibers channels)
   #:use-module (fibers operations)
   #:use-module (fibers conditions)
+  #:use-module ((guix build syscalls)
+                #:select (set-thread-name))
   #:use-module (guix-build-coordinator utils)
   #:export (make-worker-thread-channel
             call-with-worker-thread
@@ -27,14 +29,23 @@
                                      destructor
                                      lifetime
                                      (log-exception? (const #t))
-                                     (expire-on-exception? #f))
+                                     (expire-on-exception? #f)
+                                     (name "unnamed"))
   "Return a channel used to offload work to a dedicated thread.  ARGS are the
 arguments of the worker thread procedure."
   (let ((channel (make-channel)))
     (for-each
-     (lambda _
+     (lambda (thread-index)
        (call-with-new-thread
         (lambda ()
+          (catch 'system-error
+            (lambda ()
+              (set-thread-name
+               (string-append
+                name " w t "
+                (number->string thread-index))))
+            (const #t))
+
           (let init ((args (initializer)))
             (parameterize ((%worker-thread-args args))
               (let loop ((current-lifetime lifetime))