(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))
 
 
 
 
 
 
 
 
 
 