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 (else16 (mutex 'release)17 (the-sema 'acquire))))18 (else19 (error "Unknown request -- " m))))20 the-sema))