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

Tweak the resource pool return behaviour

Browse source 
If there's lots of contention for the resource pool, there will be lots of
waiters, so telling all of them to retry whenever a resource is returned seems
wasteful. This commit adds a new option (assume-reliable-waiters?) which will
have the resource pool try to give a returned resource to the oldest waiter,
if this fails, it'll go back to the old behaviour of telling all waiters to
retry.
This commit is contained in:
Christopher Baines 2024-10-31 16:46:43 +00:00
parent de5e036ab1
commit af93bdcf5e
1 changed files with 76 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -121,7 +121,8 @@
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)
@ -245,9 +246,59 @@
waiters waiters
resources-last-used))))) resources-last-used)))))
(('return resource) (('return resource)
;; When a resource is returned, prompt all the waiters to request (if (and assume-reliable-waiters?
;; again. This is to avoid the pool waiting on channels that may (not (null? waiters)))
;; be dead. (let ((checkout-success?
(perform-operation
(choice-operation
(wrap-operation
(put-operation (last waiters)
resource)
(const #t))
(wrap-operation (sleep-operation 1)
(const #f))))))
(unless checkout-success?
(set! checkout-failure-count
(+ 1 checkout-failure-count)))
(if checkout-success?
(loop resources
available
(drop-right! waiters 1)
(begin
(list-set!
resources-last-used
(list-index (lambda (x)
(eq? x resource))
resources)
(get-internal-real-time))
resources-last-used))
(begin
(for-each
(lambda (waiter)
(spawn-fiber
(lambda ()
(perform-operation
(choice-operation
(put-operation waiter 'resource-pool-retry-checkout)
(sleep-operation 0.2))))))
waiters)
(loop resources
(cons resource available)
'()
(begin
(list-set!
resources-last-used
(list-index (lambda (x)
(eq? x resource))
resources)
(get-internal-real-time))
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 (for-each
(lambda (waiter) (lambda (waiter)
(spawn-fiber (spawn-fiber
@ -269,7 +320,7 @@
(eq? x resource)) (eq? x resource))
resources) resources)
(get-internal-real-time)) (get-internal-real-time))
resources-last-used))) resources-last-used)))))
(('stats reply) (('stats reply)
(let ((stats (let ((stats
`((resources . ,(length resources)) `((resources . ,(length resources))