1 (define (make-serializer)
2   (let ((mutex (make-mutex)))
3     (lambda (p)
4       (define (serialized-p . args)
5 	(mutex 'acquire)
6 	(let ((val (apply p args)))
7 	  (mutex 'release)
8 	  val))
9       serialized-p)))
10 
11 (define (make-mutex)
12   (let ((cell (list false)))
13     (define (the-mutex m)
14       (cond ((eq? m 'acquire) (if (test-and-set! cell)
15 				  (the-mutex 'acquire)))
16 	    ((eq? m 'release) (clear! cell))))
17     the-mutex))
18 
19 (define (clear! cell)
20   (set-car! cell false))
21 ;; (define (test-and-set! cell)
22 ;;   (if (car cell)
23 ;;       true
24 ;;       (begin (set-car! cell true)
25 ;; 	     false)))
26 (define (test-and-set! cell)
27   (without-interrupts
28    (lambda ()
29      (if (car cell)
30 	 true
31 	 (begin (set-car! cell true)
32 		false)))))
33 
34 ;; Exercise 3.47.  A semaphore (of size n) is a generalization of a mutex. Like a mutex, a semaphore supports acquire and release operations, but it is more general in that up to n processes can acquire it concurrently. Additional processes that attempt to acquire the semaphore must wait for release operations. Give implementations of semaphores
35 
36 ;; a. in terms of mutexes
37 
38 ;; b. in terms of atomic test-and-set! operations. 
39 
40 (define (make-semaphore n)
41   (let ((mutex (make-mutex)))
42     (define (the-semaphore m)
43       (cond ((eq? m 'acquire) 
44 	     (mutex 'acquire)
45 	     (if (> n 0)
46 		 (begin (set! n (- n 1))
47 			(mutex 'release))
48 		 (begin (mutex 'release)
49 			(the-semaphore 'acquire))))
50 	    ((eq? m 'release) 
51 	     (mutex 'acquire)
52 	     (set! n (+ n 1))
53 	     (mutex 'release))))
54     the-semaphore))
55 
56 (define (make-semaphore n)
57   (let ((cell (list false)))
58     (define (clear! cell)
59       (set-car! cell false))
60     (define (the-semaphore m)
61       (cond ((eq? m 'acquire) 
62 	     (if (test-and-set! cell)
63 		 (the-semaphore 'acquire)
64 		 (if (> n 0)
65 		     (begin (set! n (- n 1))
66 			    (clear! cell))
67 		     (begin (clear! cell)
68 			    (the-semaphore 'acquire)))))
69 	    ((eq? m 'release) 
70 	     (if (test-and-set! cell)
71 		 (the-semaphore 'release)
72 		 (begin (set! n (+ n 1))
73 			(clear! cell))))))
74     the-semaphore))
75 
76 ;; Exercise 3.48.  Explain in detail why the deadlock-avoidance method described above, (i.e., the accounts are numbered, and each process attempts to acquire the smaller-numbered account first) avoids deadlock in the exchange problem. Rewrite serialized-exchange to incorporate this idea. (You will also need to modify make-account so that each account is created with a number, which can be accessed by sending an appropriate message.) 
77 
78 ;; The mutex for the account with the smaller number will always be acquired first. So, if two processes need to process the same two accounts, only one mutex for the lower-numbered account will be acquired successfully. So, only one process will obtain the first mutex, and that process will then proceed to obtain the other mutex.
79 
80 (define (serialized-exchange account1 account2)
81   (let ((serializer1 (account1 'serializer))
82 	(serializer2 (account2 'serializer))
83 	(num1 (account1 'number))
84 	(num2 (account2 'number)))
85     (cond ((< num1 num2)
86 	   ((serializer1 (serializer2 exchange))
87 	    account1 
88 	    account2))
89 	  ((> num1 num2)
90 	   ((serializer2 (serializer1 exchange))
91 	    account1 account2))
92 	  (else (error "Identical accounts" num1 num2)))))