/usr/share/scheme48-1.9/misc/mail.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
; 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)))))))
|