Chapter 3, Modularity, Objects, and State

Exercise 3.47


Using mutex

Here goes the code:

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
(define (make-semaphore n)
  (let ((lock (make-mutex))
		(wait (make-mutex))
		(current-count 0))

	(define (acquire-semaphore)
	  (if (< current-count n) ;checking without acquiring lock - somewhat more efficeint
		  (begin (lock 'acquire)
				 (if (< current-count n)
					 (begin (set! current-current (+ current-count 1))
							(if (= current-count n);no else for this if
								(wait 'acquire))
							(lock 'release)) ;; here the programs returns after succefully acquiring semaphore
				   (begin (lock 'release) (acquire-semaphore))))
		(begin (wait 'acquire) (acquire-semaphore))))

	(define (release-semaphore)
	  (lock 'acquire)
	  (if (> current-count 0) ;;to avoid if someone accidentally releases multiple times.
		  (set! current-count (- current-count 1))
		  (error "Inconsistent counts - check your acquires/releases" current-count))
	  (wait 'release)
	  (lock 'release))

	(define (dispatch message)
	  (cond ((eq? message 'acquire) (acquire-semaphore))
			((eq? message 'release) (release-semaphore))
			(else (error "Invalid operation - semaphore"))))

	dispatch))

Code is simple except how to avoid busy-wait - Using two mutex objects solve the purpose. One mutex is basically for the count checks - lock.

The ‘wait’ mutex is slightly difficult to understand - I hope it is correct :)

The wait mutex gets acquired when semaphore runs in full capacity i.e. total processes having the exclusive access using our semaphore is equal to n. Now when a new process comes and check that there is no capacity for further processes then it waits on wait mutex.

When any process releases the semaphore - the wait lock gets released - Then any process(es) waiting on this mutex now again check if access can be taken by calling the acquire-semaphore again.

Using atomic test-and-set!

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
(define (make-semaphore n)
  (let ((cell (list false))
		(current-count 0))

	(define (acquire-semaphore)
	  (if (test-and-set! cell)
		  (acquire-semaphore)
		  (if (< current-count n)
			  (begin (set! current-count (+ current-count 1))
					 (clear! cell))
			  (begin (clear! cell)
					 (acquire-semaphore)))))

	(define (release-semaphore)
	  (if (test-and-set! cell)
		  (release-semaphore)
		  (if (> current-count 0)
			  (begin (set! current-count (- current-count 1))
					 (clear! cell))
			  (error "Inconsistent counts - check your acquires/releases" current-count))))
	  
	(define (dispatch message)
	  (cond ((eq? message 'acquire) (acquire-semaphore))
			((eq? message 'release) (release-semaphore))
			(else (error "Invalid operation - semaphore"))))
	
	dispatch))

(define (test-and-set! cell)
  (if (car cell)
      true
      (begin (set-car! cell true)
             false)))