Add make-queueing-channel

From the build coordinator.
This commit is contained in:
Christopher Baines 2024-10-31 16:42:22 +00:00
parent 1782a33a18
commit f8ac6e3dd9

View file

@ -20,6 +20,7 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-71)
#:use-module (ice-9 q)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 atomic)
@ -80,7 +81,9 @@
call-with-sigint
run-server/patched
spawn-port-monitoring-fiber))
spawn-port-monitoring-fiber
make-queueing-channel))
(define (call-with-time-logging action thunk)
(simple-format #t "debug: Starting ~A\n" action)
@ -1188,3 +1191,25 @@ If already in the worker thread, call PROC immediately."
(sigaction SIGINT (car handler) (cdr handler))
;; restore original C handler.
(sigaction SIGINT #f))))))
(define (make-queueing-channel channel)
(define queue (make-q))
(let ((queue-channel (make-channel)))
(spawn-fiber
(lambda ()
(while #t
(if (q-empty? queue)
(enq! queue
(perform-operation
(get-operation queue-channel)))
(let ((front (q-front queue)))
(perform-operation
(choice-operation
(wrap-operation (get-operation queue-channel)
(lambda (val)
(enq! queue val)))
(wrap-operation (put-operation channel front)
(lambda _
(q-pop! queue))))))))))
queue-channel))