I have added a new process synchronization / communication mechanism to the simulation collection - similar to the Ada rendezvous mechanism. This adds call and accept syntaxes that allow processes to communicate in a synchronized manner. The call syntax allows the caller process to send a request to the callee process. The call syntax has the form:
(call callee (id . arguments))
Where
callee is the receiving process, id is the request type (which is not evaluated), and arguments are the arguments for the request. With a simple call, the caller is blocked until the callee accepts the request.
The accept syntax allows the callee process to accept a request from a caller process. The accept syntax has the form:
(accept caller (id . parameters) . body)
Where caller is the calling process, id is the request type (which is not evaluated), parameters are the formal parameters for the request, and body is the body of the accept - i.e., the critical section. With a simple accept, the callee is blocked until a caller sends a matching request. When a matching request is accepted, a rendezvous occurs - that is the body is evaluated and its result returned to caller as the result of the matching call.
Each process maintains a queue of requests that have yet to be accepted - where each caller is blocked.
Even with simple call / accept we can implement a simple lock process.
(define-process (lock)
(let loop ()
(accept caller (lock))
(accept caller (unlock))
(loop)))
This process will continuously loop waiting for a process to request a lock and then wait for a process to request an unlock. Here is an example process that uses the lock.
(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)))
This process just requests a lock - blocking until it gets it, waits a random length of time to simulate some protected task, and requests an unlock.
And here is a main procedure to start everything.
(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))))
If you run this with:
(main 10)
You get the following output:
0.13863292728449428: process p1(5) started.
0.13863292728449428: process p1(5) acquired lock.
1.1536616785362432: process p1(7) started.
2.0751959904191937: process p1(8) started.
2.876463473845367: process p1(1) started.
3.344929657351545: process p1(4) started.
7.029086638253653: process p1(5) releasing lock.
7.029086638253653: process p1(7) acquired lock.
7.342236104231587: process p1(2) started.
7.824845469456133: process p1(9) started.
7.921942925957062: process p1(6) started.
8.162050798467028: process p1(3) started.
8.574025375628212: process p1(0) started.
8.624836102585753: process p1(7) releasing lock.
8.624836102585753: process p1(8) acquired lock.
16.152957766273808: process p1(8) releasing lock.
16.152957766273808: process p1(1) acquired lock.
18.243251499858758: process p1(1) releasing lock.
18.243251499858758: process p1(4) acquired lock.
22.293434873464157: process p1(4) releasing lock.
22.293434873464157: process p1(2) acquired lock.
27.693559748646905: process p1(2) releasing lock.
27.693559748646905: process p1(9) acquired lock.
32.4025230155617: process p1(9) releasing lock.
32.4025230155617: process p1(6) acquired lock.
39.54837751017477: process p1(6) releasing lock.
39.54837751017477: process p1(3) acquired lock.
39.86720234676685: process p1(3) releasing lock.
39.86720234676685: process p1(0) acquired lock.
44.316970186291684: process p1(0) releasing lock.
However, this is a (very) fragile implementation of a lock relying on well-behaved callers.
A more robust implementation of a lock requires greater control over the acceptance of requests. The select syntax - in this case for accepts - plus some internal state variables allows us to do this. The select (for accepts) syntax has the following form.
(select
accept-alternative
...
[else-alternative])
accept-alternative
= ((when expr
(accept caller (id . parameters) . body1)
. body2)
| ((accept caller (id . parameters) . body1)
. body2)
else-alternative
= (else timing . body)
timing
= #:now
| #:at time
| #:in delta
| #:when event
Which looks a bit daunting, but basically it is a list of possibly guarded accepts with an optional else. The select will evaluate all of the guards - the when exprs - to determine the open accepts. Unguarded accepts are always open. If any request form an open accept are queued, the highest priority request is selected and a rendezvous occurs. The body2 expressions are evaluated after the rendezvous. The else alternative specified a time-out and is evaluated (in lieu of a rendezvous) if no request is accepted before the specified time.
Here is a better implementation of a lock process.
(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))))
This uses two variables, process and locked?, to maintain the internal state of the lock. The lock process continuously loops processing lock or unlock requests. A lock request will only be accepted if the lock is not currently locked. An unlock request will be accepted any time, but will raise an error if the process requesting the unlock is not the process that has the lock.
Running this lock process with the process p1 and main above gives identical results.
In some cases, we don't know if we can fully process a request until we get the request - because it depends on the caller or arguments in the request. What of we wanted to extent the lock to allow nested lock/unlock pairs from a process. In that case, we want to accept lock requests from the process owning the lock at any time, but not from others. There isn't any way to do that with a guard. Instead, we use requeue.
(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))))
Here we have a count variable instead of a simple Boolean locked? variable. - when count = 0 the lock is open to anyone, but only open open to the process current 'owning' the lock when count > 0. In this case, we remove the guard from the accept for lock and requeue the request if the caller is not the process currently owning the lock.
I believe this is a very robust interprocess synchronization / communications mechanism for the simulation collection. I have a complete knowledge-based simulation example I will be putting up in the near future.
This code (and many examples) are included in the development branch of the simulation collection on the Schematic project at Sourceforge. I will update the PLaneT package when I update the documentation.Labels: simulation
