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