Tweak the resource pool return behaviour
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:
parent
de5e036ab1
commit
af93bdcf5e
1 changed files with 76 additions and 25 deletions
|
|
@ -121,7 +121,8 @@
|
|||
destructor
|
||||
lifetime
|
||||
scheduler
|
||||
(name "unnamed"))
|
||||
(name "unnamed")
|
||||
assume-reliable-waiters?)
|
||||
(define (initializer/safe)
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
|
|
@ -245,9 +246,59 @@
|
|||
waiters
|
||||
resources-last-used)))))
|
||||
(('return resource)
|
||||
;; 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.
|
||||
(if (and assume-reliable-waiters?
|
||||
(not (null? waiters)))
|
||||
(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
|
||||
(lambda (waiter)
|
||||
(spawn-fiber
|
||||
|
|
@ -269,7 +320,7 @@
|
|||
(eq? x resource))
|
||||
resources)
|
||||
(get-internal-real-time))
|
||||
resources-last-used)))
|
||||
resources-last-used)))))
|
||||
(('stats reply)
|
||||
(let ((stats
|
||||
`((resources . ,(length resources))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue