summaryrefslogtreecommitdiff
path: root/coding-exercises/3/47.rkt
diff options
context:
space:
mode:
authorMike Vink <mike1994vink@gmail.com>2023-07-06 22:31:56 +0200
committerMike Vink <mike1994vink@gmail.com>2023-07-06 22:31:56 +0200
commita8a8e239968d45cc2539b6a55f4dcde04f5543fd (patch)
tree1f727653bf2f9d6ac5101a19796da851c6f53546 /coding-exercises/3/47.rkt
parent872edd4013539f3dfe2535f95d7efdbb6ca5e797 (diff)
stuff
Diffstat (limited to 'coding-exercises/3/47.rkt')
-rw-r--r--coding-exercises/3/47.rkt36
1 files changed, 34 insertions, 2 deletions
diff --git a/coding-exercises/3/47.rkt b/coding-exercises/3/47.rkt
index e2440ad..f995177 100644
--- a/coding-exercises/3/47.rkt
+++ b/coding-exercises/3/47.rkt
@@ -33,7 +33,6 @@
(begin (set-mcar! cell true)
false)))))
-
(define (make-mutex-busy)
(let ((cell (mlist false)))
(define (the-mutex m)
@@ -80,6 +79,7 @@
;; 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.
+;; NOTE(): does this deadlock? There are two mutexes, but can two processes acquire one mutex and then get stuck waiting on the other?
(define (make-semaphore-retry-mutex n)
(let ((n-mutex (make-mutex))
(retry-mutex (make-mutex)))
@@ -107,4 +107,36 @@
(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))
+;; Assumes single time-sliced processor context
+;; didn't feel like testing this one
+(define (make-semaphore-test-and-set n)
+ (let ((retry-cell (mlist false))
+ (n-cell (mlist false)))
+ (define (the-semaphore m)
+ (cond ((eq? m 'acquire)
+ (cond ((test-and-set! retry-cell)
+ (the-semaphore 'acquire))
+ ((> n 0)
+ (if (test-and-set! n-cell)
+ (begin
+ (the-semaphore 'acquire))
+ (begin
+ (set! n (- n 1))
+ (clear! n-cell)
+ (when (> n 0) (clear! retry-cell)))))
+ ((<= n 0)
+ (clear! n-cell)
+ (the-semaphore 'acquire))))
+ ((eq? m 'release)
+ (when (test-and-set! n-cell)
+ (the-semaphore 'release))
+ (set! n (+ n 1))
+ (clear! n-cell)
+ (clear! retry-cell))))
+ the-semaphore))
+
+(when false
+ (define s (make-semaphore-test-and-set 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 5)))))