#lang racket
(require (planet williams/simulation/simulation))
(define-process (lock)
(let ((process #f)
(locked? #f))
(let loop ()
(select
((when (not locked?)
(accept caller (lock)
(set! process caller)))
(set! locked? #t))
((accept caller (unlock)
(unless (eq? caller process)
(error 'unlock
"process does not have the lock"
caller)))
(set! process #f)
(set! locked? #f)))
(loop))))
(define-process (p1 i a-lock)
(printf "~a: process p1(~a) started.~n"
(current-simulation-time) i)
(call a-lock (lock))
(printf "~a: process p1(~a) acquired lock.~n"
(current-simulation-time) i)
(wait (random-flat 0.0 10.0))
(printf "~a: process p1(~a) releasing lock.~n"
(current-simulation-time) i)
(call a-lock (unlock)))
(define (main n)
(with-new-simulation-environment
(let ((a-lock (schedule #:now (lock))))
(for ((i (in-range n)))
(schedule #:at (random-flat 0.0 10.0) (p1 i a-lock)))
(start-simulation))))
(main 10)