#lang racket
(require (planet williams/simulation/simulation))
(define-process* (lock)
((process #f))
(let ((count 0))
(let loop ()
(select
((accept caller (lock)
(if (lock-process self)
(if (eq? caller (lock-process self))
(set! count (+ count 1))
(requeue))
(begin
(set-lock-process! self caller)
(set! count 1)))))
((accept caller (unlock)
(if (eq? caller (lock-process self))
(begin
(set! count (- count 1))
(when (= count 0)
(set-lock-process! self #f)))
(error 'unlock
"process does not have the lock"
caller)))))
(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)