#lang racket
(require (planet williams/simulation/simulation))
(define-process* (my-resource (total-units 1))
((allocations (make-hasheq))
(allocated-units 0))
(let loop ()
(select
((accept caller (request (units 1))
(let* ((current-allocation (hash-ref (my-resource-allocations self) caller 0))
(requested-allocation (+ current-allocation units))
(available-units (- total-units (my-resource-allocated-units self))))
(when (> requested-allocation total-units)
(error 'request
"Total units requested ~a > total units ~a for ~s"
requested-allocation total-units caller))
(if (<= units available-units)
(begin
(hash-set! (my-resource-allocations self) caller requested-allocation)
(set-my-resource-allocated-units!
self (+ (my-resource-allocated-units self) units)))
(requeue)))))
((accept caller (relinquish (units 1))
(let* ((current-allocation (hash-ref (my-resource-allocations self) caller 0))
(remaining-allocation (- current-allocation units)))
(when (< remaining-allocation 0)
(error 'relinquish
"Units relinquished ~a > units allocated ~a for ~s"
units current-allocation caller))
(if (= remaining-allocation 0)
(hash-remove! (my-resource-allocations self) caller)
(hash-set! (my-resource-allocations self) caller remaining-allocation))
(set-my-resource-allocated-units!
self (- (my-resource-allocated-units self) units))))))
(loop)))
(define n-attendants 2)
(define attendant #f)
(define (generator n)
(for ((i (in-range n)))
(wait (random-exponential 4.0))
(schedule #:now (customer i))))
(define-process (customer i)
(printf "~a: customer ~a enters~n" (current-simulation-time) i)
(call attendant (request))
(printf "~a: customer ~a gets an attendant~n" (current-simulation-time) i)
(work (random-flat 2.0 10.0))
(call attendant (relinquish))
(printf "~a: customer ~a leaves~n" (current-simulation-time) i))
(define (run-simulation n)
(with-new-simulation-environment
(set! attendant (schedule #:now (my-resource n-attendants)))
(schedule #:at 0.0 (generator n))
(start-simulation)))
(run-simulation 10)