From 7bb25f037bfd68f1e6427d3aebff0d07cbf0472e Mon Sep 17 00:00:00 2001
From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Sat, 18 Jun 2011 14:47:04 +0530
Subject: [PATCH] solution to 4.46 and 4.47

---
 src/sicp/ex4_46.rkt | 30 +++++++++++++++++++++
 src/sicp/ex4_47.rkt | 64 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 94 insertions(+)
 create mode 100644 src/sicp/ex4_46.rkt
 create mode 100644 src/sicp/ex4_47.rkt

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