Version 9 of Coronet

Updated 2009-07-28 17:43:35 by AK
    # Coronet - a simple skeleton for coroutine networking
    # CMcC and MS 14Jan09

    namespace eval Coronet {
        # if you are adventurous, you can redefine yield in terms of ::yield
        # proc yield {{retval ""}} {...}

        variable maxline 1024

        # provide access to variables defined in top level of coroutine
        proc corovars {args} {
            foreach n $args {lappend v $n $n}
            uplevel 1 [list upvar #1 {*}$v]
        }

        # terminate coroutine
        proc terminate {args} {
            return -level [info level] $args        ;# terminate consumer
        }

        # coroutine-enabled gets
        proc get {socket {reason ""}} {
            variable maxline
            set result [yield]
            set line ""
            while {[chan gets $socket line] == -1 && ![chan eof $socket]} {
                set result [yield]
                if {$maxline && [chan pending input $socket] > $maxline} {
                    error "line length greater than $maxline"
                }
            }

            if {[chan eof $socket]} {
                terminate $reason        ;# check the socket for closure
            }

            # return the line
            return $line
        }

        # coroutine-enabled read
        proc read {socket size} {
            # read a chunk of $size bytes
            set chunk ""
            while {$size && ![chan eof $socket]} {
                set result [yield]
                set chunklet [chan read $socket $size]
                incr size [expr {-[string length $chunklet]}]
                append chunk $chunklet
            }

            if {[chan eof $socket]} {
                terminate entity        ;# check the socket for closure
            }

            # return the chunk
            return $chunk
        }

        proc do {args} {
            set x 1        ;# x is available via [corovars x]
            .... this is where your network code goes
        }

        proc init {name socket args} {
            set coro [coroutine $name ::Coronet::do {*}$args]
            fileevent $socket readable [list $coro INCOMING]
            return $coro
        }

        namespace export -clear *
        namespace ensemble create -subcommands {}
    }

Note this uses the very important facility corovars


AMG: A greatly simplified version of the above code appears in Wibble.


A slightly different form by kbk, snatched from the pastebin

proc cgets {chan args} {
    if {[llength $args] == 1} {
        upvar 1 [lindex $args 0] line
    } elseif {[llength $args] > 1} {
        return -code error "wrong \# args, should be \"[lindex [info level 0] 0] channel ?variable?\""
    }
    while {1} {
        set blocking [fconfigure $chan -blocking]
        fconfigure $chan -blocking 0
        set status [catch {gets $chan line} result opts]
        if {$status} {
            fconfigure $chan -blocking $blocking
            return -code $status -options $opts
        } elseif {[fblocked $chan]} {
            fileevent $chan readable [list [info coroutine]]
            yield
            fileevent $chan readable {}
        } else {
            fconfigure $chan -blocking $blocking
            if {[llength $args] == 1} {
                return $result
            } else {
                return $line
            }
        }
    }
}

coroutine foo apply {{} {
    while {[cgets stdin line] >= 0} {
        puts $line
    }
    set ::finished 1
}}

vwait finished