cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make it possible to increase the number of thread pool threads

Browse source 
And double the default to 16.
This commit is contained in:
Christopher Baines 2022-10-02 15:08:18 +01:00
parent ce2e13aa45
commit ff77bbea7e
2 changed files with 19 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

9
guix-data-service/utils.scm
View file

@ -28,6 +28,7 @@
with-time-logging
prevent-inlining-for-tests
%thread-pool-threads
parallel-via-thread-pool-channel
par-map&
letpar&
@ -55,7 +56,10 @@
(define-syntax-rule (prevent-inlining-for-tests var)
(set! var var))
(define* (make-thread-pool-channel #:key (threads 8))
(define %thread-pool-threads
(make-parameter 8))
(define* (make-thread-pool-channel threads)
(define (delay-logger seconds-delayed)
(when (> seconds-delayed 1)
(format
@ -107,7 +111,8 @@
(define (make-thread-pool-channel!')
(with-mutex %thread-pool-mutex
(unless %thread-pool-channel
(set! %thread-pool-channel (make-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!

13
scripts/guix-data-service.in
View file

@ -33,6 +33,7 @@
(system repl repl)
(gcrypt pk-crypto)
(guix pki)
(guix-data-service utils)
(guix-data-service config)
(guix-data-service database)
(guix-data-service substitutes)
@ -91,6 +92,12 @@
(alist-cons 'host
arg
(alist-delete 'host result))))
(option '("thread-pool-threads") #t #f
(lambda (opt name arg result)
(alist-cons 'thread-pool-threads
(string->number arg)
(alist-delete 'thread-pool-threads
result))))
(option '("postgresql-statement-timeout") #t #f
(lambda (opt name arg result)
(alist-cons 'postgresql-statement-timeout
@ -111,6 +118,7 @@
(_ #t)))
(port . 8765)
(host . "0.0.0.0")
(thread-pool-threads . 16)
(postgresql-statement-timeout . 60000)))
@ -171,7 +179,10 @@
(current-error-port))
#f)))
(%show-error-details
(assoc-ref opts 'show-error-details)))
(assoc-ref opts 'show-error-details))
(%thread-pool-threads
(assoc-ref opts 'thread-pool-threads)))
(let* ((startup-completed
(make-atomic-box