<< Previous exercise (3.46) | Index | Next exercise (3.48) >>
I think the above implementation can be improved. Instead of the explicit busy way, we can use a second mutex that makes the clients hang. This way, if we can come up with a better implementation for mutexes, semaphores get the benefit as well:
(define (make-semaphore maximum-clients)
(let ((access-mutex (make-mutex))
(exceeded-mutex (make-mutex))
(clients 0))
(define (the-semaphore message)
(cond ((eq? message 'acquire)
(access-mutex 'acquire)
(cond ((> clients maximum-clients)
(access-mutex 'release)
(exceeded-mutex 'acquire)
(the-semaphore 'acquire))
(else
(set! clients (+ clients 1))
(if (= clients maximum-clients)
(exceeded-mutex 'acquire))
(access-mutex 'release))))
((eq? message 'release)
(access-mutex 'acquire)
(set! clients (- clients 1))
(exceeded-mutex 'release)
(access-mutex 'release))))
the-semaphore))
I think this solution can get stuck, suppose we run three process A, B, C. A and B are "acquire", C is "release". A is waiting for exceeded-mutex after release its access-mutex. and C get access-mutex and release exceeded-mutex and A get exceeded mutex, and C release access-mutex and B get it. Then B add the client and require exceeded-mutex but A get it. So now A seeks for access-mutex and B seeks for exceeded-mutex and will infinitely wait.
Also, here's an answer for part b, which is very similar to what gws did. Here, the busy wait is inevitable:
(define (make-semaphore maximum-clients)
(let ((access-mutex (list false))
(clients 0))
(define (the-semaphore message)
(cond ((eq? message 'acquire)
(if (test-and-set! access-mutex)
(the-semaphore 'acquire))
(cond ((> clients maximum-clients)
(clear! access-mutex)
(the-semaphore 'acquire))
(else
(set! clients (+ clients 1))
(clear! access-mutex))))
((eq? message 'release)
(if (test-and-set! access-mutex)
(the-semaphore 'release))
(set! clients (- clients 1))
(clear! access-mutex))))
the-semaphore))
This is a slightly simpler version of the acquire part of leafac's mutex solution which I *think* is still correct (delete me if I'm wrong).
(exceed-mutex 'acquire) (access-mutex 'acquire) (set! clients (+ clients 1)) (if (< clients maximum-clients) (exceed-mutex 'release)) (access-mutex 'release)
(define (make-cell-cycle n) (define (rec-make n) (if (= n 0) '() (cons #f (rec-make (- n 1))))) (let ((cells (rec-make n))) (set-cdr! (last-pair cells) cells) cells)) (define (retry-acquire cell) (if (test-and-set! cell) (retry-acquire (cdr cell)))) (define (retry-release cell) (if (car cell) (clear! cell) (retry-release (cdr cell)))) ; b) ; The acquire operation must precede the release operation. (define (make-semaphore-use-tas n) (let ((cells (make-cell-cycle n))) (define (the-semaphore m) (cond ((eq? m 'acquire) (retry-acquire cells)) ((eq? m 'release) (retry-release cells)) (else (error "Unknown operation -- MAKE-SEMAPHORE" m)))) the-semaphore)) ; a) (define (make-semaphore-use-mutex n) (let ((lock (make-mutex)) (clients n)) (define (the-semaphore m) (cond ((eq? m 'acquire) (lock 'acquire) (if (> clients 0) (begin (set! clients (- clients 1)) (lock 'release)) (begin (lock 'release) (the-semaphore 'acquire)))) ((eq? m 'release) (lock 'acquire) (set! clients (+ clients 1)) (lock 'release)) (else (error "Unknown operation -- MAKE-SEMAPHORE" m)))) the-semaphore))
No busy waiting and hopefully no deadlock in part a)
Part b) included for kicks.
(define (make-semaphore max) (define processes 0) (define accessing (make-mutex)) (define waiting (make-mutex)) (define (acquire) (if (< processes max) (begin (set! processes (+ processes 1)) (if (= processes max) (waiting 'acquire)) (accessing 'release)) (begin (accessing 'release) (waiting 'acquire) (dispatch 'acquire)))) (define (release) (if (> processes 0) (set! processes (- processes 1))) (waiting 'release) (accessing 'release)) (define (dispatch m) (accessing 'acquire) (cond ((eq? m 'acquire) (acquire)) ((eq? m 'release) (release)))) dispatch) (define (make-semaphore max) (let ((processes 0) (access (list false))) (define (dispatch m) (cond ((eq? m 'acquire) (acquire)) ((eq? m 'release) (release)))) (define (acquire) (cond ((test-and-set! access) (acquire)) ((< processes max) (set! processes (+ processes 1)) (clear! access)) (else (clear! access) (acquire)))) (define (release) (cond ((test-and-set! access) (release)) ((> processes 0) (set! processes (- processes 1)) (clear! access)) (else (clear! access)))) dispatch))
we have the serializer we implement using a mutex, can't we just use that?
edit: my bad, this will result in a deadlock upon hitting max due to not being able to run release
; the acquiring and releasing of mutexes need to be serialized ; this will go into a deadlock upon hitting max mutexes ; the release and acquire cannot be on the same serializer ; bad solution (define (make-semaphore n) (let ((total 0) (serializer (make-serializer))) (define (acquire) (if (< total n) (set! total (+ total 1)) (acquire))) (define (release) (set! total (- total 1))) (define (the-semaphore m) (cond ((eq? m 'acquire) (serializer acquire)) ; retry ((eq? m 'release) (serializer release))))))
Correct Solutions with explanation:
; a correct solution would acquire lock and release before retrying ; so that release also gets a chance (define (make-semaphore n) (let ((total 0) (access-lock (make-mutex))) (define (acquire) (access-lock 'acquire) (if (< total n) (begin (set! total (+ total 1)) (access-lock 'release)) (begin (access-lock 'release) (acquire)))) (define (release) (access-lock 'acquire) (set! total (- total 1)) (access-lock 'release)) (define (the-semaphore m) (cond ((eq? m 'acquire) (acquire)) ((eq? m 'release) (release)))))) ; now, an even better way would be create separate locks for access and max ; this way if a process got an access lock but max value is reached ; they release access lock and go into max lock ; as soon as max opens up when release gets called they continue execution by calling acquire again (define (make-semaphore n) (let ((total 0) (access-lock (make-mutex)) (release-indicator (make-mutex))) (define (acquire) (access-lock 'acquire) (if (< total n) (begin (set! total (+ total 1)) (access-lock 'release)) ; all semaphores occupied ; don't proceed further until one is released (begin (access-lock 'release) (release-indicator 'acquire) (acquire)))) (define (release) (access-lock 'acquire) (set! total (- total 1)) ; indicate that there is atleast one free semaphore now (release-indicator 'release) (access-lock 'release)) (define (the-semaphore m) (cond ((eq? m 'acquire) (acquire)) ((eq? m 'release) (release))))))
Not sure if this solution falls into part a or part b. In this implementation, the cell value of the mutex will only be set to #t if max_processes is reached. Otherwise, a call to acquire the semaphore will continue looping until the number of active processes is decremented below the max.
Honestly, in this implementation, the mutex procedure object isn't even strictly required - just need a local variable to store the boolean, or perhaps just use the running count of active processes?
Please let me know if this is correct, any and all comments are more than welcome.
(define (make-semaphore max_processes)
(let ((num_processes 0)
(mutex (make-mutex)))
(define (maxed-processes?)
(= num_processes max_processes))
(define (test-and-set!)
(if (maxed-processes?) #t
(begin
(set! num_processes (+ num_processes 1))
(if (maxed-processes?) (mutex 'acquire))
#f)))
(define (clear!)
(if (maxed-processes?)
(mutex 'release))
(if (= num_processes 0)
(error "Num processes already at minimum")
(set! num_processes (- num_processes 1))))
(define (the-semaphore m)
(cond ((eq? m 'acquire) (if (test-and-set!) (the-semaphore 'acquire)))
((eq? m 'release) (clear!))
(else (error "Unknown request" m))))
the-semaphore))
(define (make-semaphore n) (let ((lock (make-mutex)) (taken 0)) (define (semaphore command) (cond ((eq? command 'acquire) (lock 'acquire) (if (< taken n) (begin (set! taken (1+ taken)) (lock 'release)) (begin (lock 'release) (semaphore 'acquire)))) ((eq? command 'release) (lock 'acquire) (set! taken (1- taken)) (lock 'release)))) semaphore))