Discrete event modelling with coroutines
Arjen Markus (21 april 2009) Discrete event modelling is a way of modelling all manner of systems in which things happen at certain times only. The programming language SIMULA was/is one of the languages that makes implementing this type of modelling very easy and natural. See for instance: G.M. Birtwhistle, Discrete Event Modelling on Simula, McMillan, 1979. It describes the DEMOS system.
The example below is a simplification of a problem described in the above book. Here is the idea:
- There is a harbour and two boats want to enter it.
- To do so, they need two tugs each, but there are only three available.
- The first boat arrives, claims two tugs and proceeds to enter - this takes some time
- Meanwhile, the second boat arrives. It has to wait for the manoeuvre of the first boat, before it can begin its entering, as there is only one tug left.
- Once boat 1 finishes the entry manoeuvre it releases the tugs and boat 2 can claim two of them.
In the script below, the boats' behaviour is modelled simply as:
proc boat {objectID} {
acquire tugs 2
hold 10
release tugs 2
} (where objectID is an artifact that I need to hide in a next iteration).
The boats arrive at different times:
set b1 [object boat 1.0] set b2 [object boat 4.0]
(where the number is the arrival time - or more general: the time in the simulation that the object will be given existence)
The coroutine mechanism is used to:
- allow the simulation engine to proceed with another object/event, while the manoevre (symbolised by "hold 10") is going on
- allow the simulation engine to proceed with another object, if the present object has to wait for the release of some resource
All this is neatly done with the [coroutine] and [yield] commands (one caveat: coroutine immediately starts the code to run!)
Oh, for a real simulation package a lot needs to be done, such as setting the priority for requests, collection of statistical data, cooperation between objects, demonstrate that it works for an arbitrary number of objects and so on. But it is a start!
# coro_discrete_events.tcl --
# Experiment with SIMULA/DEMOS like modelling - using coroutines
#
package require Tcl 8.6
# acquire --
# Acquire resources and wait if that does not succeed
#
# Arguments:
# name Name of the resource
# amount Amount to acquire
#
# Returns:
# None
#
proc acquire {name amount} {
upvar 1 objectID ID
upvar #0 $name resource_name
puts "Acquiring $amount of $name for $ID ..."
if { $resource_name >= $amount } {
set resource_name [expr {$resource_name - $amount}]
} else {
puts "Waiting for $name -- $ID"
while {1} {
set ::queue($name) [linsert $::queue($name) 0 $ID]
yield [list acquire $name $ID]
puts "Checking $name ..."
if { $resource_name >= $amount } {
set resource_name [expr {$resource_name - $amount}]
break
}
puts "Wait again - $name - $resource_name -- $amount ..."
}
}
puts "Acquired $amount of $name for $ID"
}
# release --
# Release resources
#
# Arguments:
# name Name of the resource
# amount Amount to release
#
# Returns:
# None
#
proc release {name amount} {
upvar 1 objectID ID
upvar #0 $name resource_name
set resource_name [expr {$resource_name + $amount}]
puts "Releasing $amount of $name for $ID"
if { [llength $::queue($name)] != 0 } {
set hid [lindex $::queue($name) 0]
set ::queue($name) [lrange $::queue($name) 1 end]
set ::events [linsert $::events 0 [list $hid acquire 0.0]]
}
puts "Released $amount of $name for $ID"
}
# resource --
# Create a named resource
#
# Arguments:
# name Name of the resource
# amount Amount to create
#
# Returns:
# None
#
proc resource {name amount} {
upvar #0 $name resource_name
set resource_name $amount
set ::queue($name) {}
}
# hold --
# Advance the time for the given object in the simulation
#
# Arguments:
# delay Time to advance
#
# Returns:
# None
#
proc hold {delay} {
upvar 1 objectID object
lappend ::events [list $object "hold" [expr {$::time+$delay}]]
puts "Holding for $delay seconds ... $object"
yield
puts "Done"
}
# object --
# Create an object and schedule it's coming alive
#
# Arguments:
# procedure Name of the procedure holding the life cycle
# time Time at which it comes alive
#
# Returns:
# Structure representing the object
#
proc object {procedure time} {
set obj [list $procedure $::objectno]
lappend ::events [list $obj "init" $time]
incr ::objectno
return $obj
}
# handleEvents --
# Handle the events that were scheduled
#
# Arguments:
# None
#
# Returns:
# None
#
proc handleEvents {} {
global time
global events
while { [llength $events] > 0 } {
set count 0
set found 0
foreach event $events {
foreach {obj type eventTime} $event {break}
if { $eventTime <= $time } {
set events [lreplace $events $count $count]
set found 1
break
}
incr count
}
if { ! $found } {
foreach {obj type eventTime} [lindex $events 0] {break}
set events [lrange $events 1 end]
}
if { $time < $eventTime } {
set time $eventTime
}
if { $type == "init" } {
coroutine [lindex $obj 1] {*}$obj
}
if { $type == "hold" } {
puts "Releasing hold: $obj"
$obj
}
if { $type == "acquire" } {
puts "Continue acquiring: $obj"
$obj
}
}
}
# startSimulation --
# Start the simulation
#
# Arguments:
# None
#
# Returns:
# None
#
proc startSimulation {} {
if { [llength $::events] == 0 } {
return
} else {
handleEvents
}
}
# boat --
# Simulate a boat that requires several tugs to get into the harbour
#
# Arguments:
# objectID ID of the object (required name!)
#
# Returns:
# None
#
proc boat {objectID} {
acquire tugs 2
hold 10
release tugs 2
}
# main --
# Simulate two objects that need the same resources
#
# Initialise simulation system
set objectno 0
set time 0.0
set events {}
# The simulation itself
resource tugs 3
set b1 [object boat 1.0]
set b2 [object boat 4.0]
startSimulationstevel - nice work Arjen!
AM I have implemented a similar system using finite-state machines instead of coroutines: Discrete event modelling revisited
gold 9/10/2020. Added pix.
