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]

startSimulation

stevel - nice work Arjen!


AM I have implemented a similar system using finite-state machines instead of coroutines: Discrete event modelling revisited