define makediningphilosophers n getforks

1
The Dining Philosophers
(define (make-dining-philosophers n get-forks)
(let ((forks (build-vector n (lambda (i)
(make-semaphore 1)))) (philosopher
(lambda (i j) (letrec ((f (lambda ()
(printf "Philosopher a is
thinkingn" i) (sleep
(random 1)) (get-forks i
j forks) (printf
"Philosopher a is eatingn" i)
(sleep (random 5))
(semaphore-post (vector-ref forks i))
(semaphore-post (vector-ref forks
j)) (f))))
f))) (philosophers (build-list
n (lambda (i) (thread (philosopher i
(modulo ( i 1) n))))))) (sleep 30)
(display "The philosophers are satiated!")
(for-each kill-thread philosophers)))
2
Get Fork Methods
(define (ordinary i j forks) (semaphore-wait
(vector-ref forks i)) (semaphore-wait
(vector-ref forks j))) (define (deadlock i j
forks) (semaphore-wait (vector-ref forks i))
(sleep .5) (semaphore-wait (vector-ref forks
j))) (define (starvation i j forks)
(semaphore-wait (vector-ref forks i)) (unless
(semaphore-try-wait? (vector-ref forks j))
(semaphore-post (vector-ref forks i)) (sleep
2) (starvation i j forks)))
3
gt (make-dining-philosophers 3
ordinary) Philosopher 2 is thinking Philosopher
1 is thinking Philosopher 0 is thinking Philosophe
r 1 is eating Philosopher 1 is thinking Philosophe
r 0 is eating Philosopher 0 is thinking Philosophe
r 2 is eating Philosopher 2 is thinking Philosophe
r 1 is eating Philosopher 1 is thinking Philosophe
r 0 is eating Philosopher 0 is thinking Philosophe
r 2 is eating Philosopher 2 is thinking
Philosopher 1 is eating Philosopher 1 is
thinking Philosopher 2 is eating Philosopher 2 is
thinking Philosopher 1 is eating Philosopher 1 is
thinking Philosopher 0 is eating Philosopher 0 is
thinking Philosopher 2 is eating Philosopher 2 is
thinking Philosopher 1 is eating Philosopher 1 is
thinking Philosopher 0 is eating Philosopher 0 is
thinking Philosopher 2 is eating The philosophers
are satiated!
4
Deadlock
(define (deadlock i j forks) (semaphore-wait
(vector-ref forks i)) (sleep .5)
(semaphore-wait (vector-ref forks j)))
5
gt (make-dining-philosophers 3
deadlock) Philosopher 2 is thinking Philosopher
1 is thinking Philosopher 0 is thinking Philosophe
r 1 is eating Philosopher 1 is thinking Philosophe
r 0 is eating Philosopher 0 is thinking Philosophe
r 2 is eating Philosopher 2 is thinking Philosophe
r 2 is eating Philosopher 2 is thinking Philosophe
r 1 is eating Philosopher 1 is thinking deadlock!
6
Starvation
(define (starvation i j forks) (semaphore-wait
(vector-ref forks i)) (unless
(semaphore-try-wait? (vector-ref forks j))
(semaphore-post (vector-ref forks i)) (sleep
2) (starvation i j forks)))
7
gt (make-dining-philosophers 4
starvation) Philosopher 3 is thinking Philosopher
2 is thinking Philosopher 1 is
thinking Philosopher 0 is thinking Philosopher 3
is eating Philosopher 1 is eating Philosopher 1
is thinking Philosopher 1 is eating Philosopher 3
is thinking Philosopher 3 is eating Philosopher 3
is thinking Philosopher 3 is eating Philosopher 3
is thinking Philosopher 3 is eating Philosopher 1
is thinking Philosopher 1 is eating Philosopher 1
is thinking Philosopher 1 is eating Philosopher 3
is thinking Philosopher 3 is eating Philosopher 1
is thinking Philosopher 1 is eating Philosopher 3
is thinking Philosopher 3 is eating Philosopher 1
is thinking Philosopher 1 is eating Philosopher 3
is thinking Philosopher 3 is eating Philosopher 1
is thinking Philosopher 1 is eating
Philosopher 3 is thinking Philosopher 3 is
eating Philosopher 1 is thinking Philosopher 1 is
eating Philosopher 1 is thinking Philosopher 1 is
eating Philosopher 3 is thinking Philosopher 1 is
thinking Philosopher 2 is eating Philosopher 0 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 2 is thinking Philosopher 2 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 2 is thinking Philosopher 2 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 0 is thinking Philosopher 0 is
eating Philosopher 0 is thinking Philosopher 0 is
eating The philosophers are satiated!
8
Exceptions
(define careful-/ (lambda (n d)
(with-handlers ((exnapplicationdivide-by-zero?
(lambda (exn) 999))) (/
n d)))) gt (/ 2 3) 2/3 gt (/ 1 0) / division
by zero gt (careful-/ 2 3) 2/3 gt (careful-/ 1
0) 999 gt
9
(define (foo n) (with-handlers ((even? (lambda
(x) (/ x 2))) (odd? (lambda
(x) ( x 1)))) (raise n))) gt (foo
12) 6 gt (foo 13) 14 gt
10
(define (foo n) (with-handlers ((even? (lambda
(x) (/ x 2))) (odd? (lambda
(x) ( x 1)))) (bar n))) (define (bar n)
(raise n)) gt (foo 12) 6 gt (foo 13) 14 gt
(bar 12) uncaught exception 12 gt
11
Continuations
(call-with-current-continuation (lambda (k)
expr)) (call/cc (lambda (k) expr)) (let/cc k
expr) (call-with-escape-continuation (lambda (k)
expr)) (call/ec (lambda (k) expr)) (let/ec k expr)
12
(define (create name) (let/ec exit (letrec
((f (lambda (n) (printf "a
going down an" name n) (if (lt
n 3) (f ( n 1))
(let/cc deep (exit deep)))
(printf "a coming up an" name n))))
(f 0))))
13
gt (define a (create 'first)) first going down
0 first going down 1 first going down 2 first
going down 3 gt (define b (create
'second)) second going down 0 second going down
1 second going down 2 second going down 3 gt
(a 0) first coming up 3 first coming up
2 first coming up 1 first coming up 0 gt (b
0) second coming up 3 second coming up
2 second coming up 1 second coming up 0 gt (a
0) procedure application expected procedure,
given ltvoidgt ... gt (b 0) procedure
application expected procedure, given ltvoidgt
...
14
(define exit-continuation 0) (define
continue-continuation 0) (define (start)
(let/ec exit-cont (set! exit-continuation
exit-cont) (let/ec continue-cont (set!
continue-continuation continue-cont)) (echo
"continuing") (program-loop)) (echo
"sayonara")) (define (program-loop) (if (
(random 10) 0) (exit-continuation 0)
(continue-continuation 0)))
15
gt (start) continuing continuing sayonara gt
(start) continuing continuing continuing continuin
g continuing continuing continuing continuing cont
inuing continuing sayonara gt