Updated 2013-06-28 10:07:47 by APN

As of mid-August 2008 [1], the current Tcl sources offer co-routines! See coroutine. Thanks and congratulations go to MS.

Example Code
# Structural code (due to DKF)
namespace path tcl::unsupported 
proc iota {start end} { 
    for {set i $start} {$i<=$end} {incr i} {yield $i} 
    return -code break 
} 
proc UNIQUE_NAME {} {return cor[incr ::COUNTER]} 
proc makeIota {start end} { 
    set cmd [UNIQUE_NAME] 
    coroutine $cmd apply {args {yield;tailcall {*}$args}} \ 
            iota $start $end 
    return $cmd 
} 

# Demonstrate usage (due to MS)
set iota_1_5 [makeIota 1 5] 
puts *[info command $iota_1_5]* 
puts --- 
while 1 { 
     set x [$iota_1_5] 
     puts $x 
} 

puts --- 
puts *[info command $iota_1_5]* 

example:
mig@cpq:/home/CVS/tcl_SF_clean/unix$ ./tclsh /tmp/iota.tcl 
*cor1* 
--- 
1 
2 
3 
4 
5 
--- 
** 

[...]
Two subprograms (functions, methods, or subroutines) are called co-routines if they are executed using fibers [see below]. Each co-routine is executed under co-operative multitasking with the other co-routine(s). At certain points, co-routines perform I/O or explicit yields, which allow the next co-routine to start. The advantage of co-routines and fibers over threads is explicit control over context switching. The disadvantage is the burden of implementing a "fair" and "acceptable" switching of tasks.

Author: Daniel Barbalace

Website: http://www.clearthought.info/

[fibers] A process is the heaviest unit of kernel scheduling. A process's own resources are allocated by the operating system. Resources include memory, file handles, sockets, device handles, and windows. Processes do not share address spaces or file resources except through explicit methods (such as inheriting file handles or shared memory segments, or mapping the same file in a shared way). Processes are typically pre-emptively multitasked. However, Windows 3.1 and older versions of Mac OS used co-operative or non-preemptive multitasking.

The term thread will refer only to kernel supplied threads. A thread is the lightest unit of kernel scheduling. At least one thread exists within each process. If multiple threads can exist within each process, then they all share the same memory and file resources. Threads are pre-emptively multitasked if the operating system's schedule for processes is pre-emptive. Threads do not own resources except for a stack and a copy of registers (including the program counter).

A fiber is a user-level thread. Fibers are co-operatively multitasked, with context switching occurring only at I/O points or at explicit yield points. A fiber can be scheduled to run in any thread in the same process. Typically fibers are implemented entirely by user-level libraries. In Unix the I/O would be handled by using select() multiplexing. WIN32 supplies a fiber interface API. Subroutines or functions that use fibers are called "co-routines" because they are pseudo-mulitasked. SunOS 4.x implemented "light-weight processes" as fibers known as "green threads". SunOS 5.x and later implemented LWPs as threads.

Author: Daniel Barbalace

Website: http://www.clearthought.info/

Another definition, by Dan Sugalski, taken from [2] is:
"Well, a coroutine is a subroutine or function that can pause in the middle and return a value. When you call it again it picks up right where it was when you paused, environment intact, and keeps on going. Coroutines are almost always closures, though strictly speaking they don't have to be--if you had a language that didn't have closures, or lexical variables, you could still have coroutines. (Though generally speaking nobody does that. You could, though, if you were so inclined.) Often coroutines are called iterators or generators, but that's not strictly correct--while you can make iterators and generators with coroutines, you don't have to. Nor are coroutines limited to being iterators or generators, as some systems use coroutines to implement threading, and coroutines can make really nifty callbacks."

Lua's creator co-authored a survey [3] on the subject.

See Filament - A very lightweight thread package

The continuation page is a discussion of related subjects.

AM (2 june 2006) While thinking and reading about enumerators, LISP series, iterators and such, I came across coroutines (or co-routines) and I have thought of a way to implement them in Tcl. Probably not as general as they can be in other languages, but the principle can at least be mimicked if the scope is sufficiently limited. Now, all that remains is to demonstrate that ...

[someone not identified] I would be very interested in seeing that demonstration. Once in a past life, I desperately wanted Tcl coroutines and never could come up with a satisfactory solution. My need has passed, but I would love to see it solved.

AM (5 june 2006) I had the opportunity to test my ideas during a day-off. The script below is not complete in the sense that you will be able to use co-routines in the most general way, or even in the limited way that I think I can make it work (the missing piece is a way to automatically transform an enumeration procedure like enumFile below into a properly working co-routine, A).

Further disclaimers: I understand the working of co-routines up to a certain level only. I do not know what they could be used for, other than the limited context I had in mind when I devised the script below (first on paper, then on the computer).

Well, so much for that. Now the hardcore coding stuff:
# Experiment with coroutines
#
namespace eval ::Coroutines {
    variable vars
}

# __SaveVariables__ --
#    Procedure to save all variables visible in the current
#    procedure under that name
# Arguments:
#    None
# Result:
#    Index of next routine
# Side effect:
#    Sets an entry in the array vars
# Note:
#    Arrays are _not_ considered, they will lead to an error
#
proc ::Coroutines::__SaveVariables__ {} {
    variable vars
    upvar 1 __mode__ mode
    upvar 1 __coroutines__ coroutines

    set name [lindex [info level -1] 0]

    set vNames [uplevel 1 {info vars}]

    set varValues {}
    foreach v $vNames {
        if { ![string match "__*__" $v] } {
            lappend varValues $v [uplevel 1 [list set $v]]
        }
    }
    set vars($name) $varValues

    incr mode
    if { $mode >= [llength $coroutines] } {
        set mode 0
    }
    return $mode
}

# __RestoreVariables__ --
#    Procedure to restore all variables to their saved values in
#    the current procedure
# Arguments:
#    None
# Result:
#    None
# Side effect:
#    Sets an entry in the array vars
# Note:
#    Arrays are _not_ considered, they will lead to an error
#
proc ::Coroutines::__RestoreVariables__ {} {
    variable vars
    set name [lindex [info level -1] 0]

    if { [info exists vars($name)] } {
        foreach {v value} $vars($name) {
            uplevel 1 [list set $v $value]
        }
        uplevel 1 [list set __runthis__ 0]
    } else {
        uplevel 1 [list set __runthis__ 1]
    }
}

# cleanup, resume --
#     These are normally dummy routines
#
proc resume {} {
    # Do nothing
}
proc cleanup {body} {
    uplevel 1 $body
}

# enumFile --
#     Simple enumeration procedure for reading a file
# Arguments:
#     filename          Name of the file to read
#     proc              Name of the procedure to invoke
#                       per line
# Result:
#     None
# Side effects:
#     Whatever the procedure did
#
proc enumFile {filename proc} {

    set infile [open $filename r]

    while {[gets $infile line] >= 0 } {
        $proc $line
        resume   ;#This is the point where we yield control to the coroutines
    }
    cleanup {
        close $infile
    }
}

# A --
#     Procedure that can be used as a coroutine to B and C
# Arguments:
#     __coroutines__    List of procedures that interact
#     __mode__          Mode of working (either: continue-to-last
#                       or stop-at-first, other values private)
# Result:
#     None
# Side effects:
#     Global variables set as a means to communicate,
#     new file written
# Note:
#     All procedures use a loop. The processing continues
#     until either no procedure can do anything anymore
#     (mode=continue-to-last) or until one procedure
#     cannot continue anymore (stop-at-first, the default)
#
proc A {__coroutines__ {__mode__ {stop-at-first}}} {
    if { $__mode__ == "stop-at-first" } {
        set __rout__ 0
        while { $__rout__ != -1 } {
            set __rout__ [[lindex $__coroutines__ $__rout__] $__coroutines__ $__rout__]
        }

        foreach __rout__ $__coroutines__ {
            $__rout__ $__coroutines__ cleanup
            unset ::Coroutines::vars($__rout__)
        }
        return
    }
    if { $__mode__ == "continue-to-last" } {
        set __rout__ 0
        set __org_coroutines__ $__coroutines__
        while { [llength $__coroutines__] > 0 } {
            set __nrout__ [[lindex $__coroutines__ $__rout__] $__coroutines__ $__rout__]
            if { $__nrout__ == -1 } {
                set __coroutines__ [lreplace $__coroutines__ $__rout__ $__rout__]
                if { $__rout__ >= [llength $__coroutines__] } {
                    set __rout__ 0
                }
            } else {
                set __rout__ $__nrout__
            }
        }
        foreach __rout__ $__org_coroutines__ {
            $__rout__ $__org_coroutines__ cleanup
            unset ::Coroutines::vars($__rout__)
        }
        return
    }

    #
    # Ordinary processing
    #
    ::Coroutines::__RestoreVariables__
    if { $__mode__ == "cleanup" } {
        set __runthis__ -1
    }

    #
    # This part is derived from the actual arguments
    #
    if { $__runthis__ == 1 } {
        foreach {filename proc} {"first.txt" weaveText} {break}
    }

    if { $__runthis__ == 1 } {
        set infile [open $filename r]
    }

    #
    # Transforming while blocks is a bit tricky ...
    # I think that as they inspect the _current state_, the condition
    # does not need to change - note that this is not true for
    # for-loops and foreach-loops
    #
    # Well, except for the cleanup condition
    #
    while { $__runthis__ != -1  && [gets $infile line] >= 0 } {
        $proc $line

        # The call to resume is transformed into this:
        # resume   ;#This is the point where we yield control to the coroutines
        set __next__ [::Coroutines::__SaveVariables__]
        return $__next__
    }

    #
    # The call to cleanp is transformed into this:
    #
    if { $__runthis__ == -1 } {
        close $infile
    }
    return -1      ;# This is added
}

# B --
#     The second coroutine: merely adding lines from a file
#
proc B {__coroutines__ {__mode__ {stop-at-first}}} \
    [string map {first.txt second.txt weaveText addText} [info body A]]

# C --
#     The third coroutine: merely adding lines from a file
#
proc C {__coroutines__ {__mode__ {stop-at-first}}} \
    [string map {first.txt third.txt weaveText addText} [info body A]]


# weaveText --
#     Weave the text of various files together
# Arguments:
#     line        Line of text to be added
#
proc weaveText {line} {
    global all_lines
    global linecount

    lappend all_lines $line
    incr linecount
    puts "Line: $linecount"
    puts [join $all_lines \n]
    set all_lines {}
}

# addText --
#     Add a line of text to the "repository"
# Arguments:
#     line        Line of text to be added
#
proc addText {line} {
    global all_lines

    lappend all_lines $line
}

# To test this, call the coroutines in the right order
#
foreach {f c} {first.txt {A B C} second.txt {D F} third.txt {AA BB DD EE FF}} {
    set outfile [open $f w]
    puts $outfile [join $c \n]
    close $outfile
}

# Note the order! A should be executed last
#
set linecount 0
A {B C A}

# Now continuing until the last enumeration has stopped
#
set linecount 0
A {B C A} continue-to-last

AM I hope the comments are enough to get a bit of feeling for what is going on :)

AM (8 june 2006) I realised the other day that the code only works as required because the resume command appears at the bottom of the loop. The correct code should read:
while { $__runthis__ != -1  && ($__runtime__ == 0 || ([gets $infile line] >= 0)) } {
    $proc $line

    # The call to resume is transformed into this:
    # resume   ;#This is the point where we yield control to the coroutines
    if { $__runtime__ == 1 } { 
        set __next__ [::Coroutines::__SaveVariables__]
        return $__next__
    }
    set __runtime__ 1 
}

The extra conditions are required to make sure the gets is not executed.

Of course, a limitation is that the procedure can not be recursive ... that can be solved by storing the variables per procedure name and stacklevel. And we may need more complicated logic to make resume work ;)

LV Back in the day, we used to code in co-routines in IBM BAL a lot. For instance, we wrote some general purpose report generation code. One would define what a page header and footer should look like. Then one would initialize the code, resulting in the first page header being output. Then one would call the report line print command. It would work cooperatively so that as a page filled, footers and new headers, with page numbering, alternativing titles on left or right side of the page, etc. were generated. The program generating the report didn't care about any of it - it would just call the equivalent of a puts and the routine kept track of where it was, and did the right thing as necessary.

There was a lot of other uses, most of which I've forgotten. Probably used up all those memory cells to keep track of this wiki ;-) .

See also: tcor - A Tcl Coroutines Extension