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

Always assume that resource pool waiters will stick around

Browse source 
As I think this is a more efficient design.
This commit is contained in:
Christopher Baines 2024-11-05 09:36:31 +00:00
parent d310632f26
commit 6bf1747f55
2 changed files with 14 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

1
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1839,7 +1839,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
db-conn) db-conn)
1 1
#:name "postgres" #:name "postgres"
#:assume-reliable-waiters? #t
#:min-size 0)) #:min-size 0))
(define package-ids-promise (define package-ids-promise

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

@ -121,8 +121,7 @@
destructor destructor
lifetime lifetime
scheduler scheduler
(name "unnamed") (name "unnamed"))
assume-reliable-waiters?)
(define (initializer/safe) (define (initializer/safe)
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
@ -246,8 +245,18 @@
waiters waiters
resources-last-used))))) resources-last-used)))))
(('return resource) (('return resource)
(if (and assume-reliable-waiters? (if (null? waiters)
(not (null? waiters))) (loop resources
(cons resource available)
waiters
(begin
(list-set!
resources-last-used
(list-index (lambda (x)
(eq? x resource))
resources)
(get-internal-real-time))
resources-last-used))
(let ((checkout-success? (let ((checkout-success?
(perform-operation (perform-operation
(choice-operation (choice-operation
@ -294,33 +303,7 @@
(eq? x resource)) (eq? x resource))
resources) resources)
(get-internal-real-time)) (get-internal-real-time))
resources-last-used))))) resources-last-used)))))))
(begin
;; When a resource is returned, prompt all the waiters
;; to request again. This is to avoid the pool waiting
;; on channels that may be dead.
(for-each
(lambda (waiter)
(spawn-fiber
(lambda ()
(perform-operation
(choice-operation
(put-operation waiter 'resource-pool-retry-checkout)
(sleep-operation 10))))))
waiters)
(loop resources
(cons resource available)
;; clear waiters, as they've been notified
'()
(begin
(list-set!
resources-last-used
(list-index (lambda (x)
(eq? x resource))
resources)
(get-internal-real-time))
resources-last-used)))))
(('stats reply) (('stats reply)
(let ((stats (let ((stats
`((resources . ,(length resources)) `((resources . ,(length resources))