sicp-ex-3.47



<< Previous exercise (3.46) | Index | Next exercise (3.48) >>


gws

  
  
  
 (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)) 

leafac

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)) 

djrochford

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) 

Sphinxsky

  
 (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)) 
  

fry

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)) 

rohitkg98

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))))))