From: Ramakrishnan Muthukrishnan Date: Sat, 18 Jun 2011 09:17:04 +0000 (+0530) Subject: solution to 4.46 and 4.47 X-Git-Url: https://git.rkrishnan.org/pf/components/com_hotproperty/index.php?a=commitdiff_plain;h=7bb25f037bfd68f1e6427d3aebff0d07cbf0472e;p=sicp.git solution to 4.46 and 4.47 --- diff --git a/src/sicp/ex4_46.rkt b/src/sicp/ex4_46.rkt new file mode 100644 index 0000000..2092575 --- /dev/null +++ b/src/sicp/ex4_46.rkt @@ -0,0 +1,30 @@ +#lang racket + +(define (test-and-set! cell) + (if (car cell) + true + (begin (set-car! cell true) + false))) +#| + +If there are two concurrent processes doing the above test-and-set! function, +there could be many things that can happen. + +Assume that the cell is having a #f value initially. Process 1 tests the +value and finds that it is false. At the same instant, Process 2 also tests +the cell and finds that it is false and both of them set the cell to true at +the same instant. Both the processes get a false value from test-and-set! +and think that they are holding the mutex. + +Another scenario is when the Process 1 does the test and then finds that the +cell is false. Next Process 2's test is executed and it also finds that the +cell is false. Now, both of them proceed to do a set and so both gets the +mutex. + +In reality, only one of the processes should hold a mutex (Mutual exclusion). +So, that assumption is violated in this case. As footnote 47 indicate, if the +instruction that atomically implement test-and-set! is executed at the same +cycle by two separate concurrent processes, a hardware arbiter resolves who +gets the chance to execute it. + +|# diff --git a/src/sicp/ex4_47.rkt b/src/sicp/ex4_47.rkt new file mode 100644 index 0000000..edd9d09 --- /dev/null +++ b/src/sicp/ex4_47.rkt @@ -0,0 +1,64 @@ +#lang racket + +;; semaphore implementation using mutex +(define (make-mutex) + (let ([cell (mcons #f '())]) + (define (the-mutex m) + (cond [(eq? m 'acquire) + (when (test-and-set! cell) + (the-mutex 'acquire))] ;; loop till we acquire the mutex + [(eq? m 'release) (clear! cell)])) + the-mutex)) + +(define (clear! cell) + (set-mcar! cell #f)) + +(define (test-and-set! cell) + (if (mcar cell) + #t + (begin (set-mcar! cell #t) + #f))) + +;; semaphore implementation +(define (make-semaphore n) + (let ([cell 0] + [mutex (make-mutex)]) + (define (the-semaphore s) + (cond [(eq? s 'acquire) + (mutex 'acquire) + (if (>= (+ cell 1) n) + (begin + (mutex 'release) + (the-semaphore 'acquire)) + (begin + (set! cell (+ cell 1)) + (mutex 'release)))] + [(eq? s 'release) + (mutex 'acquire) + (when (> cell 0) + (set! cell (- cell 1))) + (mutex 'release)])) + the-semaphore)) + +;; using test-and-set! +(define (make-semaphore n) + (let ([cell 0] + [flag #f]) + (define (the-semaphore s) + (cond [(eq? s 'acquire) + (if (test-and-set! flag) + (the-semaphore 'acquire)) + (if (>= (+ cell 1) n) + (begin + (clear! flag) + (the-semaphore 'acquire)) + (begin + (set! cell (+ cell 1)) + (clear flag)))] + [(eq? s 'release) + (if (test-and-set! flag) + (the-semaphore 'acquire)) + (when (> cell 0) + (set! cell (- cell 1))) + (clear! flag)])) + the-semaphore))