;; Condition-Locks mit Broadcast

(define-record-type :condition-lock
  (really-make-condition-lock lock waiting-locks)
  condition-lock?
  (lock condition-lock-lock)
  (waiting-locks condition-lock-waiting-locks
		 set-condition-lock-waiting-locks!))

(define (make-condition-lock lock)
  (really-make-condition-lock lock '()))

(define (wait-condition-lock cond-lock)
  (let ((waiting-lock (make-lock)))
    (obtain-lock waiting-lock)
    (set-condition-lock-waiting-locks!
     cond-lock
     (cons waiting-lock
	   (condition-lock-waiting-locks cond-lock)))
    (let ((lock (condition-lock-lock cond-lock)))
      (release-lock lock)
      (obtain-lock waiting-lock)
      (obtain-lock lock))))

(define (signal-condition-lock cond-lock)
  (let ((waiting-locks (condition-lock-waiting-locks cond-lock)))
    (if (not (null? waiting-locks))
	(begin
	  (set-condition-lock-waiting-locks! 
	   cond-lock (cdr waiting-locks))
	  (release-lock (car waiting-locks))))))

(define (broadcast-condition-lock cond-lock)
  (let ((waiting-locks (condition-lock-waiting-locks cond-lock)))
    (set-condition-lock-waiting-locks! cond-lock '())
    (let loop ((waiting-locks waiting-locks))
      (if (not (null? waiting-locks))
	  (begin
	    (release-lock (car waiting-locks))
	    (loop (cdr waiting-locks)))))))