Split the thread pool used for database connections

In to two thread pools, a default one, and one reserved for essential
functionality.

There are some pages that use slow queries, so this should help stop those
pages block other operations.

1 files changed, 12 insertions, 35 deletions

diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm
index 2527cf4..c5c6bdf 100644
--- a/guix-data-service/utils.scm
+++ b/guix-data-service/utils.scm
@@ -31,9 +31,8 @@
             with-time-logging
             prevent-inlining-for-tests
 
-            %thread-pool-threads
-            %thread-pool-idle-seconds
-            %thread-pool-idle-thunk
+            thread-pool-channel
+            make-thread-pool-channel
             parallel-via-thread-pool-channel
             par-map&
             letpar&
@@ -63,16 +62,10 @@
 (define-syntax-rule (prevent-inlining-for-tests var)
   (set! var var))
 
-(define %thread-pool-threads
-  (make-parameter 8))
-
-(define %thread-pool-idle-seconds
-  (make-parameter #f))
-
-(define %thread-pool-idle-thunk
-  (make-parameter #f))
-
-(define* (make-thread-pool-channel threads)
+(define* (make-thread-pool-channel threads
+                                   #:key
+                                   idle-thunk
+                                   idle-seconds)
   (define (delay-logger seconds-delayed)
     (when (> seconds-delayed 1)
       (format
@@ -80,12 +73,6 @@
        "warning: thread pool delayed by ~1,2f seconds~%"
        seconds-delayed)))
 
-  (define idle-thunk
-    (%thread-pool-idle-thunk))
-
-  (define idle-seconds
-    (%thread-pool-idle-seconds))
-
   (let ((channel (make-channel)))
     (for-each
      (lambda _
@@ -142,27 +129,17 @@
      (iota threads))
     channel))
 
-(define %thread-pool-mutex (make-mutex))
-(define %thread-pool-channel #f)
-
-(define (make-thread-pool-channel!')
-  (with-mutex %thread-pool-mutex
-    (unless %thread-pool-channel
-      (set! %thread-pool-channel (make-thread-pool-channel
-                                  (%thread-pool-threads)))
-      (set! make-thread-pool-channel! (lambda () #t)))))
-
-(define make-thread-pool-channel!
-  (lambda () (make-thread-pool-channel!')))
+(define thread-pool-channel
+  (make-parameter #f))
 
 (define (defer-to-thread-pool-channel thunk)
-  (make-thread-pool-channel!)
   (let ((reply (make-channel)))
     (spawn-fiber
      (lambda ()
-       (put-message %thread-pool-channel (list reply
-                                               (get-internal-real-time)
-                                               thunk))))
+       (put-message (thread-pool-channel)
+                    (list reply
+                          (get-internal-real-time)
+                          thunk))))
     reply))
 
 (define (fetch-result-of-defered-thunk reply-channel)