# By George Peter Staplin -- Dec 19, 2005 - Jan 5, 2006
# This implements a task scheduler using [after].
# It supports (so far) 2 scheduling algorithms -- alternating and sequential.
# This is version 4 of a prototype.
array set ::tasks {}
set ::task_counter 0
set ::run_queue [list]
proc assert body {
if {![uplevel 1 $body]} {
return -code error "assertion failed: $body"
}
}
proc task {start iterator end data} {
global tasks task_counter
incr task_counter
while {[info exists tasks($task_counter)]} {
incr task_counter
}
lappend tasks(list) $task_counter
set tasks($task_counter) $task_counter
#
# The valid states are NOT_RUNNING, RUNNING, DONE.
#
set tasks($task_counter,state) NOT_RUNNING
set tasks($task_counter,start) $start
set tasks($task_counter,iterator) $iterator
set tasks($task_counter,end) $end
set tasks($task_counter,data) $data
return $task_counter
}
proc reset.tasks {} {
global tasks
foreach t $tasks(list) {
set tasks($t,state) NOT_RUNNING
}
}
proc run.tasks algorithm {
global tasks
global run_queue
lappend run_queue $algorithm
if {[llength $run_queue] > 1} {
#
# We will handle this after the current task queue finishes.
#
return
}
switch -- $algorithm {
sequential - alternating {}
default {
return -code error "invalid scheduler algorithm"
}
}
after 1 start.task $tasks([lindex $tasks(list) 0]) $algorithm
}
proc possibly.start.task task {
global tasks
#
# This is used to prevent starting a task multiple times.
#
if {"RUNNING" ne $tasks($task,state)} {
set tasks($task,state) RUNNING
$tasks($task,start) $tasks($task,data)
}
}
proc next.run.queue {} {
#
# The current queue was emptied.
# Transition to the next queue if possible.
#
global run_queue tasks
set run_queue [lrange $run_queue 1 end]
if {![llength $run_queue]} {
return
}
reset.tasks
set task [lindex $tasks(list) 0]
possibly.start.task $task
after 1 [list start.task $tasks($task) [lindex $run_queue 0]]
}
proc find.next.task.sequential {task algorithm end queue_var} {
if {!$end} {
return $task
}
global tasks
upvar $queue_var queue
#
# Remove the task from the active queue.
#
set i [lsearch -exact $queue $task]
set queue [lreplace $queue $i $i]
if {![llength $queue]} {
next.run.queue
return ""
}
#
# Start the next task
#
set task [lindex $queue $i]
possibly.start.task $task
return $task
}
proc find.next.task.alternating {task algorithm end queue_var} {
global tasks
upvar $queue_var queue
set i [lsearch -exact $queue $task]
assert {expr {$i >= 0}}
if {$end} {
set queue [lreplace $queue $i $i]
if {![llength $queue]} {
next.run.queue
return ""
}
} else {
incr i
}
if {$i >= [llength $queue]} {
set i 0
}
#puts "I:$i QUEUE LENGTH:[llength $queue]"
set task [lindex $queue $i]
possibly.start.task $task
return $task
}
proc find.next.task {task algorithm end queue_var} {
upvar $queue_var queue
#
# WARNING: This returns a result.
#
find.next.task.$algorithm $task $algorithm $end queue
}
proc run.iterator {task algorithm queue} {
global tasks
set end 0
#
# Call the iterator with the data.
#
if {![$tasks($task,iterator) $tasks($task,data)]} {
#
# We are done with this task.
#
$tasks($task,end) $tasks($task,data)
set tasks($task,state) DONE
set end 1
}
#
# Find the next available task.
#
set task [find.next.task $task $algorithm $end queue]
if {"" eq $task} {
#
# No more tasks.
#
return
}
after 1 [list run.iterator $task $algorithm $queue]
}
proc start.task {task algorithm} {
global tasks
if {"RUNNING" ne $tasks($task,state)} {
$tasks($task,start) $tasks($task,data)
set tasks($task,state) RUNNING
}
run.iterator [lindex $tasks(list) 0] $algorithm $tasks(list)
}
#### TESTS ####
#
# This implements a greeting pattern that repeats 100 times.
# The first message is "well, hello" the last is "goodbye"
#
proc greeting.start data {
set ::counter 0
puts "well, hello"
}
proc greeting.iterator data {
puts hello
incr ::counter
if {$::counter > 100} {
#end task
return 0
}
#continue
return 1
}
proc greeting.end data {
puts goodbye
}
#
# This implements a timer pattern that operates for as many seconds
# as the data member of the task array passes to the initial timer.start
# procedure. The data member is set at task creation time.
#
proc timer.start data {
set ::timer_end [expr {wide([clock seconds]) + $data}]
puts "::timer_end $::timer_end"
}
proc timer.iterator data {
puts "timer iterator: [clock seconds]"
if {[clock seconds] >= $::timer_end} {
#end task
return 0
}
#continue
return 1
}
proc timer.end data {
puts "BINGO!"
}
task greeting.start greeting.iterator greeting.end {}
task timer.start timer.iterator timer.end 2
foreach t [list sequential alternating sequential alternating alternating sequential] {
run.tasks $t
}
catch {vwait forever}See also: Concurrency concepts
