;; Producer/Consumer-Puffer mit Condition-Locks

(define-record-type :buffer
  (really-make-buffer data lock available empty)
  buffer?
  (data buffer-data set-buffer-data!)
  (lock buffer-lock)
  (available buffer-available)
  (empty buffer-empty))

(define (make-buffer)
  (let ((lock (make-lock)))
    (really-make-buffer #f
                        lock
                        (make-condition-lock lock)
                        (make-condition-lock lock))))

(define (with-lock lock thunk)
  (obtain-lock lock)
  (let ((value (thunk)))
    (release-lock lock)
    value))

(define (insert buffer value)
  (with-lock (buffer-lock buffer)
    (lambda ()
      (let loop ()
        (cond
         ((buffer-data buffer)
          (wait-condition-lock (buffer-empty buffer))
          (loop))
         (else
          (set-buffer-data! buffer value)
          (signal-condition-lock (buffer-available buffer))))))))

(define (remove buffer)
  (with-lock (buffer-lock buffer)
    (lambda ()
      (let loop ()
        (cond
         ((buffer-data buffer)
          => (lambda (value)
               (set-buffer-data! buffer #f)
               (signal-condition-lock (buffer-empty buffer))
               value))
         (else
          (wait-condition-lock (buffer-available buffer))
          (loop)))))))