Avoid calling deq! if the queue is empty
All checks were successful
/ test (push) Successful in 9s

This commit is contained in:
Christopher Baines 2025-07-06 18:49:09 +01:00
parent ec2f2489a2
commit f4b48a1499

View file

@ -365,7 +365,11 @@
((reply . timeout) ((reply . timeout)
(if (and timeout (if (and timeout
(< timeout current-internal-time)) (< timeout current-internal-time))
(waiter-loop (deq! waiters)) (if (q-empty? waiters)
(loop resources
(cons resource available)
waiters)
(waiter-loop (deq! waiters)))
(begin (begin
(if timeout (if timeout
(let ((reply-timeout (let ((reply-timeout
@ -795,7 +799,13 @@
((reply . timeout) ((reply . timeout)
(if (and timeout (if (and timeout
(< timeout current-internal-time)) (< timeout current-internal-time))
(waiter-loop (deq! waiters)) (if (q-empty? waiters)
(loop (cons resource resources)
(cons resource available)
waiters
(cons (get-internal-real-time)
resources-last-used))
(waiter-loop (deq! waiters)))
(begin (begin
(if timeout (if timeout
(let ((reply-timeout (let ((reply-timeout
@ -938,7 +948,19 @@
((reply . timeout) ((reply . timeout)
(if (and timeout (if (and timeout
(< timeout current-internal-time)) (< timeout current-internal-time))
(waiter-loop (deq! waiters)) (if (q-empty? 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))
(waiter-loop (deq! waiters)))
(begin (begin
(if timeout (if timeout
(let ((reply-timeout (let ((reply-timeout