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))
21 
22 
23 
24 (define (loop-test-and-set! cell)
25   (if (test-and-set! cell)
26       (loop-test-and-set! cell)
27       '()))
28 
29 (define (make-semaphore-ts maximal)
30   (let ((count maximal)
31 	(guard (cons #f '())))
32     (define (the-sema m)
33       (cond ((eq? m 'release) 
34 	     (loop-test-and-set! guard)
35 	     (unless (= count maximal)
36 	       (set! count (+ 1 count)))
37 	     (clear! guard))
38 	    ((eq? m 'acquire) 
39 	     (cond (loop-test-and-set! guard)
40 		   ((> count 0)
41 		    (set! count (- count 1))
42 		    (clear! guard))
43 		   (else
44 		    (clear! guard)
45 		    (the-sema 'acquire))))
46 	    (else
47 	     (error "Unknown request -- " m))))
48     the-sema))