Data commit

Task/Dining-philosophers/Racket/dining-philosophers.rkt

@@ -0,0 +1,87 @@
+#lang racket
+
+;; Racket has traditional semaphores in addition to several higher level
+;; synchronization tools.  (Note that these semaphores are used for Racket's
+;; green-threads, there are also "future semaphores" which are used for OS
+;; threads, with a similar interface.)
+
+;; ----------------------------------------------------------------------------
+;; First, a bunch of code to run the experiments below
+
+;; Only two philosophers to make it deadlock very fast
+(define philosophers '(Aristotle Kant #|Spinoza Marx Russell|#))
+
+(define (run-philosopher name fork1 fork2)
+  (define (show what) (displayln (~a name " " what)))
+  (define (loop)
+    (show "thinks") (sleep (* 2 (random))) (show "is hungry")
+    (grab-forks fork1 fork2 (λ() (show "eats") (sleep (random))))
+    (loop))
+  (thread loop))
+
+(define (run:simple)
+  (define forks (for/list ([i philosophers]) (make-semaphore 1)))
+  (for ([i philosophers] [fork1 forks] [fork2 (cons (last forks) forks)])
+    (run-philosopher i fork1 fork2))
+  (sleep (* 60 60 24 365)))
+
+;; ----------------------------------------------------------------------------
+;; This is the naive implementation, which can be used to try getting a
+;; deadlock.
+
+(define (grab:naive fork1 fork2 eat!)
+  (semaphore-wait fork1)
+  (sleep (random)) ; to make deadlocks probable
+  (semaphore-wait fork2)
+  (eat!)
+  (semaphore-post fork1)
+  (semaphore-post fork2))
+
+;; ----------------------------------------------------------------------------
+;; One way to solve it is to release the first fork if the second is busy and
+;; wait for a while.
+
+(define (grab:release+wait fork1 fork2 eat!)
+  (semaphore-wait fork1)
+  (if (not (semaphore-try-wait? fork2))
+    ;; couldn't grab the second fork, so release the first and wait
+    (begin (semaphore-post fork1)
+           (sleep (random))
+           (grab-forks fork1 fork2)) ; can swap them to improve chances
+    ;; we have both forks
+    (begin (eat!)
+           (semaphore-post fork1)
+           (semaphore-post fork2))))
+
+;; ----------------------------------------------------------------------------
+;; Another solution is to label the forks and lock the lowest-id one first,
+;; which makes the naive solution work.
+
+(define (run:labeled-forks)
+  (define forks (for/list ([i philosophers]) (make-semaphore 1)))
+  ;; the simple run used forks as (1 2 3 4) (4 1 2 3) -- so to implement this,
+  ;; we can swap the two first ones: (4 2 3 4) (1 1 2 3)
+  (for ([i philosophers]
+        [fork1 (cons (last forks) (cdr forks))]
+        [fork2 (cons (first forks) forks)])
+    (run-philosopher i fork1 fork2))
+  (sleep (* 60 60 24 365)))
+
+;; ----------------------------------------------------------------------------
+;; Homework: implement the centralized waiter solution
+
+;; ...
+
+;; ----------------------------------------------------------------------------
+;; Uncomment one of the following pairs to try it
+
+;; (define grab-forks grab:naive)
+;; (define run run:simple)
+
+;; (define grab-forks grab:release+wait)
+;; (define run run:simple)
+
+;; (define grab-forks grab:naive)
+;; (define run run:labeled-forks)
+
+(run)