examples/example-6d.rkt
#lang racket
;;; Example 6d - Selective Accepts with Multiple Process Locks

(require (planet williams/simulation/simulation))

;;; process (lock)
;;; entry (lock) -> void?
;;; entry (unlock) -> void?
(define-process (lock)
  (let ((process #f)
        (count 0))
    (let loop ()
      (select
        ((accept caller (lock)
           (if process
               (if (eq? caller process)
                   (set! count (+ count 1))
                   (requeue))
               (begin
                 (set! process caller)
                 (set! count 1)))))
        ((accept caller (unlock)
           (if (eq? caller process)
               (begin
                 (set! count (- count 1))
                 (when (= count 0)
                   (set! process #f)))
               (error 'unlock
                      "process does not have the lock"
                      caller)))))
      (loop))))

;;; process (p1 i a-lock)
;;;   i : exact-nonnegative-integer?
;;;   a-lock : process?
;;; This process uses the lock to protect its critical region, which just does a
;;; random wait in this case.
(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)))

;;; (main n) -> void?
;;;   n : exact-nonnegative-integer?
;;; Creates the lock process and schedules n p1 processes that use the lock.
(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))))

;;; Test with 10 p1 processes.
(main 10)