#lang racket
(require (planet williams/simulation/simulation))
(define-process-type lock-process
((locked? #f)))
(define-process lock-process (lock)
(let loop ()
(select
((when (not (lock-process-locked? self))
(accept caller (lock)))
(set-lock-process-locked?! self #t))
((when (lock-process-locked? self)
(accept caller (unlock)))
(set-lock-process-locked?! self #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)