From 872edd4013539f3dfe2535f95d7efdbb6ca5e797 Mon Sep 17 00:00:00 2001
From: Mike Vink <mike1994vink@gmail.com>
Date: Sat, 24 Jun 2023 17:08:08 +0200
Subject: semaphores

---
 coding-exercises/3/39.rkt |   4 ++
 coding-exercises/3/47.rkt | 110 ++++++++++++++++++++++++++++++++++++++++++++++
 shared/lists.rkt          |   4 --
 3 files changed, 114 insertions(+), 4 deletions(-)
 create mode 100644 coding-exercises/3/39.rkt
 create mode 100644 coding-exercises/3/47.rkt

diff --git a/coding-exercises/3/39.rkt b/coding-exercises/3/39.rkt
new file mode 100644
index 0000000..c170b45
--- /dev/null
+++ b/coding-exercises/3/39.rkt
@@ -0,0 +1,4 @@
+#lang racket
+
+(define x 10)
+(define (parallel-execute (lambda () (set! x (* x x)))))
diff --git a/coding-exercises/3/47.rkt b/coding-exercises/3/47.rkt
new file mode 100644
index 0000000..e2440ad
--- /dev/null
+++ b/coding-exercises/3/47.rkt
@@ -0,0 +1,110 @@
+#lang racket
+(require ffi/unsafe/atomic)
+(require compatibility/mlist)
+(require "../../shared/lists.rkt")
+
+(define (parallel-execute ps)
+    (for-each
+     thread-wait
+     (map (lambda (thnk)
+              (thread thnk))
+         ps)))
+
+(define (make-sleeper name)
+    (define (random-sleeper)
+     (let ((n 10))
+         (map
+          (lambda (i)
+            (display name)
+            (display " ")
+            (displayln i)
+            (sleep (random 0 2)))
+          (enumerate-interval 0 n))))
+    random-sleeper)
+
+(define (clear! cell)
+    (set-mcar! cell false))
+
+(define (test-and-set! cell)
+    (call-as-atomic
+     (lambda ()
+         (if (mcar cell)
+           true
+           (begin (set-mcar! cell true)
+                  false)))))
+
+
+(define (make-mutex-busy)
+    (let ((cell (mlist false)))
+        (define (the-mutex m)
+            (cond ((eq? m 'acquire)
+                   (when (test-and-set! cell)
+                         (the-mutex 'acquire)))
+                  ((eq? m 'release) (clear! cell))))
+        the-mutex))
+
+(define (make-mutex)
+    (let ((the-mutex (make-semaphore 1)))
+        (define (dispatch m)
+            (cond ((eq? m 'acquire)
+                   (semaphore-wait the-mutex))
+                  ((eq? m 'release)
+                   (semaphore-post the-mutex))))
+        dispatch))
+
+(define (make-serializer)
+    (let ((mutex (make-mutex)))
+        (lambda (p)
+            (define (serialized-p . args)
+                (mutex 'acquire)
+                (let ((val (apply p args)))
+                    (mutex 'release)
+                    val))
+            serialized-p)))
+
+(when false
+    (let ((m (make-mutex)))
+       (parallel-execute
+        (lambda ()
+            (m 'acquire)
+            (println "acquired")
+            (sleep 5)
+            (m 'release)
+            (println "released"))
+        (lambda ()
+            (sleep 1)
+            (m 'acquire)
+            (println "acquired after other process")
+            (m 'release)))))
+
+;; In the book there are only examples that mention that you can use atomic operations on a single processor and for multiple processors there are special instructions that are atomic.
+;; But in the racket manual it seems like there is no mention of two processes sharing the same memory space (there is places which run as separate os processes, potentially on a different cpu native processor).
+;; So we could get away with atomic mode instead of the n-mutex.
+(define (make-semaphore-retry-mutex n)
+    (let ((n-mutex (make-mutex))
+          (retry-mutex (make-mutex)))
+        (define (the-semaphore m)
+            (cond ((eq? m 'acquire)
+                   (n-mutex 'acquire)
+                   (if (<= n 0)
+                       (begin
+                         (n-mutex 'release)
+                         (retry-mutex 'acquire)
+                         (the-semaphore 'acquire))
+                       (begin
+                        (set! n (- n 1))
+                        (n-mutex 'release))))
+                  ((eq? m 'release)
+                   (n-mutex 'acquire)
+                   (set! n (+ n 1))
+                   (n-mutex 'release)
+                   (retry-mutex 'release))))
+        the-semaphore))
+
+(when false
+    (define s (make-semaphore-retry-mutex 3))
+    (parallel-execute (map (lambda (f) (lambda () (s 'acquire) (f) (s 'release)))
+                           (map (lambda (n) (lambda () (for-each (lambda (i) (sleep 1) (print "thread: ") (print n) (print ", ") (println i)) (enumerate-interval 1 3))))
+                                (enumerate-interval 1 10)))))
+
+(define (make-semaphore-test-and-set n))
diff --git a/shared/lists.rkt b/shared/lists.rkt
index ac501fd..1db62f7 100644
--- a/shared/lists.rkt
+++ b/shared/lists.rkt
@@ -92,10 +92,6 @@
   (let ((setup (setup-n-window)))
     (iter '() (car setup) (cadr setup))))
 
-(enumerate-windows
-  (enumerate-interval 1 4)
-  2)
-
 (define (find-first pred? seq)
   (cond ((null? seq) false)
         ((pred? (car seq)) (car seq))
-- 
cgit v1.2.3