Blob


1 (define (make-semaphore-mtx maximal)
2 (let ((count maximal)
3 (mutex (make-mutex)))
4 (define (the-sema m)
5 (cond ((eq? m 'release)
6 (mutex 'acquire)
7 (unless (= count maximal)
8 (set! count (+ 1 count)))
9 (mutex 'release))
10 ((eq? m 'acquire)
11 (mutex 'acquire)
12 (cond ((> count 0)
13 (set! count (- count 1))
14 (mutex 'release))
15 (else
16 (mutex 'release)
17 (the-sema 'acquire))))
18 (else
19 (error "Unknown request -- " m))))
20 the-sema))