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

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

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