Add make-queueing-channel
From the build coordinator.
This commit is contained in:
parent
1782a33a18
commit
f8ac6e3dd9
1 changed files with 26 additions and 1 deletions
|
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-71)
|
#:use-module (srfi srfi-71)
|
||||||
|
#:use-module (ice-9 q)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 atomic)
|
#:use-module (ice-9 atomic)
|
||||||
|
|
@ -80,7 +81,9 @@
|
||||||
call-with-sigint
|
call-with-sigint
|
||||||
run-server/patched
|
run-server/patched
|
||||||
|
|
||||||
spawn-port-monitoring-fiber))
|
spawn-port-monitoring-fiber
|
||||||
|
|
||||||
|
make-queueing-channel))
|
||||||
|
|
||||||
(define (call-with-time-logging action thunk)
|
(define (call-with-time-logging action thunk)
|
||||||
(simple-format #t "debug: Starting ~A\n" action)
|
(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))
|
(sigaction SIGINT (car handler) (cdr handler))
|
||||||
;; restore original C handler.
|
;; restore original C handler.
|
||||||
(sigaction SIGINT #f))))))
|
(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))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue