;; Lock-Conditions

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

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

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

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

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