scsh-common-0.6 0.6.7-8 / usr / share / scsh-0.6 / misc / mail.scm

; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.



; Mailboxes (to be used with the threads package)

(define (make-mailbox)
  (vector (make-lock) (make-queue) (make-queue)))

(define (mailbox-lock	  mbx) (vector-ref mbx 0))
(define (mailbox-messages mbx) (vector-ref mbx 1))
(define (mailbox-readers  mbx) (vector-ref mbx 2))

(define (mailbox-empty? mbx)
  (queue-empty? (mailbox-readers mbx)))

(define (mailbox-write mbx message)
  (with-lock (mailbox-lock mbx)
    (lambda ()
      (if (queue-empty? (mailbox-readers mbx))
	  (enqueue! (mailbox-messages mbx) message)
	  (condvar-set! (dequeue! (mailbox-readers mbx)) message)))))

(define (mailbox-read mbx)
  ((with-lock (mailbox-lock mbx)
     (lambda ()
       (if (queue-empty? (mailbox-messages mbx))
	   (let ((cv (make-condvar)))
	     (enqueue! (mailbox-readers mbx) cv)
	     ;; The condvar-ref *must* happen after lock is released,
	     ;; otherwise deadlock will result.
	     (lambda () (condvar-ref cv)))
	   (let ((message (dequeue! (mailbox-messages mbx))))
	     (lambda () message)))))))