(module test-chans mzscheme (provide acquire-input release-input acquire-output release-output) (define request-channel (make-channel)) (define writer-acquire-channel (make-channel)) (define reader-acquire-channel (make-channel)) (define release-channel (make-channel)) (define readers 0) (define writer? #f) (define (satisfy-readers n) (when (positive? n) (set! readers (+ readers 1)) (channel-put reader-acquire-channel (open-input-file "test.txt")) (satisfy-readers (- n 1)))) (define (satisfy-writer) (set! writer? #t) (channel-put writer-acquire-channel (open-output-file "test.txt" 'replace))) (define reader-requests 0) (define writer-requests 0) (define (acquire-input) (channel-put request-channel 'read-request) (channel-get reader-acquire-channel)) (define (acquire-output) (channel-put request-channel 'write-request) (channel-get writer-acquire-channel)) (define (release-input port) (close-input-port port) (channel-put release-channel 'read-release)) (define (release-output port) (close-output-port port) (channel-put release-channel 'write-release)) (define (server-thunk) (define ready (object-wait-multiple #f release-channel request-channel)) (cond ((eq? ready 'write-request) (if (and (not writer?) (zero? readers)) (satisfy-writer) (set! writer-requests (+ writer-requests 1)))) ((eq? ready 'read-request) (if (and (not writer?) (zero? writer-requests)) (satisfy-readers 1) (set! reader-requests (+ reader-requests 1)))) ((eq? ready 'read-release) (set! readers (- readers 1)) (when (and (positive? writer-requests) (zero? readers) (not writer?)) (set! writer-requests (- writer-requests 1)) (satisfy-writer))) ((eq? ready 'write-release) (set! writer? #f) (cond ((positive? writer-requests) (set! writer-requests (- writer-requests 1)) (satisfy-writer)) ((positive? reader-requests) (satisfy-readers reader-requests) (set! reader-requests 0))))) (server-thunk)) (thread server-thunk))