Permalink
Switch branches/tags
Find file
Fetching contributors…
Cannot retrieve contributors at this time
48 lines (41 sloc) 1.21 KB
;;; In-RAM Mailbox object routines
;;;
;;; This code is from Gambit's documentation.
;;;
;;; Copyright (c) 1994-2009 by Marc Feeley, All Rights Reserved.
(define (make-empty-mailbox)
(let ((mutex (make-mutex))
(put-condvar (make-condition-variable))
(get-condvar (make-condition-variable))
(full? #f)
(cell #f))
(define (put! obj)
(mutex-lock! mutex)
(if full?
(begin
(mutex-unlock! mutex put-condvar)
(put! obj))
(begin
(set! cell obj)
(set! full? #t)
(condition-variable-signal! get-condvar)
(mutex-unlock! mutex))))
(define (get!)
(mutex-lock! mutex)
(if (not full?)
(begin
(mutex-unlock! mutex get-condvar)
(get!))
(let ((result cell))
(set! cell #f) ; avoid space leaks
(set! full? #f)
(condition-variable-signal! put-condvar)
(mutex-unlock! mutex)
result)))
(lambda (msg)
(case msg
((put!) put!)
((get!) get!)
(else (error "unknown message"))))))
(define (mailbox-put! m obj) ((m 'put!) obj))
(define (mailbox-get! m) ((m 'get!)))