Thread wrapper for easy asynchrony

# Threads - asynchronous thread
if {[info exists argv0] && $argv0 eq [info script]} {
    lappend ::auto_path .
}
package require Thread
#package require Debug
Debug define thread
package require OO

oo::class create ::Thread {
    # response - process response from next call
    method response {var _id op} {
	if {[catch {
	    upvar 1 $var result
	    variable id 
	    if {$id ne $_id} {
		error "[self] response $var $_id $op - did not match $id"
	    }

	    # get the async response
	    lassign $result($id) code e eo
	    unset result($id)

	    # get the associated scripts
	    variable responder
	    variable next
	    lassign $responder([incr next]) response error
	    unset responder($next)

	    #Debug.thread {response $next: $var $_id $op -> code:$code e:$e eo:($eo)}

	    # invoke the appropriate script to process result
	    switch -- $code {
		return - 2 -
		ok - 0 {
		    if {$response ne ""} {
			#Debug.thread {DO: $response $e}
			{*}$response $e
		    } else {
			#Debug.thread {DO EMPTY}
		    }
		}
		default {
		    if {$error eq ""} {
			::return -code $code -options $eo $e
		    } else {
			{*}$error $code $e $eo
		    }
		}
	    }
	} e eo]} {
	    puts stderr "ERR: $e $eo"
	}
    }

    # call - asynchronously send call script to thread
    # callback $response on success, $error on error
    method call {call {response {}} {error {}}} {
	variable id
	#Debug.thread {$id call$rcount ($call) response:($response) error:($error)}

	variable responder
	variable rcount
	set responder([incr rcount]) [list $response $error]

	::thread::send -async $id [list ::_thread::call $call] [classvar_name waiter]($id)
    }

    # preserve - incr thread refcount
    method preserve {} {
	variable id
	thread::preserve $id
    }

    # release - decr thread refcount
    method release {} {
	variable id
	::thread::release $id
    }

    destructor {
	classvar waiter
	unset waiter($id)

	my release
    }

    method waiter {} {
	#return ::WAITER
	return [classvar_name waiter]
    }

    constructor {args} {
	if {[llength $args]%2} {
	    variable script [lindex $args end]
	    set args [lrange $args 0 end-1]
	} else {
	    variable script {}
	}

	variable prescript {
	    package require Thread
	    namespace eval ::_thread {
		# call - run the script, return the full result
		proc call {script} {
		    list [catch {uplevel #0 $script} e eo] $e $eo
		}
		proc call {script} {
		    set result [list [catch {uplevel #0 $script} e eo] $e $eo]
		    return $result
		}
	    }
	}

	variable postscript {
	    ::thread::wait
	}

	variable {*}$args
	variable next	;# next expected response
	variable rcount	;# last sent request

	variable id [::thread::create -preserved $prescript$script$postscript]
	::thread::configure $id -eventmark 3
	classvar waiter
	set waiter($id) {}
	trace add variable [classvar_name waiter]($id) write [list [self] response]
    }
}

if {[info exists argv0] && $argv0 eq [info script]} {
    #Debug on thread
    set max 10
    for {set i 0} {$i < $max} {incr i} {
	set thread($i) [Thread new {
	    proc terror {args} {
		puts stderr [::thread::id]:$args
	    }
	    ::thread::errorproc terror
	    interp bgerror "" terror
	}]
    }
    interp bgerror "" output

    proc output {args} {
	puts stderr $args
    }

    after idle {
	time {
	    set i [expr {int(rand() * $max)}]
	    $thread($i) call ::thread::id [list output $i:]
	    after 1
	} 20
    }

    set waiter [$thread(0) waiter]
    puts stderr "WAITER: [array get $waiter]"
    while {1} {
	vwait $waiter
	puts stderr "WAITER: [array get $waiter]"
    }
}