[Peter Spjuth] : Having used [coroutine]s I was wondering how hard it
would be to make VHDL like processes using them. The result is below.

----
======
# Signals and processes are local to a namespace. Signals are automatically
# in scope in processes in that namespace.
# Structural hierarchy is done in namespaces.
# A variable declared as signal is used as normal, but assignment is
# delayed until idle time.

# TODO:
# Delayed signal assignments?
# Flag to process to make asynchronous reset block

namespace eval vhdl {
    # An array that, for each signal, keeps a list of waiting processes
    variable signalWait
    # An array that, for each signal, keeps the current value
    variable signalValue
    # An array that, for each process, keeps its wakeup time
    variable processTime
    # An array that, for each process, keeps the signals it waits for
    variable processSignals
    # An array that, for each namespace, keeps a list of signals
    variable nsSignals
    # An array of signals about to be assigned
    variable activeSignals
    # Next time for a signal event
    variable nextSignalTime -1
    # Counter to generate coroutines for processes
    variable coroCnt 0
    # Current time
    variable now 0
    # An array of default reset signal per namespace
    variable defaultReset
    # These variables are only active during an instantiation
    variable currentInstParent ""
    variable currentPortMap ""

    namespace export resetsignal signal process wait entity port instance

    # Start up simulation as soon as there is an event loop
    after idle vhdl::Run
}

# Activate a process for one delta cycle
proc vhdl::ActivateProcess {process} {
    variable processTime
    variable processSignals
    variable signalWait

    # Remove process from signal wait lists
    foreach sig $processSignals($process) {
        set i [lsearch -exact $signalWait($sig) $process]
        if {$i >= 0} {
            set signalWait($sig) [lreplace $signalWait($sig) $i $i]
        }
    }
    set processSignals($process) {}
    set processTime($process) {}

    # Run process
    $process
}

# Main loop
proc vhdl::Run {} {
    variable processTime
    variable processSignals
    variable now
    variable activeSignals
    variable signalValue
    variable signalWait
    variable nextSignalTime
    if {[info coroutine] eq ""} {
        # Reschedule as a coroutine
        variable coroCnt
        set name ::vhdl::process$coroCnt
        incr coroCnt
        coroutine $name vhdl::Run
        return
    }
    while 1 {
        # Look for the next scheduled process
        set mintime -1
        foreach process [array names processTime] {
            set wTime $processTime($process)
            if {$wTime eq ""} continue
            if {$mintime < 0 || $wTime < $mintime} {
                set mintime $wTime
            }
        }
        # Move time to next process
        if {$now < $mintime} {
            set now $mintime
        }
        # Move back time if a signal is scheduled earlier
        if {$nextSignalTime >= 0 && $nextSignalTime < $now} {
            set now $nextSignalTime
        }
        # Activate any due process
        set anyDone 0
        #puts "Running processes at $now"
        foreach process [array names processTime] {
            set wTime $processTime($process)
            if {$wTime eq ""} continue
            if {$wTime <= $now} {
                ActivateProcess $process
                set anyDone 1
            }
        }
        # Perform signal assignments
        if {$nextSignalTime >= 0 && $nextSignalTime <= $now} {
            set nextSignalTime -1
            set anyDone 1
            # Assign all new signal values
            foreach name [array names activeSignals] {
                set signalValue($name) $activeSignals($name)
                upvar \#0 $name var
                set var $activeSignals($name)
            }
            # Active any waiting processes
            foreach name [array names activeSignals] {
                unset activeSignals($name)
                set todo $signalWait($name)
                set signalWait($name) {}
                #if {[llength $todo]>0} {puts "Running processes on sig $name"}
                foreach process $todo {
                    ActivateProcess $process
                }
            }
        }
        if {!$anyDone} {
            puts "Nothing to do! Now $now"
            #exit
            return
        }
        # A small delay to give a bit visibility to progress
        after 10 [info coroutine]
        yield
    }
}

# Write trace on a signal
proc vhdl::WriteSig {name name1 name2 op} {
    upvar 1 $name1 var
    variable signalValue
    variable activeSignals
    variable nextSignalTime
    variable now

    set newVal $var
    # Restore value until rescheduled assignment
    set var $signalValue($name)

    # Already scheduled?
    if {[info exists activeSignals($name)] && $var eq $activeSignals($name)} {
        return
    }

    set activeSignals($name) $newVal
    set nextSignalTime $now
}

# Figure out the fully qualified namespace for a signal
proc vhdl::NsQualify {name} {
    if {[string match "::*" $name]} { return $name }
    set currNs [uplevel 2 namespace current]
    if {[string match "*::" $currNs]} {
        set fullName $currNs$name
    } else {
        set fullName ${currNs}::$name
    }
    return $fullName
}

# wait        : Wait forever, i.e. stop process.
# wait for 10 : Wait for a time.
# wait on Sig : Wait for signal to change
proc vhdl::wait {args} {
    variable processTime
    variable processSignals
    variable signalWait
    variable now
    set co [info coroutine]
    if {$co eq ""} {
        return -code error "wait must be called in a process"
    }
    if {[llength $args] == 0} {
        # Do not schedule it to wake up again
        # FIXA: Is there a way to shut down the coroutine regardless of
        # call depth?
        yield
        return -code error "Internal error: wait forever failed"
    }
    foreach {keyw what} $args {
        if {$keyw eq "for"} {
            # Schedule a wakeup call at a time
            set processTime($co) [expr {$now + $what}]
        } elseif {$keyw eq "on"} {
            foreach sig $what {
                # Schedule a wakeup call on signal
                set fullName [NsQualify $sig]
                lappend signalWait($fullName) $co
                lappend processSignals($co) $fullName
            }
        } else {
            return -code error "Unknown wait: $keyw"
        }
    }
    yield
}

# Declare an entity
# entity Controller { signals and processes }
proc vhdl::entity {name block} {
    variable entities
    set fullName [NsQualify $name]
    set entities($fullName) $block
}

# Instantiate an entity
# instance Controller -name CI -port { InsideSig MySig }
# The port is a dictionary mapping ports to surrounding signals
proc vhdl::instance {name args} {
    variable entities
    variable currentPortMap
    variable currentInstParent
    # Locate the entity
    set fullName [NsQualify $name]
    # Search down namespaces
    while {![info exists entities($fullName)]} {
        set ns [namespace qualifier $fullName]
        if {$ns eq ""} { 
            return -code error "No such entity \"$name\""
        }
        set ns2 [namespace qualifier $ns]
        set tail [namespace tail $fullName]
        set fullName ${ns2}::$tail
    }
    # Check arguments
    set opts(-name) [namespace tail $fullName]
    set opts(-port) ""
    foreach {opt val} $args {
        set opts($opt) $val
    }
    # Figure out namespaces
    set parent [uplevel 1 namespace current]
    if {$parent eq "::"} {
        set newNs ${parent}$opts(-name)
    } else {
        set newNs ${parent}::$opts(-name)
    }
    set currentInstParent $parent
    set currentPortMap $opts(-port)
    if {[namespace exists $newNs]} {
        return -code error "Instance $opts(-name) already exists"
    }
    namespace eval $newNs $entities($fullName)
    # These variables are only active during an instantiation
    set currentInstParent ""
    set currentPortMap ""
}

# A port declaration in an entity automatically connects to
# instantiating namespace's signal
proc vhdl::port {name} {
    variable currentPortMap
    variable currentInstParent
    
    set parentName $name
    if {[dict exists $currentPortMap $name]} {
        set parentName [dict get $currentPortMap $name]
    }
    set currNs [uplevel 1 namespace current]
    namespace eval $currNs [list \
            namespace upvar $currentInstParent $parentName $name]
    # Declare it as a signal as well
    # Use tailcall so signal can find the caller's namespace
    tailcall vhdl::signal $name
}

# Declare signal, with an optional initialization value.
proc vhdl::signal {name args} {
    variable signalWait
    variable signalValue
    variable nsSignals
    set fullName [NsQualify $name]
    set ns [namespace qualifier $fullName]
    if {$ns eq ""} {set ns ::}
    lappend nsSignals($ns) $fullName

    set signalWait($fullName) {}
    set signalValue($fullName) {}
    upvar \#0 $fullName var
    if {[llength $args] > 0} {
        set var [lindex $args 0]
        set signalValue($fullName) [lindex $args 0]
    }
    trace add variable var write [list vhdl::WriteSig $fullName]
}

# Declare default reset signal
proc vhdl::resetsignal {name} {
    variable defaultReset
    set defaultReset([uplevel 1 namespace current]) $name
    # Declare it as a signal as well
    # Use tailcall so signal can find the caller's namespace
    tailcall signal $name
}

# Declare process
# process ?options? body
# -clock Clk     : Run process on rising edge of signal
# -every Time    : Run process regularly
# -on    SigList : Run process on signal change.
# -reset Block   : Code to run during reset.
# -resetsig Sig  : Reset signal
proc vhdl::process {args} {
    variable coroCnt
    variable processTime
    variable processSignals
    variable now
    variable defaultReset
    variable signalValue

    set currNs [uplevel 1 namespace current]
    set body [lindex $args end]
    set args [lrange $args 0 end-1]

    set opts(-clock) ""
    set opts(-every) ""
    set opts(-on) ""
    set opts(-reset) ""
    if {![info exists defaultReset($currNs)]} {
        set defaultReset($currNs) ""
    }
    set opts(-resetsig) $defaultReset($currNs)
    foreach {opt val} $args {
        set opts($opt) $val
    }

    # A first yield to end the call at creation time
    set body2 "yield\n"
    # Make all signals available in this scope
    append body2 {global {*}[set ::vhdl::nsSignals([namespace current])]} \n
    append body2 "variable ::vhdl::now\n"
    # Put a loop around everything
    append body2 "while 1 \{\n"

    if {$opts(-clock) ne ""} {
        append body2 [string map [list %% $opts(-clock)] {
            while 1 {
                vhdl::wait on %%
                if {$%% == 1} break
            }
        }]
    }
    if {$opts(-every) ne ""} {
        append body2 "set __every__ \$now\n"
    }
    if {$opts(-reset) ne ""} {
        if {$opts(-resetsig) eq ""} {
            return -code error "No reset signal declared"
        }
        append body2 "if {\$$opts(-resetsig)} \{\n"
        append body2 $opts(-reset)\n
        append body2 "\} else \{\n"
    }
    append body2 $body\n
    if {$opts(-reset) ne ""} {
        append body2 "\}\n"
    }
    if {$opts(-every) ne ""} {
        append body2 "vhdl::wait for \[expr {$opts(-every) - (\$now - \$__every__)}\]\n"
    }
    if {$opts(-on) ne ""} {
        if {$opts(-on) eq "all"} {
            set vars {}
            foreach var [regexp -all -inline {\$\w+} $body] {
                set var [string range $var 1 end]
                set fullName [NsQualify $var]
                if {[info exists signalValue($fullName)]} {
                    lappend vars $var
                }
            }
            if {[llength $vars] == 0} {
                return -code error "No vars detected in -on all process"
            }
        } else {
            set vars $opts(-on)
        }
        append body2 "[list vhdl::wait on $vars]\n"
    }
    # End of the loop around everything
    append body2 "\n\}\n"

    set name ::vhdl::process$coroCnt
    incr coroCnt
    coroutine $name apply [list {} $body2 $currNs]
    # The wakeup time is now, to make ut wake up immediately
    set processTime($name) $now
    set processSignals($name) {}
}
======

***Example Usage***

======
##############################################################################
# Examples
##############################################################################

namespace import vhdl::*
namespace import tcl::mathop::*

signal Clk 1
signal Clk_N
signal Gurka 0
signal Miffo 0
resetsignal Reset

# Testing separation of namespaces
namespace eval gurka {
    signal Clk
    signal Miffo 0
    resetsignal Reset

    # Clock generator
    process -every 30 {
        set Clk 1
        wait for 15
        set Clk 0
        if {$now > 250} wait
    }
    process {
        set Reset 1
        wait for 200
        set Reset 0
        wait
    }
    process -clock Clk -reset {
        set Miffo 0
    } {
        puts "CLK_N @$now Miffo $Miffo"
        incr Miffo
    }
}

# Clock generator
process -every 20 {
    set Clk 1
    wait for 10
    set Clk 0
    if {$now > 150} wait
}

# Clocked process
process -clock Clk {
    puts "PROCESS1 @$now G=$Gurka"
    # Signals do not update immediately. The below should increment once
    incr Gurka
    incr Gurka
    # See that assignment is delayed
    puts "               G=$Gurka"
}

process {
    puts "PROCESS2 @$now G=$Gurka"
    wait for 12
    puts "PROCESS2 @$now G=$Gurka"
    wait on Gurka
}

# Combinatorial inverter
process -on Clk {
    set Clk_N [! $Clk]
}

# Clocked process
process -clock Clk_N -reset {
    set Miffo 0
} {
    puts "CLK_N @$now Miffo $Miffo"
    incr Miffo
}

# Startup reset generator
process {
    set Reset 1
    wait for 50
    set Reset 0
    wait
}

process -on {Gurka Miffo} {
    puts "G or M"
}

process -on all {
    puts "G $Gurka M $Miffo"
}

process {
    wait on Gurka for 7
    puts "Gurka $Gurka @$now"
    if {$now > 150} wait
}

entity myent1 {
    port MySig

    process {
        puts "MySig 1 @$now"
        set MySig 1
        wait for 10
        puts "MySig 0 @$now"
        set MySig 0
        wait for 10
        if {$now > 150} wait
    }
}

namespace eval n2 {
    signal OtherSig 
    signal OtherSig2 
    instance myent1 -name n1 -port {
        MySig OtherSig
    }
    instance myent1 -name n2 -port {
        MySig OtherSig2
    }
    process {
        wait on OtherSig
        puts "OtherSig $OtherSig @$now"
    }
    process {
        wait on OtherSig2
        puts "OtherSig2 $OtherSig2 @$now"
    }
}

# Enter event loop
catch {console show}
vwait forever
======
<<categories>> Simulator | Concurrency