aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-11-05 09:36:31 +0000
committerChristopher Baines <mail@cbaines.net>2024-11-05 09:41:30 +0000
commit6bf1747f5580eb582789eb7b77f17c82c6489059 (patch)
tree3d62b29be5cdbdddd88651760f901846de6e36f2
parentd310632f26bfbb9272a5f4019f66045256327702 (diff)
downloaddata-service-6bf1747f5580eb582789eb7b77f17c82c6489059.tar
data-service-6bf1747f5580eb582789eb7b77f17c82c6489059.tar.gz
Always assume that resource pool waiters will stick around
As I think this is a more efficient design.
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm1
-rw-r--r--guix-data-service/utils.scm45
2 files changed, 14 insertions, 32 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 0d09b54..1fd88b3 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -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
diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm
index 5436eb8..b53f33f 100644
--- a/guix-data-service/utils.scm
+++ b/guix-data-service/utils.scm
@@ -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))