Always assume that resource pool waiters will stick around
As I think this is a more efficient design.
This commit is contained in:
parent
d310632f26
commit
6bf1747f55
2 changed files with 14 additions and 32 deletions
|
|
@ -1839,7 +1839,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
|||
db-conn)
|
||||
1
|
||||
#:name "postgres"
|
||||
#:assume-reliable-waiters? #t
|
||||
#:min-size 0))
|
||||
|
||||
(define package-ids-promise
|
||||
|
|
|
|||
|
|
@ -121,8 +121,7 @@
|
|||
destructor
|
||||
lifetime
|
||||
scheduler
|
||||
(name "unnamed")
|
||||
assume-reliable-waiters?)
|
||||
(name "unnamed"))
|
||||
(define (initializer/safe)
|
||||
(with-exception-handler
|
||||
(lambda (exn)
|
||||
|
|
@ -246,8 +245,18 @@
|
|||
waiters
|
||||
resources-last-used)))))
|
||||
(('return resource)
|
||||
(if (and assume-reliable-waiters?
|
||||
(not (null? waiters)))
|
||||
(if (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?
|
||||
(perform-operation
|
||||
(choice-operation
|
||||
|
|
@ -294,33 +303,7 @@
|
|||
(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
|
||||
(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)))))
|
||||
resources-last-used)))))))
|
||||
(('stats reply)
|
||||
(let ((stats
|
||||
`((resources . ,(length resources))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue