Version 82 of Tasks

Updated 2021-10-03 17:44:42 by et4

ET 2021-09-29 - (1.5)

Introduction to Tcl Tasks

Tasks are an extension to tcl threads that are designed for ease of use. There are only 6 commands to learn, with the occasional use of a few others. Tasks implement a familiar call/return or client/server like framework. Tasks are threads that call and receive a standard proc-like arglist either synchronously or asynchronously with a corresponding wait.

A task is created using the Task procedure, as shown below. The taskname is the name of a variable assigned the thread id and a name used for creating some shared variables used internally by Task's to communicate with one another. The tasks::* procedures and optionally additional proc's defined in the program can be imported into the thread's interpreter.

The last arg is the script. Task creates a new thread, supplements the script, and starts it running. The script will usually begin (after some possible inits) with a twait call that returns with the first job and it's arglist.


A script will typically contain calls to 2 task procedures, twait and treturn. Here is a common layout of a Task.

    Task taskname ?options? ?list of imports? {
         twait -> varname1 varname2 ...   
         # do something with the args $varname1 $varname2 ...
         treturn result
    }

 Details

twait waits until a job is requested from another task or the main thread who uses the tcall command which like calling a procedure, can optionally supply input parameters. The parameters to twait are variable names of where to store the arglist and individual args.

treturn returns a value to a calling task (or the main thread).

Note: treturn does not end the task, after the treturn, data is returned to the caller, and the code continues on. It might loop back to another twait, or go into some other loop, as in the example producer consumer code. The next twait can have different arguments.

The -> used here is just a variable name like args or argv and as the first argument receives the full arglist. This name was chosen for its visual look.


Synchronous calls use tcall to mimic a procedure call, but the procedure in this case is running concurrently in its own thread. This returns, with a value, after the task issues it's treturn statement.

    tcall $taskname resultvar   arg1 arg2 ...

Asynchronous calls also use tcall to mimic a concurrent procedure or function call, that also runs in it's own thread.

    tcall $taskname -async resultvar   arg1 arg2 ...
# ... do something else ...
    tvwait resultvar 
   

tcall calls the task: taskname a variable now containing the thread id. tcall requires a variable name to receive the result which is the signal back to the caller that the job is done.

tvwait is a vwait that checks for the variable's existence which insures that if the task completes first tvwait will return immediately.

                                                   - - -

Task Properties

 Features

Tasks can process one job or loop back for more work

After processing an arglist and returning a value, the task can then simply exit, or remain running in a loop waiting for the next arglist to process, similar to a client/server arrangement.

By default, a loop surrounds the script, unless the -once option is specified in the Task command. Each task has a queue, so pending asynchronous calls will be queued fifo in an orderly fashion.


Helper tasks are simple to add

One or more tasks can be helpers, (with the same or different scripts) and will all share the main task's queue implementing a single queue multiple server organization. Callers can be from the main thread or any task (except itself). This is a key feature of Tasks.

Adding helpers is quite easy. Helper tasks are created with a simple taskname convention of worker/boss. All work is sent to the boss.

    Task boss ... $script
    Task worker1/boss ... $script
    Task worker2/boss ... $script
    ...

    tcall $boss ....

For example, here's a program that will create 4 tasks for 5 jobs. Note: the task name is available to each task using the global variable t_name, created by the Task command.

Because the computation takes a second or two, 4 will be run concurrently, and which ever one finishes first will snag the 5th one which was waiting in the job queue of tBoss. Due to scheduling of threads, there's no guarantee of which task that will be. Each task returns a list of 2 items, a text message and the result of the computation.

    namespace import tasks::*
    set script {
        package require math
        twait   ->  i  number
        treturn  [list                                          \
                   "$i courtesy of $::t_name : $number"         \
                   [string length [math::fibonacci $number]]    \
                 ]
    }
    set jobs {100 200 300 400 500}

    foreach   taskname {tBoss help1/tBoss help2/tBoss help3/tBoss } {
        Task $taskname  -import  $script      ;# create the 4 tasks
    }
    foreach i $jobs {                         ;# run the 5 jobs
        tcall $tBoss -async   rvar($i)    $i  [expr { $i + 100000 }]
    }
    foreach i $jobs {tvwait rvar($i)}         ;# wait for all jobs
    
    parray rvar

#   
#   Each run could assign different tasks to each job, here's 2 results
#   Since there are only 4 tasks for 5 jobs, someone has to do 2 jobs:
#   
#    
#   rvar(100) = {100 courtesy of help1 : 100100} 20920
#   rvar(200) = {200 courtesy of tBoss : 100200} 20941
#   rvar(300) = {300 courtesy of help2 : 100300} 20962
#   rvar(400) = {400 courtesy of help3 : 100400} 20983
#   rvar(500) = {500 courtesy of help1 : 100500} 21003
#   
#   rvar(100) = {100 courtesy of help1 : 100100} 20920
#   rvar(200) = {200 courtesy of help2 : 100200} 20941
#   rvar(300) = {300 courtesy of tBoss : 100300} 20962
#   rvar(400) = {400 courtesy of help3 : 100400} 20983
#   rvar(500) = {500 courtesy of tBoss : 100500} 21003
    

Tasks are compatible with other Thread functions and the event queue

The tsv shared variables are easily incorporated. Mutexes can also be used. Even a thread::send or thread::cancel can still be used. The taskid used in tcall is just the thread id.

During the wait for work, the event queue is checked every 50 ms by doing an update, so any pending events, such as a thread::send or updating of any gui widgets will have time to be serviced.


Tasks include puts like debugging and an error handler

Tasks comes with utility procedures for debugging such as a puts like statement that can create a Tk text widget (one per task) and a built in error catcher that will display a tk_messageBox.

Note, due to a Tk bug on linux, putz will not create Tk windows, but rather will output to stdout using puts, but with the taskname prepended. This mode can also be used on windows to output to the console if desired.

                                                        - - -

Task Procedures

 Primary 6

Create a Task

  • Task tname ?-once? ?-import ? ?import list? script

The -once option suppresses the forever while loop normally around the script.

The -import is used when the parent Task (or main thread) imports all the task::* procedure names. Then this option will also import them unqualified into the thread's interpreter. This way the task won't need to qualify the taskks::* procedure names either. If preferred however, one can fully qualify them in all cases.

The import list is a list of proc's that can be imported into the task's interpreter. Each list element can be a pattern as described in the [info procs] command.

The script can be supplied in braces or with a $script variable, depending on preference. A variable is normally used with helper tasks when each uses the same script.


Call a Task and Wait till Done

  • tcall tname ?-async? rglobal ?arg ...?
  • tvwait rglobal ?taskid?

tcall sends a message to the task id specified by tname providing a return global to set on completion and providing an argument list.

tvwait will wait for the completion, of the task and receive the return value.


Wait for a Call and Return a Value

  • twait ?argv? ?varname1 varname2 ..?
  • treturn result

Waits for work to do and get args and optionally lassign them to the variables varname1 varname2 ...

Signals the caller and returns a result. If the caller is waiting with a tvwait, it will resume.


Debug output

  • putz "text" ?color?

On windows, this will create a Tk window for debug output, one per Task. There are a few buttons and checkboxes, for turning on/off the output, clearing the text, and pausing the task. The large button is a quick exit of the program along with some Task info.

On Linux, this will go to stdout using a puts. If called from the main thread, this will translate to a puts call.

See the tag's in the code for the current set of colors. Add additional ones for your own use. The t_debug global variable control's putz output with an option for a debug trace.

                                              - - -

 Utilities and Misc.

Utilities

  • tset taskname element ?val?

Set a Task shared variable value, or get it if no ?val?

  • tdump ?pat? ?max-width?

Debug dump of shared variable data used by tasks, pat=* max width def=90

  • tname taskid

taskid (which is the thread id also) will lookup and return the taskname.

  • tpause_check

This is checked in twait, but can be used also by the task code. It checks for the t_task_pause global, which is initialized to 0, and does a non-busy wait for the global to change back to 1. It is connected to the pause checkbox in the Tk window that putz creates.

  • tgroup name ?-option?

This is a task builder which can create a group of tasks sharing the same queue. see the discussion in the comments before that proc for more information and some examples.


Misc

  • comma number

comifies a positive integer, only used in testing

  • wait ms

A non busy wait using vwait and a global variable.

  • xwait ms

A busy wait, for easily testing compute bound threads. The time is approximate.

                                                    - - -

Try out the examples

To test the examples, copy the code block followed by an example to a file and run it with tclsh or wish. It requires the Threads package and Tk, which it will (attempt to) load.


Open the code discussion which has a large comment block with more details.

 Code
# proc intro
# tasks
################################################################################################
#
#   Tasks are an extension of threads. A Task is a thread that includes:
#
#       A high level call/return interface (or client/server)
#       A job input queue optionally shared among tasks   
#       An exclusive mutex and associated condition variable
#       An error handler
#       A forever while loop around the script (optional)
#       Text widget (optionally) - one per Task
#       putz output to the text widget (similar to puts) plus colors
#       A parent thread proc importer
#       package require Tk if needed
#       Debug on/off to include tracing
#
#   Summary of Task command set:
#   ----------------------------
#
# From a parent thread - the name tname will be used for tsv shared variables and a variable to save the thread id.
# The Task proc create a variable tname and assigns it the id.
#
#   Task  tname  ?-once? ?-import ? ?prefixlist? script      ;# prefixlist is imported procs, tname can be tname/tname2 
#   tcall $tname ?-async? rglobal ?arg ...?]                    ;# if called with -async, use tvwait, rglobal is the return value
#                                                               ;# if called sync (no -async) it returns the value also, if -async
#                                                               ;# returns a 0/1 as to the success of operation
#                                                               ;# for -import, see below on Namespace
#
#   tvwait rglobal ?taskid? ;# wait till variable set: if taskid given, checks if Task exists to avoid waiting
#                           ;# forever on task crash
#   
# inside a Task
#
#   twait ?argv? ?arg1 arg2 ..? ;# waits for work to do and get args and optionally lassign them to variables
#   treturn  result             ;# if the last statement (e.g. no loop), it will drop through after and exit thread 
#
# Utilities
#
#   tset taskname element ?val? ;# quick way to set a Task shared variable value, or get it if no ?val?
#   tget                        ;# alias for tset (for readability, so can still set the var if val is given) from main only
#   tdump ?pat? ?max-width?     ;# debug dump of shared variable data used by tasks, pat=* max width def=90 
#   tname taskid                ;# taskid (which is the thread id also) will lookup and return the taskname
#   tpause_check                ;# this is checked in twait, but can be used also by the task code, if it doesn't twait
#                               ;# for example, a task that only gets 1 tcall and then loops doing something, like producing for a consumer
#                               ;# this checks for the t_task_pause global, which is initialized to 0
#   tgroup name  ?-option?      ;# this is a task builder, see the discussion in the comments before that proc
#
# Misc
#
#   putz "text" ?color?         ;# debug output for a Task, with separate window with a text widget
#   comma number                ;# comifies a positive integer, only used in testing, probabaly can just remove it
#   wait ms                     ;# a non busy wait using vwait and a global variable
#   xwait ms                    ;# a busy wait, for easily testing compute bound threads
#
#
#
#   In a minimal case, a Task can be written like so to call someproc with 2 args
#   where someproc will run in a different thread from the caller thread:
#
#   ;   proc someproc {a1 a2} {                 ;# this is outside the Task definition, but is imported
#            ...do something...
#           return $something
#       }
#
#
#       Task mytask {someproc other-procs} {    ;# create new thread, assign thread id to mytask, import someproc
#           twait -> a1 a2 ...                  ;# wait for work and then lassign the args to a1 a2 ...
#           set result [someproc $a1 $a2 ]      ;# call someproc with the input args 
#           treturn $result                     ;# send back the results, sets a variable with the result
#       }
#
#
#   And it might be called like this synchronously:
#   
#       tcall $mytask resultvar 100 200 ;# the mytask variable was created in the Task call above
#   
#   or asynchronously with some compute followed by a wait for completion:
#   
#       tcall $mytask -async resultvar 100 200
#       ... do something else ...
#       tvwait resultvar
#
#   A Task works similar to a procedure using [tcall]/[treturn] with args and a result.
#   Each task creates it's own tcl thread. It can be [tcall]ed by another Task, but
#   should not tcall itself or deadlock will occur. 
#   
#   It's input is an argv (or args) like list of arguments. The [twait] command
#   is used to wait for work to be sent in, and can optionally assign values to locals.
#   The caller issues a [tcall] that mimics a procedure call. [Task] returns a 
#   taskid (which is a true thread id) which can be used with other thread package 
#   commands.  All the tsv:: shared variable package can also be used.
#   
#   A [tcall] can be synchronous or asynchronous. Included in the tcall is a 
#   global variable name (scalar or array, with a namespace or not) that will 
#   receive the results when the call is done. The Task issues a [treturn] 
#   statement with a result value, similar to a proc return. A pair of :: will be
#   prefixed to the name automatically if needed.
#   
#   A Task is created with a Task name, and an optional import list (of procs from 
#   the parent thread) and a script. Task returns the taskid and also creates a
#   variable of the same name in the local address space also storing the taskid.
#
#
#   By being a Task (running in its own thread) the main thread can 
#   be responsive to events, even if the Task is a very heavy compute process. If
#   the Task breaks from the loop (or there's no loop at all) the task will exit
#   if it drops off the bottom.
#   
#   The first argument to [twait], is assigned the entire argument list, while
#   the arguments that follow are names of variables to be assigned values from the arglist.
#   It resembles the lassign command, except the first arg (often called argv)  
#   was written by [twait] first, then used. 
#   
#   If the first variable is not needed, as might be the case with a fixed set of actual args,
#   then a nice syntactic trick is to use -> for that. Regexp often does this.
#
#       twait -> arg1 arg2
#   
#   Note that like regexp, a variable -> is created but was chosen to "look nice" given we
#   are not really interested in it's contents. When it's needed, argv is a suitable choice.
#
#
# Some random notes:
#
#   The Task create imports procs that the parent thread has defined. A Task can also call 
#   other Tasks, and so the parent thread is not always the main thread. These procs are a list
#   of args that can be given to the [info procs] command and so can be glob type patterns as
#   documented in the [string match] command. Each proc is reconstructed using info body/args/default.
#
#   In addition, the body is modified to replace full line comments (begin with #) to be just the
#   # alone, to save space, but not change line numbering.
#
#   These imported procs are prepended to the script parameter. All of the required procs, like twait
#   and treturn are automatically prepended first. Also there are 3 global variables that are defined
#   for the Task (i.e. the thread and it's interpreter), These are the parent thread id
#   (the caller of Task) and the name of the Task. For example, they might look like this:
#   
#       set ::t_pid tid00002F40
#       set ::t_name helper1
#       set ::t_debug 0         ;# this controls putz output
#   
#   If the putz output command is used, it will create the text widget on first call. It
#   no longer creates a variable to indicate the text widget was created, but rather tests
#   for the existance of the text widget, using info command. But...
#
#   There are now 2 checkboxes on the Tk putz window which have 2 globals (but only if the
#   windows is created.
#
#   t_putz_output              ;# a toggle to turn putz output on/off
#   t_task_pause               ;# a toggle to pause the task, see tpause_check
#
#   
#   [putz] also defines a series of tags for colors. They are easily modified. If
#   the t_debug flag is set, then a log of various internal debugging will be output to
#   to the text widget. 
#
#   When waiting for work in it's queue, it will update the text widget every 50 ms, 
#   so it should remain responsive. If in a heavy loop however, the widget will freeze.
#   
#   The script can easily be listed out as it is stored in the shared variable tname,script. The command:
#   
#       tget taskname script
#   
#   will list the script as the thread will have seen it. This can be run from a console.
#   
#   There is a catch wrapper and while loop around the script and if an error occurs which is caught
#   will use tk_messageBox to display it. Thus tk is required for Tasks. The other use is the putz
#   command. It looks like this (but check the actual code in Task for lastest):
#   
#       if [catch { 
#           while 1 {
#               ... script ...
#           }
#       } thread_err_code thread_err_dict] {
#           tsv::set tvar helper1,error $thread_err_dict  
#           tk_messageBox -message "Name = $::t_name Parent = $::t_pid\n$thread_err_code\n\n$thread_err_dict" -title "tid [thread::id]"
#       }
#
#   If there is a need to do something with an initialization and then the loop, one can simply write code:
#
#       initial
#       while 1 {
#          script
#       }
#       
#   Since there's always one outer while loop, if one wants to exit a task, then using a [break] will do that, since
#   unlike threads, there is no need for a thread::wait call. A one shot would look like this:
#   
#       twait -> arg1 arg2 ...
#       treturn result
#       break
#       
#   Note that the automatic while loop is placed on the same line with the catch, (just to remove 1 newline) which
#   results in a better line number being reported in the message box when an error occurs.
#
#   And finally, there's a -once option on the Task call to suppress this. To check the actual code that
#   is generated, one can use the [tget] command to retreive the actual script code which is generated.
#   
#       puts [tget taskname script]
#       
#   Notice that there are 2 variables here that all Task's will be using: thread_err_code thread_err_dict
#   
#   The script is at the global level, so these variables will also be global (in the threads's interpreter). 
#   To make them local, one can use this for a script instead:
#   
#   ;   proc doit {} {
#           while 1 {
#          .... script ...
#       }
#       }
#       doit
#   
#   Here we should code the while loop ourselves, however, since this whole script is enclosed in
#   a while 1 loop itself. Or, there is the -once option to Task which can be used to suppress that loop.
#   It is best to check the script using the above tget, to be sure you are getting the code you really want.
#       
#   (that ; in front of the proc is just to keep my editor from doing an auto fold on procs)
#
#   The [tdump] command will dump all the Task associated shared variables. For example, 
#   
#       helper1    tid: tid000026E0  exists: 1
#                    (helper1,cond)       = |cid1| 
#                    (helper1,count)      = |3| 
#                    (helper1,error)      = || 
#                    (helper1,gvar)       = |::foobarvar3(6)| 
#                    (helper1,mutex)      = |mid0| 
#                    (helper1,pid)        = |tid00002F40| 
#                    (helper1,queue)      = || 
#                    (helper1,result)     = |{6 helper-one-}| 
#                    (helper1,script)     = |#Preamble??set ::t_pid tid00002F40?set ....
#                    (helper1,share)      = |int_sum| 
#                    (helper1,tid)        = |tid000026E0| 
#   
#   The [tdump] command will replace newlines and tabs with unicode characters to keep the output 
#   from getting ugly by the script. It also dumps additional information about the shared
#   variables. It limits the size of each line, and takes an optional arg to set the max width.
#
#   The global variable that is used in a [tcall] to return the results can be a namespace'd variable
#   array or scalar. If it begins with :: it will be used as entered, but will have :: prepended if not. 
#
#   Each Task normally has it's own set of mutex, condition variables, and a queue. However, 
#   if the Task name is of the form 
#
#       tname/taskmain 
#
#   then the task name will be the first part (tname) but it will share the use of the
#   shared variables from the 2nd Task's (taskmain) set. This implements a single queue multi server 
#   setup. See the example in Ashok's book "The tcl programming language" which was heavily used in
#   creating this module.
#
#   
#   An example, 
# ---------------------------------------------------------
#   ;   proc someproc {arg1 arg2} {     ;# this could also be in the task script, but we'll import it
#           ...
#           return $result
#       }                               ;# being imported means it's not inside the catch of the script
#       
#       set script {                    ;# when multiple tasks use the same script this technique is best
#           while 1 {
#               twait -> arg1 arg2
#               set result [someproc $arg1 $arg2]
#               treturn $result
#           }
#       }
#   
#   This will start 4 Tasks (so 4 cpu threads). They all specify the task main, but
#   whichever thread is not busy and wakes up to take a work item from the queue
#   will be the one that runs.
#   
#       Task main   {someproc otherimports} $script         ;# create main and 3 helper Tasks
#       Task helper1/main {someproc otherimports} $script   ;# notice that we import someproc since we don't
#       Task helper2/main {someproc otherimports} $script   ;# load it directly inside the script variable
#       Task helper3/main {someproc otherimports} $script
#
#   The tasks (and threads) will be created by the Task call, and will likely be waiting for input, so
#   this will call them with their first arglist. The res array elements should be distinct as so:
#   
#       tcall main -async res(1) 100 200 ;# res(1) will be set when this completes, 100 200 are the 2 args.
#       tcall main -async res(2) 200 200
#       tcall main -async res(3) 300 200
#       tcall main -async res(4) 400 200
#       
#       .... do something ...
#       
#       tvwait res(1)
#       tvwait res(2)
#       tvwait res(3)
#       tvwait res(4)   ;# wait for all 4 to finish (in any order, but we wait on all 4)
#                       ;# if the first one takes the longest, the others will already be done
#                       ;# by the time that one finishes, but that's ok, other tvwait's will return immediately.
#                       ;# In order to do a vwait on that variable (tvwait does that) the variable is unset in
#                       ;# the [tcall], and set by a thread::send back to the caller thread where it's set
#   
#   
#
#
#
#   Note, a bug has surfaced in tcl/tk on linux when using putz. It causes a crash. So this
#   version includes a test for the platform and rather than a separate tk text window per
#   task, sends the output to stdout using a puts. This will not work on windows, which will
#   still use the separate windows. However, there is now an option with the t_debug global
#   that will have the windows version output to the console by using a thread::send -async
#   back to the main thread, with a puts of the text. If color is red, it will also output
#   to stderr. There has been added another tsv:: shared variable with the main threads id.
#
#   See the comments in putz for the different values of t_debug. When all are output to
#   the single stream, either stdout or the windows console, the task name will be prefixed
#   plus a ! (easy to use with grep). 
#
#   
#   The taskid is a thread id and so can also be used with various lower level 
#   thread calls. A thread::send could be used to interrupt the thread (assuming it 
#   is waiting and not doing solid compute). The Task works off of a queue and that 
#   queue will be checked with a 50 ms timeout timer. When the timer goes off, an update 
#   is issued and it loops back. This will allow for any widgets created by the Task 
#   (including the putz window) to update. Also the thread::send script will have 
#   time to be run from the event queue.
#
#
#   A [tvwait] is like a regular vwait, except it first checks for the existance of
#   the rglobal. It was designed so that [update] or [vwait] calls could occur between
#   the [tcall] and the [tvwait].
#   
#   However, this could lead to a race condition. The solution is to unset the rglobal
#   in tcall before placing work in the tasks queue. 
#   
#   This has a side effect. If you set a trace on the variable, before a tcall, 
#   your trace will be deleted (unseting a traced variable also deletes the trace). 
#   So, you need to setup the trace after the tcall like this:
#   
#       tcall $tname -async rglobal ?arg ...?
#        ...
#       if { ! [info exist rglobal] } {
#           trace add variable rglobal {write} {notify }
#       } else {
#           notify ...  ;# here if it already exists, just call notify immediately
#       }
#   
#   This could be useful if one wants to [tcall] the task, but does not want to [tvwait] for
#   it later (tvwait is a blocking wait). Say instead, it just wants an event to trigger 
#   when the variable is set. In this method, we call notify when the variable is written
#   to (i.e. is set).
#   
#   But we should only setup the trace if the variable doesn't yet exist, and if it does
#   exist, then we will call notify directly. Thus notify won't miss being called if the
#   variable has already been set to a value.
#   
#   If the task is tcall'ed again, the trace would have to be issued once again. 
#
#   
#   Namespace tasks
#   
#   This namespace is used to enclose the procs for this package. A program can use the
#   namespace import feature like so 
#
#       namespace import tasks::*
#
#   to avoid needing to fully qualify the names. 
#
#   However, the Tasks themselves each import all the tasks procs and also create a tasks
#   namespace. If this option is used, then each task definition should include the -import
#   option. Then the tasks will not need to fully qualify their names either.
#
#   When -import is used, then the imported (i.e. not tasks:: qualified) names are used and the
#   task need not qualify each task::* call.
#    
################################################################################################


#################################################

package require Thread
    
tsv::set  tids [thread::id] mainthread  ;# for reverse lookup 
tsv::set  main mainthread [thread::id]  ;# for reverse lookup 
#################################################
namespace eval tasks {        
proc putz {arg {color normal} {debug no}} { ;# debugging put using a text widget from a Task (a thread)
##########################################
#   t_debug 0  means we use the tk, but no  debug output - the default if < we use 0
#   t_debug 1  means we use the tk  and yes debug stuff
#
#   t_debug 2  means we don't use the tk, and also no  debug
#   t_debug 3  means we don't use the tk, and also yes debug output debug
#
#   platform is windows     ok
#   platform is not windows then we add 2 to the value of t_debug
##########################################
    set dodebugging     0
    set dotk        0
    if { ! [info exist ::t_debug] } {
        set io stdout
        if { $color ne "normal" && $::tcl_platform(platform) eq "windows"} {
            set io stderr
        }
        puts $io $arg
        return
    }
    set tdebug $::t_debug
    if       { $tdebug < 0 || $::t_putz_output == 0} {
        return
    } elseif { $tdebug > 3 } {
        error "t_debug set to > 3 an invalid setting"
    }
    if { $::tcl_platform(platform) ne "windows"  } { ;# hack: change windows to windowsx to force it to use stdout/stderr and a puts
        if { $tdebug < 2 } {
            incr tdebug 2
        }
    }
    
    if       { $tdebug == 0} {
        set  dotk 1
    } elseif { $tdebug  == 1} {
        set  dotk 1
        set  dodebugging 1
    } elseif { $tdebug  == 2} {
        # ok as is, both 0
    } elseif { $tdebug  == 3 } {
        set dodebugging 1
    } else {
        error "bad value for tdebug"
    }
#   error "dotk= |$dotk| dodebugging= |$dodebugging| tdebug= |$tdebug| color= |$color| debug= |$debug| ::t_debug= |$::t_debug| "
#   return  ;# to turn off debugging putz calls always
    if { $debug  eq "debug" && $dodebugging == 0} {
#       puts "we are returning with     $arg"
        return  
    }
    if { $dotk == 0 } {
        set mid [tsv::get main mainthread]
        set argg "[format %-10s  $::t_name] ! $arg"
        set io stdout
        if { $color ne "normal" && $::tcl_platform(platform) eq "windows"} {
            set io stderr
        }
#       puts "trying to send it"
        if { $::tcl_platform(platform) eq "windows" } {
            thread::send -async $mid [list puts $io $argg]
        } else {
            puts $io $argg
        }
        return
    }
    if { [info command .ttttt] eq "" } {                    ;# ![info exist ::t_putz] 
#        set ::t_putz 1
        package require Tk
        if [catch {
            set tname [tsv::get tids [thread::id]]
        } err_code] {
            set tname "No Task" 
        }
        frame  .fffff
        button .fffff.bbbbb -text "Program exit      [thread::id] $tname"   -command exit
        button .fffff.ccccc -text "Clear text"                              -command {.ttttt delete 1.0 end}
        
        set ::t_task_pause 0
        checkbutton .fffff.cbcbcb1 -variable ::t_task_pause -text "pause"
        
        text      .ttttt    -yscrollcommand     {.sssss set}
        scrollbar .sssss    -command            {.ttttt yview}
        
        pack .fffff -side top -fill x
        pack .fffff.ccccc .fffff.bbbbb -side left -expand 1 -fill x
        pack .sssss -side right -fill y
        pack .ttttt -side left -fill both -expand 1
        pack .fffff.cbcbcb1 -side right -fill y
        
        set ::t_putz_output 1
        checkbutton .fffff.cbcbcb2 -variable ::t_putz_output -text "putz output" 
        pack .fffff.cbcbcb2 -side right -fill y
        .ttttt tag configure debug              -foreground black
        .ttttt tag configure normal             -foreground black
        .ttttt tag configure green              -foreground \#408f40 -background \#e8e8e8 -font {courier 10 bold}
        .ttttt tag configure white              -foreground white -background black  -font {courier 10 bold}
        .ttttt tag configure yellowonblack      -foreground yellow -background black -font {courier 10 bold}
        .ttttt tag configure yellow             -foreground yellow -background red
        .ttttt tag configure whiteonred         -foreground white -background red -font {courier 10 bold}
        .ttttt tag configure red                -foreground red -font {courier 10}
    }
    if [catch {
        .ttttt insert end $arg\n $color
        .ttttt see end
        update
    } err_code] {
#       puts $err_code 
    }
}

proc wait { ms } {              ;# non busy wait
    set uniq [incr ::__sleep__tmp__counter]
    set ::__sleep__tmp__$uniq 0
    after $ms set ::__sleep__tmp__$uniq 1
    vwait ::__sleep__tmp__$uniq
    unset ::__sleep__tmp__$uniq
}
#wait 1
#puts "__sleep__tmp__counter= |$__sleep__tmp__counter| "
    
#################################################
    
proc xwait {arg {doupdate 1} {doputz 0}} {              ;# a busy wait version of wait, to test compute bound
    set max [expr {   $arg * 12000   }]
    for {set m 0} {$m < $max} {incr m} {
        incr mm 
        if { ($m % 100000) == 0 } {
            if { $doupdate } {
            update
        }
    }
    }
    if { $doputz } {
    putz "xwait max= |$max|" normal debug
    }
}


#################################################

proc comma {num {sep ,}} { ;    ;# commify a positive number
    while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
    return $num
}

#proc Task package code         -----------------------------------------------------------
################################################# return a name from a tid
proc tname {tid} {              ;# shorthand to get the taskname given a Task id
    return [tsv::get tids $tid]
}
################################################# get or set by taskname and parm
proc tset {name parm args} {    ;# shorthand to get or set a shared variable given a Task name and element (optional value)
#   puts "name= |$name| parm= |$parm| "
    set items [list tid pid result script mutex gvar cond queue count error]
    
    if { $args != {} } {
#       puts "set $name($parm) with args = $args"
        foreach item $items {
            if { $parm eq $item } {
                return [tsv::set tvar $name,$item $args]
            }   
        }
    } else {
        foreach item $items {
            if { $parm eq $item } {
                return [tsv::set tvar $name,$item]
            }   
        }
    }
#   puts  "unknown item $parm"
}
#proc tget/tset alias           -----------------------------------------------------------
interp alias {} tget {} tset
################################################# dump all shared variables
proc tdump {{pat *} {max 90}} {         ;# dump all the shared Task variables
    puts "\n------ Task(s) dump -----------------------------------------"
    puts "tsv::names  = |[tsv::names *]|"
#   puts "tsv::tvar   = |[tsv::array names tvar *]|"
    puts "tsv::tids   = |[tsv::array names tids *]|"
    puts "---------------------------------------------------------------"
    set tvarnames [lsort -stride 2 -index 1 [tsv::array get tids]]
    puts "tid/names   = |$tvarnames|"
    puts "---------------------------------------------------------------"
    set io stdout
    if { $::tcl_platform(platform) eq "windows" && 0} {
        set io stderr
    }
    foreach {var val}  [lsort -dictionary -stride 2 -index 1 $tvarnames ] {
        puts $io "[format %-10s $val] tid: $var  exists: [thread::exists $var]"
        set tidnames [tsv::array names tvar $val,*]
        foreach tname [lsort $tidnames] {
            set val [tsv::get tvar $tname]
            set val [string map {\n \u2936 \t \u02eb} $val]
            if { [string match *${pat}* $tname] } {
                puts "                 [format %-20s ($tname)] = |[string range $val 0 $max]| "
            }
        }
    }
    puts "---------------------------------------------------------------"
}
#proc - main Task procs         -----------------------------------------------------------
#################################################
proc Task {name0 args} {        ;# create a Task
    set dowhile 1               ;# assume we want the automatic while loop, but if -once is the first arg in args, we suppress it
    set donamespace 1           ;# assume we want to use namespaces, so we import by namespace
    foreach option {1 2} {
#       puts "$option - args= |$args| "
        if {        [lindex $args 0] eq "-once" } {
            set dowhile 0
            set args [lrange $args 1 end]   ;# shift over the first item in args if -once is the next one
        } elseif {  [lindex $args 0] eq "-import" } {
            set donamespace 0
            set args [lrange $args 1 end]   ;# shift over the first item in args if -import is the next one
        }
    }
    set len [llength $args]
    if       { $len == 0 || $len > 2 } {
        error "too few or too many args to Task = $len"
    } elseif { $len == 1 } {
        set args [list {} [lindex $args 0 ]]
    }
#   puts "dowhile= |$dowhile|  "
#   puts "import = |$donamespace|  "
    set names [split $name0 /]
    if { [llength $names] == 1 } {
        set name $name0
        set share no
        set sname {}
    } elseif { [llength $names] == 2 } {
        lassign $names name sname           ;# my name plus which shared queue do we use
        set share yes
    } else {
        error "Invalid Task name |$name0|"
    }
    if { [info exist ::t_debug] && $::t_debug } {
        if [catch {
            puts "Task: name= |$name| sname= |$sname| name0= |$name0| names= |$names| share= |$share| args(end-1)= |[lrange $args end-1 end-1]|"
        } err_code] {
            catch {putz "Task: name= |$name| sname= |$sname| name0= |$name0| names= |$names| share= |$share| args(end-1)= |[lrange $args end-1 end-1]|"}
        }
    }
    
    
    set me [thread::id]
    tsv::set tvar $name,pid $me             ;# save current parent pid
    tsv::set tvar $name,gvar {}             ;# used by tresult and tcall for a global to wait on
    tsv::set tvar $name,result {}           ;# the result
    tsv::set tvar $name,count 0             ;# the number of times waked up
    tsv::set tvar $name,error {}            ;# the last error if any
    tsv::set tvar $name,share {}            ;# the shared queue if any
    
    if { $share } {
        set mutex   [tsv::get   tvar    $sname,mutex]
        set cond    [tsv::get   tvar    $sname,cond]
        tsv::set    tvar    $name,share     $sname
        
    } else {
        set mutex   [thread::mutex create]
        set cond    [thread::cond create]
    }
    tsv::set    tvar    $name,queue     {}              ;# setup the cond/mutex and the queue
    tsv::set    tvar    $name,mutex     $mutex
    tsv::set    tvar    $name,cond      $cond
    
    set dw1 "while 1 \{"        ;# also enclose our script in a while 1 loop unless the option -once is used
    set dw2 "\}"
    if { ! $dowhile } {
        set dw1 ""
        set dw2 ""
    }
#   puts "dw1= |$dw1| dw2= |$dw2| "
    set e1 "if \[catch \{$dw1"  ;# enclose script in a catch, and a while (unless suppressed with the option)
    set e2a "\n\}$dw2 thread_err_code thread_err_dict\] \{\n    tsv::set tvar $name,error \$thread_err_dict  \n"
    set e2b {package require Tk; tk_messageBox -message "Name = $::t_name Parent = $::t_pid\n$thread_err_code\n\n$thread_err_dict" -title "tid [thread::id]"}
    set e2c "\n\}\n"
    
    set e2 ""
    append e2 $e2a $e2b $e2c
    
#   puts "$e1----\n----$e2"
    set autoimport [list ::tasks::tproc ::tasks::tdump ::tasks::putz ::tasks::treturn \
                        ::tasks::wait ::tasks::tset ::tasks::tcall ::tasks::twait ::tasks::Task ::tasks::tgroup \
                        ::tasks::xwait ::tasks::comma ::tasks::tname ::tasks::tvwait ::tasks::tpause_check]
    if { ! $donamespace } {
        set autoimport [string map {::tasks {}} $autoimport]
    }
    set preamble "#Preamble\n\nnamespace eval tasks {}\nset ::t_pid $me\nset ::t_name $name\nset ::t_putz_output 1\nset ::t_task_pause 0\nset ::t_debug 0\n[tproc {*}$autoimport]\n"
    if       { [llength $args] == 2 } {
        lassign $args prefix script00
        append script0 $e1 $script00 $e2
        append script $preamble  "\n#end preamble\n" "\n#included procs: importing: $prefix\n\n" [tproc {*}$prefix] $script0
#       puts "2 args with prefix $prefix --------------------------------"
    } elseif { [llength $args] == 1 } {
        lassign $args script0
        append script $preamble  "\n#end preamble\n" "\n#included procs: none\n\n"  $script0
#       puts "1 args ----------------------------------------"
    } else {
#       dothis
    }
#   puts stderr "script= \n|\n$script| the parent me= |$me| "
    set tid [thread::create $script]
    
    tsv::set  tvar $name,tid        $tid
    tsv::set  tvar $name,script     $script
    tsv::set  tids $tid             $name       ;# for reverse lookup
    if { $share } {
#       tdump
#       vwait ffff
    }
    uplevel set $name $tid
    return $tid
}
proc tproc {args} {             ;# get procedure(s) and return results, internal use by [Task]
    set output {}
    foreach arg $args {
        set found 0
        foreach proc [info procs ::$arg] {
            set found 1
            set space ""
            append output  "proc $proc {"
                foreach arg [info args $proc] {
                    if [info default $proc $arg value] {
                        append output  "$space{$arg \{$value\}}"
                    } else {
                        append output  $space$arg
                    }
                    set space " "
                }
#                No newline needed because info body may return a
#                value that starts with a newline
                append output  "} {"
                append output   [info body $proc]
            append output "}\n"
        }
        if { $found == 0 } {
            error "No imports found for $arg\n"
        }
    }
    set lines [split $output \n]
    set out {}
    foreach line $lines {
        if { [string index $line 0] eq "#" } { ;# don't import comment lines, just a blank line instead (so line numbers don't change)
            set line "#"
        }
        append out $line \n 
    }
    return $out
}
proc treturn {args} {           ;# return the value from a Task
#   putz "treturn args= |$args| "
    set exiting no
    if { [llength $args ] > 0} {
        if       { [lindex $args 0] eq "-exit"} {
            set exiting yes
            set args [lrange $args 1 end]
        }
    }
    if [catch {
        set rvalue $args
        set me      [thread::id]
        set name    [tsv::get   tids            $me]
        set pid     [tsv::get   tvar            $name,pid]
        tsv::set    tvar        $name,result    $args
        set gvar    [tsv::get   tvar            $name,gvar]
        
#       putz "+++rvalue= |$rvalue| exiting= |$exiting| me= |$me| name= |$name| pid= |$pid| gvar= |$gvar| "
        if { $args == {} } {
            thread::send $pid [list set ::$gvar $rvalue]    ;# to allow for an empty return value
        } else {
            thread::send $pid "set ::$gvar $rvalue"         ;# to allow for a simple text string or a [list]
        }
#       putz "sent the return value $rvalue to $gvar"
        
    } err_code] {
        putz $err_code
    }
}

#################################################
proc tcall {taskid args} {      ;# call a Task, sync or asyn
        if {! [thread::exists $taskid] } {
                error "Thread does not exist"
        }
    set name [tsv::get tids $taskid]
#   puts "args= |$args| taskid= |$taskid| name= |$name| "
    set async no
    if { [llength $args ] > 0} {
        if       { [lindex $args 0] eq "-async"} {
            set async yes
            set args [lrange $args 1 end]
        }
    }
    if { [llength $args ] > 0} {
        set theglobal   [lindex $args 0]
        set args        [lrange $args 1 end]
    } else {
        error "tcall missing the argument for global variable"
    }
    if { [string range $theglobal 0 1] ne "::" } {
#       puts stderr "added :: to $theglobal"
        set theglobal "::$theglobal"
    }
#   global $theglobal
    unset -nocomplain $theglobal
#   puts "$theglobal exists [info exists $theglobal]"
    
#   thread::send ?-async? ?-head? id script ?varname?
#   return
    
    set mutex   [tsv::set tvar $name,mutex]
    set cond    [tsv::set tvar $name,cond]
    set argsx   [list]
    lappend     argsx   [thread::id]    $theglobal $args
    
#   tsv::set tvar $name,gvar $theglobal ;################## the problem
    
#   puts "send args = |$argsx|  mutex= |$mutex| cond= |$cond| "
    
    thread::mutex   lock    $mutex
    tsv::lpush      tvar    $name,queue $argsx end
    thread::cond    notify  $cond
    thread::mutex   unlock  $mutex
    
    if { $async } {
        if [catch {
#           puts "send  $name  $taskid   args -async = |$args|" ;# this will fail if we were not called by the main thread
        } err_code] {
            putz "async cannot use puts here $err_code" green debug
            catch {putz "send  $name  $taskid   args -async = |$args|"} ;# try again but to the thread instead
        }
        return 1
    } else {
        if { ![tvwait $theglobal $taskid] } {
            return {}
        }
        return [set $theglobal]
#       return [tsv::set tvar $name,result] ;# note, if we are using a shared queue, this will not be right, must use global var instead
    }
    
    
}
#################################################
proc tpause_check {args} {
    set twcount 0
    if { $::t_task_pause } {
        while { $::t_task_pause } {
            if { [incr twcount] == 1 } {
                putz "Pausing  task: $twcount"
            }
            wait 1000
        }
        putz "Resuming task after:  $twcount seconds"
        wait 1000
    }
    
}

proc twait {args} {             ;# wait for something in the Task queue
#   putz "   inside twait for $::t_name"
#   wait 2000
    tpause_check
    if [catch {
        set mutex [tsv::get tvar $::t_name,mutex]
        set cond  [tsv::get tvar $::t_name,cond]
#       putz "twait:    mutex= |$mutex| cond= |$cond| " normal debug
    } err_code] {
        catch {putz $err_code}
    }
#   putz "good"
    if [catch {
        
#       putz "about to lock $mutex"; update
#       wait 2000
        thread::mutex lock $mutex
#       putz "after lock"; update
        set count 0
        set sname [tsv::get  tvar $::t_name,share]
        if { $sname != {} } {
            set tname $sname
        } else {
            set tname $::t_name
        }
        catch {putz "" normal debug}
        catch {putz "sname(share name) = |$sname| tname(use)= |$tname| ::t_name(me)= |$::t_name| "  normal debug}
        set count -1
        while {[tsv::llength tvar $tname,queue] == 0} {
            incr count
            if { $count % 50 == 0 && $count <= 100} { ;# output 3 times only each idle period
                catch {putz "queue is empty, so wait $count" red debug}
            }
            thread::cond wait $cond $mutex 50
            update
        }
        catch {putz "queue not empty len= [tsv::llength tvar $tname,queue] contents: [tsv::get tvar $tname,queue]" green debug}
        set works [tsv::lpop tvar $tname,queue]
        thread::mutex unlock $mutex
        
        lassign $works pid gvar work ;# got these from the queue, now set gvar, so the return can use it, also the parent thread to return to
        tsv::set tvar   $::t_name,gvar  $gvar 
        tsv::set tvar   $::t_name,pid   $pid 
        
        set ms [clock milliseconds]
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        
        catch {putz "[string range [clock format $secs] 11 18].$ms job [expr {   [tsv::get tvar $::t_name,count]+1   }]: worklen= |[llength $works]|     work= |$work| parentid= $pid globalvar= $gvar " yellowonblack debug}
        
        } err_code err_dict] {
                set err [lrange [dict get $err_dict -errorcode] 0 1]
                tsv::set tvar $::t_name,error [list $err_code $err]
                catch {putz "error2: |$err_code| err |$err| " normal debug}
                error  $err ;# propogate up, this could be a cancel, not sure what else to do here
    }
    tsv::incr tvar $::t_name,count

# should be able to do this with just one uplevel and lassign, but couldn't figure it out, so brute force it
    if { [llength $args] > 0 } { ;# if the call contained a variable to get the args, plus optionally variables to "lassign" them to
        set name [lindex $args 0]
        set rest [lrange $args 1 end]
        
        catch {putz  "args varname= |$name| rest of variables= |$rest|" normal debug}
        uplevel set $name [list $work]
        
        set i -1
        foreach item $rest {
            incr i
            set data [lindex $work $i ] 
            catch {putz "i= |$i| item= |$item| data= |$data| " normal debug}
            uplevel set $item [list $data]
        }
    
    }
    
    
    return $work
    
}
#################################################
proc tvwait {var {tid {}}} {    ;# wait till an async Task call, with Task id tid, completes and sets the variable
    if { [string range $var 0 1] ne "::" } {
        set var "::$var"
    }
    if { ![info exist $var] } {
        if {$tid != {} && ![thread::exists $tid] } { ;# if given a taskid, make sure it's still running or we wait forever
            set io stdout
            if { $::tcl_platform(platform) eq "windows" && 0} {
                set io stderr
            }
            if [catch {
                puts $io "Task: $tid does not exist, while waiting on $var"
            } err_code] {
                putz "error in twait: $err_code" normal debug
                catch {putz  "Task: $tid does not exist, while waiting on $var"}
            }
            return 0
        }
        vwait $var
    }
    return 1    
}
############ tgroup ##########################################################
#   
#   Multiple task builder. This takes tname and uses it for a
#   group of tasks. The names will be tname0, tname1, .... tname(N-1)
#   where tname0 is the boss and the rest will be boss/helper with
#   names like tname1/tname0, tname2/tname0, ... tname(N-1)/tname0
#   
#   If the number of tasks is negative, e.g. -4, then the abs(number) will
#   be used, but the -N also will then create traces on each of the tasks
#   assigned result variables (rvar,n). in the -call code, after the tcall's
#   
#   tname is also the name of a global array that will be
#   first unset on the -tasks option, and then the following elements are
#   generated:
#   
#   where n is the number 0..N-1 for N tasks
#   
#   rvar,n     the result value element the calls use
#   args,n     the arguments passed to the n'th task
#   tid,n      the task id's
#   
#   tasks      one only, the number of tasks  
#   
#   The tasks are all linked to the first one, tname0, and they may exit, but
#   tname0 should not exit. If the script is the same for each, they can tell
#   if they are the boss task by testing for the number in ::t_name which is
#   always set to the task's name and will have a number at the end. 
# 
#   usage:
#   
#   tgroup group -tasks N .... args to a task beginning with the options
#   tgroup group -call {arglist 1} {arglist 2} ...
#   tgroup group -wait all 
#   
#   
# 
############
    
proc tgroup {tname option args} {

    if       { $option eq "-tasks" } {
        uplevel array unset $tname
        upvar 1 $tname name
        
        set argss [lassign $args num]
#       puts "num=$num argss= |$argss| "
        set name(trace) 0
        if { $num < 0 } {
            set num [expr {   0 - $num   }]
            set name(trace) 1
        }
        set name(tasks) $num
#                                                                           uplevel [list set $tname\(tasks2\) $num ]
        for {set n 0} {$n < $num } {incr n} {
            if { $n == 0 } {
                set t ${tname}0
            } else {
                set t   ${tname}${n}/${tname}0
            }   
            set tid [uplevel [list Task $t {*}$argss]]
#           puts "n= |$n| tid= |$tid| "
#                                                                           uplevel [list set $tname\(id,$n\) $tid ]
            set name(tid,$n) $tid
        }
        
    } elseif {  $option eq "-call"  } {
        upvar 1 $tname name
        set numtasks $name(tasks)
        set numarglists [llength $args]
#       puts "numarglists= |$numarglists| numtasks= |$numtasks| "
        if { $numarglists >  $numtasks} {
            error "tgroup $tname : too many arglists, $numarglists with only $numtasks tasks"
        }
        set index 0
        for {set job 0} {$job < $numtasks } {incr job} {
            if { ($job % $numarglists) == 0} {
                set index 0
            }
            set theargs [lindex $args $index ]
#           puts "job= |$job| index= |$index| numarglists= |$numarglists| numtasks= |$numtasks| args($index)= |$theargs| "
            set name(args,$job) $theargs
            set tid [tset  ${tname}0 tid]
            set tn  [tname $tid]
#           puts stderr "calling: tid= |$tid| tn= |$tn|  job  = |$job| resvar = |::${tname}(rvar,$job)| args= |{*}$theargs|"
            set c [uplevel [list tcall $tid -async ::${tname}(rvar,$job) {*}$theargs]]
#                                                                                       wait 2200
            if { $name(trace) } {
                if {! [info exist  ::${tname}(rvar,$job)] } {
#                                                                                       puts "set trace on ::${tname}(rvar,$job)  to $tname" ;update
                    trace add variable ::${tname}(rvar,$job) write $tname
#                                                                                       puts "trace info = [trace info variable ::${tname}(rvar,$job)]"
                } else {
#                                                                                       puts "call $tname direct"
                    $tname  ::$tname rvar,$job Write
                }
            }
#           vwait ffff
            if { $c != 1 } {
                error "error calling tgroup -call on job $job"
            }
            
            incr index
        }
        
    } elseif {  $option eq "-wait"  } {
        upvar 1 $tname name
        lassign $args type
        if       { $type eq "all" } {
            set numtasks $name(tasks)
            for {set job 0} {$job < $numtasks } {incr job} {
#               puts "-wait on job= |$job| numtasks= |$numtasks| rvar= ::${tname}(rvar,$job)"
                tvwait ::${tname}(rvar,$job)
            }
        } elseif { $type eq "one"  } {
            error "not implemented in tgroup yet $type"
        } else {
            error "Invalid tgroup call -wait $type must be all or one"
        }
    } else {
        error "Invalid option to tgroup: $option, must be -tasks, -call, or -wait"
    }
}
namespace export {*}[info proc]
}
# end of tasks namespace eval
# this was the polling method first used, kept here for reference only
#proc tvwait {var {tid {}}} {   ;# wait till an async Task call, with Task id tid, completes and sets the variable - polling method
#   if { [string range $var 0 1] ne "::" } {
#       set var "::$var"
#   }
#
#   while {1 } {
#       incr n
#       if { ![info exist $var] } {
#           if {$tid != {} && ![thread::exists $tid] } {
#               set io stdout
#               if { $::tcl_platform(platform) eq "windows" && 0} {
#                   set io stderr
#               }
#               if [catch {
#                   puts $io "Task: $tid does not exist, while waiting on $var"
#               } err_code] {
#                   putz "error in twait: $err_code" normal debug
#                   catch {putz  "Task: $tid does not exist, while waiting on $var"}
#               }
#               return 0
#           }
#           wait 1
#           continue
#       }
#       puts "$n times wait"
#       return 1
#   }
#}


 Example

Small example

This example runs the proc sum in a separate thread, perhaps to keep the GUI responsive. It is called first synchronously, and then a second time asynchronously.

    namespace import tasks::*                ;# easiest to just import them all, but could limit to tasks::\[Ttp]* etc.

    proc sum args {foreach arg $args {incr s $arg} ;return $s} ;# sum the arglist items
   
    Task sumserver  -import {sum} {         ;# import all the tasks::* and also sum, this is a repeating task
            set t_debug 1                   ;# turn on debug tracing
            twait argv                      ;# wait for work and get the args
                set result [sum {*}$argv]   ;# call sum with the input args (note imported proc)
                putz "result= |$result| "   ;# output some debug info
            treturn $result                 ;# send back the results, sets a variable with the result, then repeat from top
    }
    
#   call synchronously:
    
    tcall $sumserver resultvar 100 200 300
    puts "resultvar= |$resultvar| " 
    
#   call asynchronously, then wait for it after doing something else 
  
    tcall $sumserver -async resultvar 1 2 3 4 5 6 7
#      ... can do something else while it crunches in the background ...
    tvwait resultvar

    puts "resultvar= |$resultvar| " 
    tdump                                   ;#some debug info about the task(s)

Here's the output on a linux system with the debug turned on, but where the tk window cannot (currently) be used:

$ tclsh wiki-example.tcl
sumserver  ! sname(share name) = || tname(use)= |sumserver| ::t_name(me)= |sumserver| 
sumserver  ! queue not empty len= 1 contents: {tid0x7feb1e590740 ::resultvar {100 200 300}}
sumserver  ! 10:48:03.079 job 1: worklen= |3|     work= |100 200 300| parentid= tid0x7feb1e590740 globalvar= ::resultvar 
sumserver  ! args varname= |argv| rest of variables= ||
sumserver  ! result= |600| 
resultvar= |600| 
sumserver  ! sname(share name) = || tname(use)= |sumserver| ::t_name(me)= |sumserver| 
sumserver  ! queue not empty len= 1 contents: {tid0x7feb1e590740 ::resultvar {1 2 3 4 5 6 7}}
sumserver  ! 10:48:09.153 job 2: worklen= |3|     work= |1 2 3 4 5 6 7| parentid= tid0x7feb1e590740 globalvar= ::resultvar 
sumserver  ! args varname= |argv| rest of variables= ||
sumserver  ! result= |28| 
sumserver  ! sname(share name) = || tname(use)= |sumserver| ::t_name(me)= |sumserver| 
sumserver  ! queue is empty, so wait 0
resultvar= |28| 

------ Task(s) dump -----------------------------------------
tsv::names  = |main tvar tids|
tsv::tids   = |tid0x7feb1d685700 tid0x7feb1e590740|
---------------------------------------------------------------
tid/names   = |tid0x7feb1e590740 mainthread tid0x7feb1d685700 sumserver|
---------------------------------------------------------------
mainthread tid: tid0x7feb1e590740  exists: 1
sumserver  tid: tid0x7feb1d685700  exists: 1
                 (sumserver,cond)     = |cid1| 
                 (sumserver,count)    = |2| 
                 (sumserver,error)    = || 
                 (sumserver,gvar)     = |::resultvar| 
                 (sumserver,mutex)    = |mid0| 
                 (sumserver,pid)      = |tid0x7feb1e590740| 
                 (sumserver,queue)    = || 
                 (sumserver,result)   = |28| 
                 (sumserver,script)   = |#Preamble??namespace eval tasks {}?set ::t_pid tid0x7feb1e590740?set ::t_name sumserver?set| 
                 (sumserver,share)    = || 
                 (sumserver,tid)      = |tid0x7feb1d685700| 
---------------------------------------------------------------
sumserver  ! queue is empty, so wait 50
sumserver  ! queue is empty, so wait 100


 Example using trace

Example with 8 Parallel Fibonacci computations

This example, derived from Ashok's web page on Promises [L1 ], computes the number of digits of 8 fibonacci numbers. Each task is a one shot and quits. The main thread uses a trace on each task call's variable so it can report each computed value as they are finished through the trace event call. It then also waits with tvwait for all 8 tasks to complete (the bigger the number the longer each takes).

It uses a non-busy wait so that one of the tasks finishes before the trace can be applied, and uses the technique mentioned where if the job is done, it just calls the trace notifier with similar arguments.

Followng that is a time comparison with running all 8 sequentially.

    package require math

    namespace import tasks::* 
                
    proc Time {} {
        set ms [clock milliseconds]
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        return [string range [clock format $secs] 11 18].$ms 
    }

# this example uses a trace to report results as they happen
# in this trace event: 

    proc notify {var index operation} {
        puts "[Time] [format %15s $var] ($index) $operation complete result = [set ::$var\($index\)]"
        update
    }

# list of pairs { job, fib number } using 8 jobs on I7: 4 core 8 threads

    set jobs {1 300000   2 310000   3 320000   4 330000 \
              5 300500   6 310500   7 320500   8 330500} 

##################################################  
#   create tasks and start a fibonacci on a number
##################################################
#   
    foreach {task number} $jobs {
        Task fibber$task -once -import { 
            package require math
            twait -> number
            treturn [string length [math::fibonacci $number]]
        }
        tcall [set fibber$task] -async result($task) $number
        puts "[Time] started task= $task with number= $number"
    }
#
##################################################

    puts "\n[Time] ----- all [expr {   [llength $jobs] / 2   }] started    ----" ; update
    tasks::wait 15000
    puts "[Time] ----- 15 sec wait done ----" ; update

############################################################    
#   create N traces on the tasks, Note cap W if already done 

    foreach task {1 2 3 4 5 6 7 8} {
       if { ! [info exist result($task)] } {
           trace add variable result($task) {write} {notify }
       } else {
           notify result $task Write   ;# here if it already exists, just call notify now with W so we know
       }
    }
#
####################################################### 
# now wait for all to have completed in different order 
#
    foreach task {6 3 2 4 8 1 7 5} {    
        puts "[Time] waiting on task $task" ; update
        tvwait result($task)
    }
#   
#######################################################

    puts "[Time] ----- all   complete ----\n" ; update  
    parray result ; update

####################################################### 
#   compute the numbers again, but sequentially

        puts "\n[Time] start sequentially"
        foreach {task number} $jobs {
            set tm [time {
                    set result2($task) [string length [math::fibonacci $number]]
            }]
            puts "[Time] [tasks::comma [lindex $tm 0]] [lrange $tm 1 end]  task $task = $result2($task)"; update
        }
        
    parray result2
#
#######################################################

Here is the output of one of those runs. Each will be slightly different. The processor used was an i7-4790k @ 4 gHz running windows 10. Running as tasks takes 18 seconds vs. 92 seconds sequentially.

15:49:22.795 started task= 1 with number= 300000
15:49:22.822 started task= 2 with number= 310000
15:49:22.844 started task= 3 with number= 320000
15:49:22.869 started task= 4 with number= 330000
15:49:22.895 started task= 5 with number= 300500
15:49:22.927 started task= 6 with number= 310500
15:49:22.955 started task= 7 with number= 320500
15:49:22.988 started task= 8 with number= 330500

15:49:23.003 ----- all 8 started    ----
15:49:38.219 ----- 15 sec wait done ----
15:49:38.220          result (1) Write complete result = 62696
15:49:38.221 waiting on task 6
15:49:38.225      ::::result (5) write complete result = 62801
15:49:39.079      ::::result (2) write complete result = 64786
15:49:39.298      ::::result (6) write complete result = 64891
15:49:39.299 waiting on task 3
15:49:40.241      ::::result (3) write complete result = 66876
15:49:40.242 waiting on task 2
15:49:40.242 waiting on task 4
15:49:40.536      ::::result (7) write complete result = 66981
15:49:41.234      ::::result (4) write complete result = 68966
15:49:41.235 waiting on task 8
15:49:41.315      ::::result (8) write complete result = 69071
15:49:41.316 waiting on task 1
15:49:41.318 waiting on task 7
15:49:41.319 waiting on task 5
15:49:41.320 ----- all   complete ----

result(1) = 62696
result(2) = 64786
result(3) = 66876
result(4) = 68966
result(5) = 62801
result(6) = 64891
result(7) = 66981
result(8) = 69071

15:49:41.332 start sequentially
15:49:52.046 10,713,372 microseconds per iteration  task 1 = 62696
15:50:03.507 11,458,033 microseconds per iteration  task 2 = 64786
15:50:15.702 12,193,040 microseconds per iteration  task 3 = 66876
15:50:28.758 13,053,244 microseconds per iteration  task 4 = 68966
15:50:39.595 10,834,563 microseconds per iteration  task 5 = 62801
15:50:51.173 11,576,267 microseconds per iteration  task 6 = 64891
15:51:03.527 12,349,874 microseconds per iteration  task 7 = 66981
15:51:16.664 13,134,909 microseconds per iteration  task 8 = 69071
result2(1) = 62696
result2(2) = 64786
result2(3) = 66876
result2(4) = 68966
result2(5) = 62801
result2(6) = 64891
result2(7) = 66981
result2(8) = 69071

 Example 1 using helper tasks

This example computes the length of 3 fibonacci numbers. First using just one thread, to keep any Tk gui responsive, the second method to run 3 in parallel to increase performance.

To create a helper task, that shares a queue with a previously created boss task, one specifies the two names as helper/boss. This will cause the helper to share the work on the boss's queue. This provides for a multi-server single queue. All requests still go to the boss, but the boss and all the workers have equal opportunity to grab a job off the queue.

In the results, notice the output of tdump which includes the count of times the task was called and the result of the last job it did. Also notice the mutex and cond variables were shared.

In several places, a <- or -> or even "- >" is used for variable names where the value is not needed. This is used to add a visual aid to separate arguments and indicate the semantics.

    namespace import tasks::*

    set script {
        package require math
        twait - >  number ;# wait for a call and the argument
        treturn  [string length [math::fibonacci $number]]
    }
    set jobs {100000 100005 100009} 

   
# each should take roughly the same time or the timing test
# could be dominated by the one that could take much longer
# this way we have a better idea of the speed up using 3 threads

##############################################################  
    
    set tm [time { ;# one thread 3 jobs
        
        Task fibber1  -import $script  ;# import tasks::*
        foreach num $jobs {
            tcall $fibber1 answer1($num) <- $num 
        }
        
    }]
    
    parray answer1
    puts $tm
    
##############################################################  
#   
#   extend this to compute all 3 in separate threads and wait till all are done
#   
##############################################################  

    set tm [time { ;# 3 threads 3 jobs
        
        foreach taskname {fibber3 helper31/fibber3 helper32/fibber3} {
            Task $taskname  -import  $script  ;# import tasks::*
        }

        foreach num $jobs { ;# call the 3 tasks w/o waiting
            tcall $fibber3 -async answer3($num) <- $num
        }
        
        foreach num $jobs { ;# wait for all 3 to be done
            tvwait answer3($num)
        }
        
    }]
    
    parray answer3
    puts $tm
    tdump
    
##############################################################  
    
# results:
#   answer1(100000) = 20899
#   answer1(100005) = 20900
#   answer1(100009) = 20901
#   3802318 microseconds per iteration
#   answer3(100000) = 20899
#   answer3(100005) = 20900
#   answer3(100009) = 20901
#   1342338 microseconds per iteration
#   
#   ------ Task(s) dump -----------------------------------------
#   tsv::names  = |main tvar tids|
#   tsv::tids   = |tid000008C4 tid000028A8 tid00003260 tid00001ADC tid000034B8|
#   ---------------------------------------------------------------
#   tid/names   = |tid00003260 fibber1 tid00001ADC fibber3 tid000028A8 helper31 tid000008C4 helper32 tid000034B8 mainthread|
#   ---------------------------------------------------------------
#   fibber1    tid: tid00003260  exists: 1
#                    (fibber1,cond)       = |cid1| 
#                    (fibber1,count)      = |3| 
#                    (fibber1,error)      = || 
#                    (fibber1,gvar)       = |::answer1(100009)| 
#                    (fibber1,mutex)      = |mid0| 
#                    (fibber1,pid)        = |tid000034B8| 
#                    (fibber1,queue)      = || 
#                    (fibber1,result)     = |20901| 
#                    (fibber1,script)     = |#Preamble??namespace eval tasks {}?set ::t_pid tid000034B8?set ::t_name fibber1?set ::t_deb| 
#                    (fibber1,share)      = || 
#                    (fibber1,tid)        = |tid00003260| 
#   fibber3    tid: tid00001ADC  exists: 1
#                    (fibber3,cond)       = |cid3| 
#                    (fibber3,count)      = |1| 
#                    (fibber3,error)      = || 
#                    (fibber3,gvar)       = |::answer3(100000)| 
#                    (fibber3,mutex)      = |mid2| 
#                    (fibber3,pid)        = |tid000034B8| 
#                    (fibber3,queue)      = || 
#                    (fibber3,result)     = |20899| 
#                    (fibber3,script)     = |#Preamble??namespace eval tasks {}?set ::t_pid tid000034B8?set ::t_name fibber3?set ::t_deb| 
#                    (fibber3,share)      = || 
#                    (fibber3,tid)        = |tid00001ADC| 
#   helper31   tid: tid000028A8  exists: 1
#                    (helper31,cond)      = |cid3| 
#                    (helper31,count)     = |1| 
#                    (helper31,error)     = || 
#                    (helper31,gvar)      = |::answer3(100005)| 
#                    (helper31,mutex)     = |mid2| 
#                    (helper31,pid)       = |tid000034B8| 
#                    (helper31,queue)     = || 
#                    (helper31,result)    = |20900| 
#                    (helper31,script)    = |#Preamble??namespace eval tasks {}?set ::t_pid tid000034B8?set ::t_name helper31?set ::t_de| 
#                    (helper31,share)     = |fibber3| 
#                    (helper31,tid)       = |tid000028A8| 
#   helper32   tid: tid000008C4  exists: 1
#                    (helper32,cond)      = |cid3| 
#                    (helper32,count)     = |1| 
#                    (helper32,error)     = || 
#                    (helper32,gvar)      = |::answer3(100009)| 
#                    (helper32,mutex)     = |mid2| 
#                    (helper32,pid)       = |tid000034B8| 
#                    (helper32,queue)     = || 
#                    (helper32,result)    = |20901| 
#                    (helper32,script)    = |#Preamble??namespace eval tasks {}?set ::t_pid tid000034B8?set ::t_name helper32?set ::t_de| 
#                    (helper32,share)     = |fibber3| 
#                    (helper32,tid)       = |tid000008C4| 
#   mainthread tid: tid000034B8  exists: 1
#   ---------------------------------------------------------------
#    

 Example 2 using helper tasks

Example helper tasks: 2 tasks 8 jobs

In this example, we again compute the same fibonacci numbers as the previous example (8 numbers so 8 jobs), but we don't run 1 task per number; rather, we setup only 2 tasks, a main task fibber which has the queue, and one helper task helper2 that shares the queue from fibber. The number of tasks is assigned to the variable ntasks and for this demo was set to just 2. This results in the two tasks sharing the load and each ends up working 4 jobs.

With some changes to the number of tasks, the load will be distributed differently. If more tasks exist than there are jobs, e.g. 10 tasks, you will see that some do no work at all.

Each task sets the t_debug global variable to 1, and so each task will create it's own toplevel window with a text widget on the first output from the debugging log. Debugging uses the putz command with different colors for various items, but that cannot be copy/pasted here, only the text, not the attributes. Note that if there were in fact 10 tasks, you'd see 10 windows.

    package require math

    namespace import tasks::* 
                
    proc Time {} {
        set ms [clock milliseconds]
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        return [string range [clock format $secs] 11 18].$ms 
    }


# list of pairs { job, fib number } using 8 jobs on I7: 4 core 8 threads

    set jobs {1 300000   2 310000   3 320000   4 330000 \
              5 300500   6 310500   7 320500   8 330500} 

##################################################
# 
    set taskname fibber
    set ntasks 2
    for {set tasknum 1} {$tasknum <= $ntasks } {incr tasknum} {
        if { $tasknum > 1 } { ;# first one fibber, others helper#/fibber
            set taskname helper$tasknum/fibber
        }
        puts "[Time] creating task $taskname"
        Task $taskname  -once -import {
            set t_debug 1           ;#  set this once
            package require math    ;#  and do this once only
            while 1 {               ;#  but repeat this forever
                twait -> number
                treturn [string length [math::fibonacci $number]]
            }
        }
    }
#
##################################################  
#   start a fibonacci on a number

    foreach {job number} $jobs {
        puts "[Time] starting job= $job with number= $number"
        tcall $fibber -async result($job) $number
        update
    }
#
# now wait for all jobs to have completed 
#
    set njobs [expr {   [llength $jobs] / 2   }]
    puts "[Time] wait for $njobs jobs"
    for {set job 1} {$job <= $njobs } {incr job} {
        puts "[Time] waiting on job $job" ; update
        tvwait result($job)
    }
#   
#######################################################

    puts "[Time] ----- all   complete ----\n" ; update  
    parray result ; update
    tdump

Here is the output to stdout from puts. The tdump command output is shown as well. You can see that they use the same mutex and conditional, and the helper2 task has the share attribute set to fibber.

11:38:24.005 creating task fibber
11:38:24.035 creating task helper2/fibber
11:38:24.055 starting job= 1 with number= 300000
11:38:24.184 starting job= 2 with number= 310000
11:38:24.255 starting job= 3 with number= 320000
11:38:24.257 starting job= 4 with number= 330000
11:38:24.257 starting job= 5 with number= 300500
11:38:24.258 starting job= 6 with number= 310500
11:38:24.259 starting job= 7 with number= 320500
11:38:24.259 starting job= 8 with number= 330500
11:38:24.260 wait for 8 jobs
11:38:24.260 waiting on job 1
11:38:35.159 waiting on job 2
11:38:35.969 waiting on job 3
11:38:47.728 waiting on job 4
11:38:49.336 waiting on job 5
11:38:58.812 waiting on job 6
11:39:01.173 waiting on job 7
11:39:11.385 waiting on job 8
11:39:14.522 ----- all   complete ----

result(1) = 62696
result(2) = 64786
result(3) = 66876
result(4) = 68966
result(5) = 62801
result(6) = 64891
result(7) = 66981
result(8) = 69071

------ Task(s) dump -----------------------------------------
tid/names   = |tid00002CC0 fibber tid00000818 helper2|
---------------------------------------------------------------
fibber     tid: tid00002CC0  exists: 1
                 (fibber,cond)        = |cid1| 
                 (fibber,count)       = |4| 
                 (fibber,error)       = || 
                 (fibber,gvar)        = |::result(7)| 
                 (fibber,mutex)       = |mid0| 
                 (fibber,pid)         = |tid00003210| 
                 (fibber,queue)       = || 
                 (fibber,result)      = |66981| 
                 (fibber,script)      = |#Preamble??namespace eval tasks {}?set ::t_pid tid00003210?set ::t_name fibber?set ::t_debu| 
                 (fibber,share)       = || 
                 (fibber,tid)         = |tid00002CC0| 
helper2    tid: tid00000818  exists: 1
                 (helper2,cond)       = |cid1| 
                 (helper2,count)      = |4| 
                 (helper2,error)      = || 
                 (helper2,gvar)       = |::result(8)| 
                 (helper2,mutex)      = |mid0| 
                 (helper2,pid)        = |tid00003210| 
                 (helper2,queue)      = || 
                 (helper2,result)     = |69071| 
                 (helper2,script)     = |#Preamble??namespace eval tasks {}?set ::t_pid tid00003210?set ::t_name helper2?set ::t_deb| 
                 (helper2,share)      = |fibber| 
                 (helper2,tid)        = |tid00000818| 
---------------------------------------------------------------

Here is the debug log output from task fibber that used putz.

sname(share name) = || tname(use)= |fibber| ::t_name(me)= |fibber| 
queue not empty len= 1 contents: {tid00003210 ::result(1) 300000}
11:38:24.177 job 1: worklen= |3|     work= |300000| parentid= tid00003210 globalvar= ::result(1) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |300000| 

sname(share name) = || tname(use)= |fibber| ::t_name(me)= |fibber| 
queue not empty len= 6 contents: {tid00003210 ::result(3) 320000} {tid00003210 ::result(4) 330000} {tid00003210 ::result(5) 300500} {tid00003210 ::result(6) 310500} {tid00003210 ::result(7) 320500} {tid00003210 ::result(8) 330500}
11:38:35.162 job 2: worklen= |3|     work= |320000| parentid= tid00003210 globalvar= ::result(3) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |320000| 

sname(share name) = || tname(use)= |fibber| ::t_name(me)= |fibber| 
queue not empty len= 4 contents: {tid00003210 ::result(5) 300500} {tid00003210 ::result(6) 310500} {tid00003210 ::result(7) 320500} {tid00003210 ::result(8) 330500}
11:38:47.737 job 3: worklen= |3|     work= |300500| parentid= tid00003210 globalvar= ::result(5) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |300500| 

sname(share name) = || tname(use)= |fibber| ::t_name(me)= |fibber| 
queue not empty len= 2 contents: {tid00003210 ::result(7) 320500} {tid00003210 ::result(8) 330500}
11:38:58.816 job 4: worklen= |3|     work= |320500| parentid= tid00003210 globalvar= ::result(7) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |320500| 

sname(share name) = || tname(use)= |fibber| ::t_name(me)= |fibber| 
queue is empty, so wait 0


Here is the output from task helper2.

sname(share name) = |fibber| tname(use)= |fibber| ::t_name(me)= |helper2| 
queue is empty, so wait 0
queue not empty len= 1 contents: {tid00003210 ::result(2) 310000}
11:38:24.249 job 1: worklen= |3|     work= |310000| parentid= tid00003210 globalvar= ::result(2) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |310000| 

sname(share name) = |fibber| tname(use)= |fibber| ::t_name(me)= |helper2| 
queue not empty len= 5 contents: {tid00003210 ::result(4) 330000} {tid00003210 ::result(5) 300500} {tid00003210 ::result(6) 310500} {tid00003210 ::result(7) 320500} {tid00003210 ::result(8) 330500}
11:38:35.973 job 2: worklen= |3|     work= |330000| parentid= tid00003210 globalvar= ::result(4) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |330000| 

sname(share name) = |fibber| tname(use)= |fibber| ::t_name(me)= |helper2| 
queue not empty len= 3 contents: {tid00003210 ::result(6) 310500} {tid00003210 ::result(7) 320500} {tid00003210 ::result(8) 330500}
11:38:49.359 job 3: worklen= |3|     work= |310500| parentid= tid00003210 globalvar= ::result(6) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |310500| 

sname(share name) = |fibber| tname(use)= |fibber| ::t_name(me)= |helper2| 
queue not empty len= 1 contents: {tid00003210 ::result(8) 330500}
11:39:01.199 job 4: worklen= |3|     work= |330500| parentid= tid00003210 globalvar= ::result(8) 
args varname= |->| rest of variables= |number|
i= |0| item= |number| data= |330500| 

sname(share name) = |fibber| tname(use)= |fibber| ::t_name(me)= |helper2| 
queue is empty, so wait 0

 Example to combine with thread::send

This example demonstrates how one can combine lower level thread::send calls with Tasks. The task waits for input, but does not block the event queue forever (it issues an update every 50 ms while waiting for tcall input).

    namespace import tasks::*
    
    Task test -import  {
        twait argv a1 a2
        putz "argv= |$argv| a1= |$a1| a2= |$a2| "
        treturn   " this is a string with a1= |$a1| a2= |$a2| "
    }
    
    wait 1000
    
    thread::send -async $test [list putz "this should open a tk window on windows (or output to stdout on linux)"]
    
    wait 1000
    
    tcall   $test result some input
    puts "result= <$result> "

Here's the output (on windows)

The Tk window has this:

this should open a tk window on windows (or output to stdout on linux)
argv= |some input| a1= |some| a2= |input| 

And the console will have this:

result= < this is a string with a1= |some| a2= |input| >  

 Example to combine with thread::cancel

This example demonstrates using thread::cancel calls with Tasks.

When a cancel arrives as an event, it throws a cancel error. If you intend to use a cancel, you can catch it, or any thing else that does a return to the event loop, such as the wait call in this code. If it cancels before the treturn, the result-var will still be unset. Here's some test code.

    namespace import tasks::*
    ;   proc sum {args} {
        putz "sum up: $args"
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
    Task test  -import {sum} {
        set t_debug 2                       ;# putz (no debug) sent back to console or stdout
        if [catch {
            twait argv                      ;# wait for work and get the args
            putz "started the job"
            wait 2000                       ;# this is a non-busy wait that can get canceled too
            putz "after the wait 2000 in the task"
        } err_code] {
            putz "task got an error = $err_code"
            break     ;# out of our hidden while loop, to exit the task/thread
        }
        set result [sum {*}$argv]   ;# call sum with the input args (note imported proc)
        putz "result= |$result| "
        treturn $result                 ;# send back the results, sets a variable with the result
    }
    
    tcall $test result 5 10 15          ;# show that it works
    puts "result= |$result| "
    
    tcall $test -async result 10 20 30  ;# but this one will end up being cancelled
    wait 1000
    thread::cancel $test
    wait 1000
    tvwait result $test                 ;# since the task may have exited, use this
    
    if [catch {
        puts "result= |$result| "
    } err_code] {
        puts "error outputing the result: $err_code"
    }
    
    wait 5000
    tdump

Here's the output to a windows console:

test       ! started the job
test       ! after the wait 2000 in the task
test       ! sum up: 5 10 15
test       ! result= |30| 
result= |30| 
test       ! started the job
test       ! task got an error = eval canceled
Task: tid0000358C does not exist, while waiting on ::result
error outputing the result: can't read "result": no such variable

------ Task(s) dump -----------------------------------------
tsv::names  = |main tvar tids|
tsv::tids   = |tid0000358C tid00002CE0|
---------------------------------------------------------------
tid/names   = |tid00002CE0 mainthread tid0000358C test|
---------------------------------------------------------------
mainthread tid: tid00002CE0  exists: 1
test       tid: tid0000358C  exists: 0
                 (test,cond)          = |cid1| 
                 (test,count)         = |2| 
                 (test,error)         = || 
                 (test,gvar)          = |::result| 
                 (test,mutex)         = |mid0| 
                 (test,pid)           = |tid00002CE0| 
                 (test,queue)         = || 
                 (test,result)        = |30| 
                 (test,script)        = |#Preamble??namespace eval tasks {}?set ::t_pid tid00002CE0?set ::t_name test?set ::t_debug | 
                 (test,share)         = || 
                 (test,tid)           = |tid0000358C| 
---------------------------------------------------------------

 Example producer/consumer with a buffer task

Using tasks with the N-producer/N-consumer single queue problem.

Here we have several producer and consumer tasks which communicate through the intermediary of a buffer task.

The bounded buffer size queue is in buffer's local (global) memory. All of the prod/cons tasks calls the buffer task requesting some data off the queue, or to put some data on the queue (fifo). These requests are also queued fifo, as with any task.

Buffer returns 0/1 as to the success of a request, which depends on the state of the queue, full, empty, or in between, and which operation (prod or cons) is desired.

The included variable name, is used to signal back to the caller task when the queue status has changed. All waiting tasks are signaled and they will then resume from waiting for the signal.

This example runs best on windows, where all the tasks have a window where one can pause any or all of them. On linux, there will still be a bit of a gui, but most of the output will be to stdout. You can pipe through grep however.

    package require Tk
    namespace import tasks::*
    
    proc addwaiter {id type var } {
        lappend ::waiters($type) [list $id $var]
    }
    
    proc signalwaiters {type} {
        while { [llength $::waiters($type)] > 0 } {                  ;# signal all waiters of same "type"
            lassign [lindex $::waiters($type) 0] id varname          ;# task id an the varname to wait on
            putz "signal $type id= |$id| [format %-13s [tname $id]] varname= |$varname| "
            thread::send -async $id [list set ::$varname $type/666]  ;# set the waiters wait var, that resumes him
            set ::waiters($type) [lrange $::waiters($type) 1 end]    ;# remove the first waiter from queue
        }
    }
    
    proc dumpq {} {
        putz ""
        foreach type {produce consume} {
            putz "--- $type --- <$::waiters($type)>" green
            foreach item $::waiters($type) {
                lassign $item id var
                putz "id= |$id| [format %-15s [tname $id] ] var= |$var| "
            }
        }
        putz "--- queue   --- <$::queue>\n" green
    }
    
    
#   
#   ########################## buffer ###############################################
    
    Task buffer -import {addwaiter signalwaiters dumpq} {
        
        twait -> qsize          ;# first time called, we just get our max queue size
        treturn ok              ;#
        
        putz "Buffer Queue max size= |$qsize| "
        catch {wm geom . 1109x495+-5+6}
        
        set queue {}            ;# this is our queue of data produced and consumed
        
        set waiters(consume) {} ;# these are the lists of consumers who are blocked
        set waiters(produce) {} ;# and the producers
        
        package require Tk
        toplevel .top           ;# our queue text entry with the items and the length
        entry   .top.queue    -text "queue"   -textvariable ::queue        -font {courier 18} -width 60
        entry   .top.queue2   -text "length"  -textvariable ::queuesize    -font {courier 18} -width 3
        
        ttk::labelframe .top.delay    -text "Delay"
        ttk::spinbox .top.delay.sb    -from 0 -to 1000 -increment 25    -textvariable ::delay_buffer -width 5 -font {courier 18}
        
        pack    .top.delay                    -side right
        pack    .top.queue      -expand true  -side right -fill both
        pack    .top.queue2     -expand true  -side left  -fill both
        pack    .top.delay.sb   -expand true              -fill both
        
        wm geom .top 1255x62+374+859
        
        wm attributes .top  -topmost 1
        set ::delay_buffer 0
        while { 1 } {
            wait $::delay_buffer
            twait -> type data var                      ;# called with real requests, if type is consume, data is just a place holder
            
            set pid [tset buffer pid]                   ;# get our parent (caller) id so we can signal if needed
            putz "$pid [format %-14s [tname $pid] ] type= |$type| data= |$data| var= |$var| " green
            set ::queuesize [llength $queue]            ;# for our queue size text entry
            
            if       { $type eq "produce" } {
                
                putz "   produce:  len/max= [llength $queue] / $qsize   <$queue> before insert" red
                
                if { [llength $queue] >= $qsize } {     ;# is there room for another
                    addwaiter $pid produce $var         ;# no put this guy on our producer waiting list
                    treturn 0                           ;# return 0 if the queue is full
                } else {
                    lappend queue $data                 ;# add data to the end of the queue (fifo)
                    signalwaiters consume               ;# signal all waiting consumers that there's new data available
                    treturn 1                           ;# return 1 when data added to queue sucessfully
                }
                
            } elseif { $type eq "consume" } {
                
                putz "   consume:  len/max= [llength $queue] / $qsize   <$queue> before consume" red
                
                if { [llength $queue]  == 0} {          ;# is there anything to consume
                    addwaiter $pid consume $var         ;# no put this guy on our consumer waiting list
                    treturn [list 0 0]                  ;# {code data} - data is just a place holder here
                } else {
                    set data    [lindex $queue 0]       ;# get the next one off the data queue
                    set queue   [lrange $queue 1 end]   ;# now remove that one
                    putz "   remove <$data> queue now:    <$queue> "
                    signalwaiters produce               ;# signal all producers there's room now
                    treturn [list 1 $data]              ;# return code 1, and some data
                }
                
            } elseif { $type eq "dump" } {
                
                dumpq
                wait 3000 ;# time to look at the dump
                
            } else {
                error "bad type"
            }
        }
    }
    
#   ########################### producer ####################################
    set pscript {
        twait -> bid delay geom first   ;# one time we get called with the buffer task id
        treturn ok
        
        putz "producer init"
        catch {wm geom . $geom}
        set data [expr {   $first - 1   }]
        while { 1 } {
            putz "produce during [comma $delay] miliseconds" green
            wait $delay ;#simulate time to produce
            tpause_check
            incr data   ;# this is what we produce, just keep incr'ing it
            set try 0   ;# how many tries before we can give this successfully to the buffer task
            while { 1 } {
                unset -nocomplain                   ::prod_full_var ;# in order to wait on a var, we must unset it first
                tcall $bid rvar       produce $data ::prod_full_var ;# sync call to the buffer, with our signal var as a parm
                incr try                                            ;# with multiple producers, we all get a shot at the queue
                if { $rvar } {                                      ;# rvar is 1/0 for sucess or no room in buffer
                    putz "fits   on try number: $try    data we inserted = |$data|" red
                    break                                           ;# leave this loop and go back to producing a new data item
                } else {
                    putz "no-fit on try number: $try    try again, tvwait on ::prod_full_var"
                    tvwait ::prod_full_var      ;# the buffer task will save prod_full_var and signal us when room in queue
                }
            }
        }
        
    }
    Task producer  -import $pscript
    Task producer2 -import $pscript
    
#   ################################# consumer ####################################################
    
    set cscript {
        twait -> bid delay1 modulo delay2  geom ;# buffer task/thread id, 2 delays with a modulo on delay2
        treturn ok                              ;# we return only to resume the callback that started us going
        
        putz "consumer init"
        catch {wm geom . $geom}
        while { 1 } {
            set try 0
            while { 1 } {
                tpause_check
                
                unset -nocomplain                         ::cons_empty_var
                tcall   $bid            rvar  consume 0   ::cons_empty_var   ;# returns list of {code data} code 0/1
                
                lassign $::rvar   code        data
                if { $code  } {
                    break           ;# the data was returned from the queue
                } else {            ;# the queue was empty, so we need to wait for a signal after a producer queues some data
                    putz  "Queue empty, wait for a signal try: [incr try]" red
                    tvwait ::cons_empty_var
                }
            }
            
            putz "Got one $data" red
            wait $delay1
            if { [incr counter] % $modulo == 0 } {
                catch {wm title . "delaying $delay2"}
                wait $delay2
                catch {wm title . "continue"}
            }
        }
    }
    Task consumer  -import  $cscript
    Task consumer2 -import  $cscript
    Task consumer3 -import  $cscript
#    Task consumer4 -import  $cscript
    
    
#   ################################# consume 1 button callback ####################################################
    
    proc consume1 {args} {
        incr ::level
        if { $::level > 1 } {
#           putz "busy in the last one, level = $::level so ignoring this one"
        } else {
            while { 1 } {
                unset -nocomplain                        ::cons_empty_var
                tcall $::buffer rvar     consume 0 ::cons_empty_var
                lassign $::rvar code data
                putz "consume reequest [format %-15s |$::rvar| ] code= |$code| data= |$data| "
                if { $code  } {
                    break
                } else {
                    tvwait cons_empty_var
                }
            }
            putz "Got one $data" red
        }
        incr ::level -1
        
    }
    
#   ##################################### some gui buttons #######################################################
    
    button  .consume    -text "consume" -command    consume1             ;# do just 1 consume, report to console
    button  .dump       -text "dump"    -command    dump                 ;# dump the queues in the buffer task
    
    pack    .consume    -fill both      -expand     true
    pack    .dump       -fill both      -expand     true
    
    wm geom . 369x105+1+857
    
#   ###################################### start up our tasks ####################################################
    
    tcall $::buffer    <-   10                                       ;# send buffer his max size
    
    tcall $::producer  <-  $::buffer 199  792x222+1112+7   0         ;# buffer id, delay to produce, window geom, starting data value
    tcall $::producer2 <-  $::buffer 100  792x229+1119+272 10000     ;# buffer id, delay to produce, window geom start at 10k
    
    after 5000  {tcall  $::consumer   <- $::buffer 300 10 2000 517x220+-6+543}    ;# delay starting our consumers
    after 15000 {tcall  $::consumer2  <- $::buffer 25  30 3000 531x221+517+544}   ;# delay, modulo, delay2, geom
    after 17000 {tcall  $::consumer3  <- $::buffer 300 10 2000 521x220+1055+545}
    
    tdump                                                                ;# threads dump to console
    
    proc dump {} {
        tcall $::buffer -async xxxx dump                                 ;# send to buffer ask for a queue dump
    }
    
    wait 2000
    dump

 using tgroup the task builder

The tgroup procedure is a quick way to launch a group of tasks, sharing a single queue, that can be run given a set of arglists. They will run in parallel if possible.

This example starts 4 tasks/threads that compute the sum of their arglist's plus a busy wait we can monitor for cpu time. The first argument to each tgroup call is the tasks group name which is used to create task names: group0, group1/group0, group2/group0, .... for a total of N tasks, as given by the -tasks N option. If it's negative, then use abs(N) and set a flag for traces. The arguments that follow this option are identical to those in the Task procedure which follow the taskname argument.

The -call option calls the tasks for each arglist that follows. If there are fewer arglists than tasks, the list of arglists will repeat at the first one until all N of the tasks are given work. They are all run -async. If the trace flag was set, a trace is put on each one, using the group name as a callback procedure. See the 3rd example below that uses the trace option.

The -wait all option will wait for all the work to complete. There is an option in the works, -wait one but it is a TBD.

The group name is also used to create a global array with the args and results, plus other info.

    namespace import tasks::*
;   proc sum {args} {
        xwait 2000 ;# simulate 2 seconds of heavy compute
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
    
    tgroup summer -tasks 4  -import {sum} {   ;# create 4 tasks using the same script
            twait argv
            treturn [sum {*}$argv]
    }
    
    tgroup summer -call {1 2 3} {4 5 6} {7 8 9} ;# when fewer arglists, repeat at front
    tgroup summer -wait all
    
    parray summer args*
    puts ""
    parray summer rvar*

The result is:

summer(args,0) = 1 2 3
summer(args,1) = 4 5 6
summer(args,2) = 7 8 9
summer(args,3) = 1 2 3

summer(rvar,0) = 6
summer(rvar,1) = 15
summer(rvar,2) = 24
summer(rvar,3) = 6

The above example is handy when you have N jobs and want to run exactly N tasks.

However, suppose you have more jobs than tasks and you only want to run 1 task per cpu core (or cpu thread with hyperthreading).

In this example, we use the tgroup -tasks 4 command to setup 4 tasks. Then we tcall each of the 10 jobs -async so they will be placed on the single queue. We tcall the boss (first one) task, which was named summer0 and so is used as $summer0. Then we wait on all of them.

    namespace import tasks::*
;   proc sum {args} {
        xwait 2000 ;# simulate 2 seconds of heavy compute
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
    
    tgroup summer -tasks 4  -import {sum} { ;# generate 1 per core
            twait argv
            treturn [sum {*}$argv]
    }
    
    set njobs 10
    for {set m 0} {$m < $njobs} {incr m} {
        tcall $summer0 -async rvar($m) $m 1 2 3 ;# add up m + 1 + 2 +3, result to rvar($m)
    }
    for {set m 0} {$m < $njobs} {incr m} {
        tvwait  rvar($m) 
    }
    
    parray rvar

And here are the results, with the index to rvar being the value computed (m + 6 for each m 0..9) and a trimmed tdump showing the count.

rvar(0) = 6
rvar(1) = 7
rvar(2) = 8
rvar(3) = 9
rvar(4) = 10
rvar(5) = 11
rvar(6) = 12
rvar(7) = 13
rvar(8) = 14
rvar(9) = 15

------ Task(s) dump -----------------------------------------
mainthread tid: tid00002B14  exists: 1
summer0    tid: tid00002DE8  exists: 1
                 (summer0,count)      = |3| 
summer1    tid: tid000014B8  exists: 1
                 (summer1,count)      = |3| 
summer2    tid: tid00002FF4  exists: 1
                 (summer2,count)      = |2| 
summer3    tid: tid000023C8  exists: 1
                 (summer3,count)      = |2| 
---------------------------------------------------------------

Here's an example where we use the trace, by using a -N for number of tasks.

    namespace import tasks::*
;   proc sum {args} {
        lassign $args first
        xwait [expr {   200 * $first   }]   ;# use first number to determine busy wait time
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
;   proc Time {} {
        set ms [clock milliseconds]
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        return [string range [clock format $secs] 11 18].$ms
    }
    puts "[Time] starting"
#####################################################################

    tgroup summer -tasks -8  -import {sum} { ;# setup 8 tasks, set trace flag 
        twait argv
        treturn [sum {*}$argv]
    }
        
;   proc summer {args} {                     ;# trace callback at each task completion
        lassign $args aname element op
        set value [set ${aname}($element)]
        puts "[Time] [format %-26s |$args| ] aname= |$aname| element= [format %-10s |$element| ] op= |$op| value= |$value| "
    }
    
    tgroup summer -call {1 2 3} {4 5 6} {7 8 9} {10 11 12} ;# when fewer arglists, repeat at front
    tgroup summer -wait all
    
    puts ""
    parray summer args*
    puts ""
    parray summer rvar*

# output:    
#    16:33:02.303 starting
#    16:33:03.006 |::::summer rvar,4 write|  aname= |::::summer| element= |rvar,4|   op= |write| value= |6| 
#    16:33:03.042 |::::summer rvar,0 write|  aname= |::::summer| element= |rvar,0|   op= |write| value= |6| 
#    16:33:04.186 |::::summer rvar,5 write|  aname= |::::summer| element= |rvar,5|   op= |write| value= |15| 
#    16:33:04.226 |::::summer rvar,1 write|  aname= |::::summer| element= |rvar,1|   op= |write| value= |15| 
#    16:33:05.033 |::::summer rvar,2 write|  aname= |::::summer| element= |rvar,2|   op= |write| value= |24| 
#    16:33:05.172 |::::summer rvar,6 write|  aname= |::::summer| element= |rvar,6|   op= |write| value= |24| 
#    16:33:05.520 |::::summer rvar,7 write|  aname= |::::summer| element= |rvar,7|   op= |write| value= |33| 
#    16:33:05.824 |::::summer rvar,3 write|  aname= |::::summer| element= |rvar,3|   op= |write| value= |33| 
#    
#    summer(args,0) = 1 2 3
#    summer(args,1) = 4 5 6
#    summer(args,2) = 7 8 9
#    summer(args,3) = 10 11 12
#    summer(args,4) = 1 2 3
#    summer(args,5) = 4 5 6
#    summer(args,6) = 7 8 9
#    summer(args,7) = 10 11 12
#    
#    summer(rvar,0) = 6
#    summer(rvar,1) = 15
#    summer(rvar,2) = 24
#    summer(rvar,3) = 33
#    summer(rvar,4) = 6
#    summer(rvar,5) = 15
#    summer(rvar,6) = 24
#    summer(rvar,7) = 33

Please place any user comments here.