Paced Loop Framework
LWS 18 May 2022 - Several times over the years I have found myself re-creating a paced loop framework for my code to execute in. I spent a bit of time working this out as a package that serves my purposes and I thought I would share with the community. Use at your own risk, of course, and feel free to provide feedback.
This features configurable tick time (in milliseconds or 'freerun' to execute as fast as your machine can), callbacks for detected timing problems, code execution errors, and for when the loop is stopped, etc. Statistics are gathered for profiling. All configurations are accessible via variables, though use of the ensemble command is likely sufficient for most purposes.
In its simplest form, you can do the following
set pl [PacedLoop::pacedloop -ticktime 1000 -loopcode {puts stdout "Nice!"} -countdown 50]
$pl start
vwait ALWAYS; # Only for tclsh to enter the event loop.which will display "Nice!" about every 1 second for a count of 50 times. Leaving out the last parameter will continue execution of the loop's code forever.
Next is a slightly more interesting demonstration, which is still not as feature-rich as it could be. Here, a fade-in of a canvas text item is implemented every 100 milliseconds. The current, actual paced loop time (the "tick time") is shown in the upper left of the canvas, and the count of passes through the loop (essentially an animation video frame number in this case) in the upper right. This creates the gif, above, when using the technique outlined by our friends at Creating an animated display.
package require PacedLoop; # Or source it!
canvas .c -width 150 -height 150 -background black
pack .c
set textitem [.c create text 75 75 -text "LWS Presents\n\nPaced Loop\nTCL Framework" \
-fill #000000 -justify center]
set tickitem [.c create text 0 0 -anchor nw -fill green]
set frameitem [.c create text 150 0 -anchor ne -fill green]
set greylevel 0
proc action {} {
global pl greylevel
global textitem tickitem frameitem
incr greylevel 5
if {$greylevel > 255} {
set greylevel 0
}
set cstring [string repeat [format %02x $greylevel] 3]
.c itemconfigure $textitem -fill #$cstring
.c itemconfigure $tickitem -text "[$pl cget -thisticktime] uS"
.c itemconfigure $frameitem -text "frame [$pl cget -loopcount]"
}
set pl [PacedLoop::pacedloop -loopcode action -ticktime 100]
tkwait visibility .c
$pl startI think you can do some quite interesting things with this, particularly since you can reconfigure the loop's configuration as you go.
Here is the code to implement the PacedLoop package. I tend to be long-winded with comments, talking to my future, forgetful self, but it also serves as the documentation at the current time.
# This is a package intended for the organized handling of code that
# follows a "Paced Loop" kind of framework. More than one paced loop
# is possible, though scheduling via TCL's there there is apparently
# some timing cross-talk between them (likely associated with the
# details of how TCL's 'after' command is implemented). An ensemble
# command is created for each paced loop, and has the same name as
# the handle returned during creation.
#
# USE THIS AT YOUR OWN RISK: there are no warranties, expressed or
# implied. This should never be used for anything remotely important.
# TCL/Tk is itself not real-time in nature, Failure is quite likely,
# in fact: writing this was a learning exercise. Using more than one
# loop is likely never needed, but I have burned myself in the past by
# not anticipating growth.
#
# Though some timing errors may be detected, there is no provision for
# *prevention* of errors (beyond what the programmer may provide).
#
# Design Notes:
# 1. An ensemble command approach is used.
# My take on what our friends at
# https://wiki.tcl-lang.org/page/namespace+ensemble
# seem to indicate is that a new namespace holding the ensemble
# using copies of routines should be created, thus allowing the
# ensemble to be deleted when the program is done with it. Though
# I hear this advice, I have instead opted to simply allow a paced
# loop ensemble go defunct, returning errors if used after it has
# been deleted. This is somewhat in-line with the fact that only
# one loop should really be used, anyway, though you can
# experiment with more here.
# 2. All callbacks have the ensemble command (the PacedLoop handle)
# appended as the first argument.
# 3. If loop code executes with an error, the loop is first stopped
# and then an optional user-defined 'looperrorcallback' is executed.
# 4. If a loop is stopped (for whatever reason, including that
# outlined in (2), above) a 'stoppedcallback' is executed, if
# defined.
# 5. A single callback, 'timingcallback', is associated with the
# detection of timing-related issues. A second argument is
# provided to this callback: the problem condition that caused
# the callback to be executed. This can be one of:
# 'jitter': the pacing of the loop was not within tolerance
# (configurable via 'failjitterratio').
# i.e. the tick time/loop pacing is irregular
# 'exectime': over-threshold of permitted execution time,
# also known as an over-run (configurable via
# 'failexecratio'). i.e. the execution time
# of the loop code has taken too long.
# 'scheduling': indicates that the code was executed
# prior to completion of the last run. This
# is another type of over-run that will show
# itself only if the user's code enters the event
# loop, including the use of 'update'.
# a) The paced loop is stopped only for the 'scheduling' issue,
# above. The other two ('jitter' and 'exectime') will, by
# default leave the code running.
# b) To discontinue operation of the loop, execute
# $pl stop
# where $pl is the handle of the paced loop, passed as the
# first argument to the callback. This then should be followed
# by something like
# return -code return
# to break execution and prevent future scheduling.
# c) If an 'exectime' issue is detected and that also results in
# sufficient tick-time jitter, then the callback will run,
# once for each reason.
# d) During execution of this callback, statistics may not have
# been fully updated for the current pass of the loop:
# 'jitter': thisticktime is valid (if past the first tick)
# 'exectime': all statistics should be available
# 'scheduling': thisticktime is valid (if past the first tick)
# ('thisticktime' is undefined until a full tick has passed
# coming out of a paused/initialized sate).
# 6. Though more than one loop is possible, timing is at least
# somewhat interlinked due the underlying operation of the
# 'after' command. Someone may be able to explain more.
# Strictly speaking, you only want one loop, anyway.
# 7. Further documentation is provided via lists, below, and
# (of course) via source comments.
#
# Ideas for the future:
# - provision for recording state to "replay" the loop. Though this
# would be neat for game-type applications, it would also be
# interesting for diagnostics of failed loops, if applicable. One
# could likely do this better as part of whatever uses this
# framework, though. However, a list of loop variables to
# track (and insertion of loop code to do that) may do the trick.
package require Tcl 8.5
# I find I like to rename packages, particularly on first passes.
# This presents a bit of a danger, though since variable NS may
# collide with other variables.
set NS PacedLoop
package provide $NS 0.0; # See also VERSION variable, below.
######################################################################
namespace eval $NS {
namespace export pacedloop help
# Routines mapped to lower-case versions of an ensemble command
# associated the return of pacedloop, above: Cget, ClearStats,
# Configure, Delete, GetHandles, GetVarName, Initialize,
# Start, Stop
# Non-public routines:
# IsHandleValid, Loop
# Below, note the anomaly of the ticktime in milliseconds, but
# time-based statistics are in integer microseconds.
# Set of the options that are used, corresponding to the
# handle,option index of the PL array. Each list is
# optionname optionglobpattern permissions
# description1 [description2..]
# Descriptions are used solely for documentation purposes at this
# time. The order here is an attempt to show what parameters are
# related.
set OPTIONLIST {
{ticktime tick* rw
"paced loop (tick) time in milliseconds (or 'freerun')"}
{loopcode loopcod* rw
"loop code, executed at the top (global) level"}
{looperrorcallback looperr* rw
"callback procedure to execute on error in loop code"}
{stoppedcallback stop* rw
"callback procedure to execute when the loop is stopped (paused)"
"for whatever reason; handle is appended as a parameter"}
{timingcallback tim* rw
"callback procedure to run when detected loop timing is off a"
"problem; two arguments are to be expected by the handler: the"
"loop handle and the 'problemtype' which can be 'jitter',"
"'exectime', or 'scheduling'"}
{initcode init* rw
"initialization code, executed at the top (global) level"}
{countdown count* rw
"value that, if not empty, specifies the number of times"
"to run the loop and then stop"}
{failexecratio faile* rw
"execution-to-ticktime ratio (0.0-1.0) over which is"
"considered a paced loop failure: defaults to 0.7,"
"meaning if execution time exceeds 70% of the tick"
"time, it is a failure"}
{failjitterratio failj* rw
"fraction of loop time beyond which is considered"
"a jitter failure: defaults to 0.02, meaning unacceptable"
"jitter is identified if the tick time is outside 98-102%"
"of the nominal tick time"}
{loopcount loopcou* r
"number of passes through the loop since creation"}
{averageexectime averagee* r
"average time spent executing (in microseconds)"}
{minexectime mine* r
"minimum time (microseconds) loop code has taken to execute"}
{maxexectime maxe* r
"maximum time (microseconds) loop code has taken to execute"}
{sumexectime sume* r
"sum of execution time in microseconds"}
{thisexectime thise* r
"duration (in microseconds) of the last loop code's execution"}
{exectoidleratio exec* r
"average idle ratio (exec to ticktime)"}
{averageticktime averaget* r
"average tick time in microseconds"}
{minticktime mint* r
"minimum time (microseconds) measured between ticks"}
{maxticktime maxt* r
"maximum time (microseconds) measured between ticks"}
{sumticktime sumt* r
"sum of time of the paced loop tick times in microseconds"}
{overruncount overrunco* r
"count of number of times the paced loop has over-run due"
"to the execution time taking too long (and associated with"
"the 'exectime' type of the timing error callback)"
"configured via 'failexecratio'."}
{jittercount jitterco* r
"count of number of times the loop's pacing has deviated"
"from the threshold established by 'failjitterratio'"
"(and associated with the 'jitter' type of the timing"
"error callback"}
{thisticktime thist* r
"duration (in microseconds) of the last tick interval; this"
"is undefined before a full tick interval has passed coming"
"out of a paused or initialized state"}
{pausecount pause* r
"count of the number of times the loop has been stopped;"
"used in statistic calculations"}
{state state r
"paced loop state: uninitialized, initialized, stopped, running"}
{afterid after* r
"id of the command for the next execution of the loop"}
}
# States of the paced loop framework. Transitions between these
# states are implemented via initialize, stop, start commands.
# This list is just for documentation purposes at this time.
set STATELIST {
{uninitialized r "new loop item: initialization code has not yet run"}
{initialized r "initialization code has been run: ready to run loop"}
{running r "paced loop is running"}
{stopped r "execution of the loop is stopped/paused"}
}
# This is an array that contains information about the paced loop
# configuration.
variable PL
# The indices are handle,option where handle is the unique
# identifier for the paced loop, and the options are outlined in
# the OPTIONLIST, above. There are few (internal) additions, as
# follows:
# handle,inloop - flag used to detect (scheduling) over-runs
# handle,lasttickstart - time in microseconds of last tick start
# A list of current paced loop handles.
variable HANDLES
set HANDLES {}
# Count used during unique handle generation.
variable HANDLECOUNT
set HANDLECOUNT 0
variable VERSION
set VERSION 0.0
}
######################################################################
proc ${NS}::pacedloop { args } {
# Returns a new PacedLoop handle to a structure that will be
# initialized with initcode and run with loopcode.
variable HANDLECOUNT
variable HANDLES
variable PL
set handle "pl$HANDLECOUNT"
# Create a unique handle number for the next pass.
incr HANDLECOUNT 1
# Start in the uninitialized sate.
set PL($handle,state) uninitialized
# Establish a reasonable initial configuration. See the
# OPTIONLIST, above, for documentation.
set PL($handle,ticktime) 100
set PL($handle,loopcount) 0
set PL($handle,looperrorcallback) {}
set PL($handle,stoppedcallback) {}
set PL($handle,timingcallback) {}
set PL($handle,afterid) {}
set PL($handle,inloop) 0
set PL($handle,lasttickstart) 0
set PL($handle,initcode) {}
set PL($handle,loopcode) {}
set PL($handle,failexecratio) 0.7
set PL($handle,failjitterratio) 0.02
set PL($handle,countdown) {}
# Save the handle.
lappend HANDLES $handle
# Establish defaults of other variables that fall into a "statistics"
# kind of category.
ClearStats $handle
# Now pass the args (if any) to the configuration command to update
# from these defaults.
Configure $handle {*}$args
# Create the handle command that will be an ensemble command.
set cmdmap [list cget [list Cget $handle] \
destroy [list Delete $handle] \
clearstats [list ClearStats $handle] \
configure [list Configure $handle] \
gethandles [list GetHandles $handle] \
getvarname [list GetVarName $handle] \
initialize [list Initialize $handle] \
start [list Start $handle] \
stop [list Stop $handle]]
namespace ensemble create -command $handle -map $cmdmap
# Return the handle.
return [namespace current]::$handle
}
######################################################################
proc ${NS}::help { option } {
# Provides help with respect to the name of a configuration
# option.
variable OPTIONLIST
# Inefficient, but concise code. I do this several times in this
# package, and I do note that it allows malformed options to be
# specified. For example, -ticktime has a glob pattern of
# tick* and so tickTYPO will still work. Small potatoes, I think.
foreach optitem $OPTIONLIST {
set hlist [lassign $optitem fulloption gpattern permissions]
if {[string match $gpattern [string trimleft $option "-"]]} {
return "[join $hlist] ($permissions)"
}
}
return -code error "unknown option, $option"
}
######################################################################
# Routines used via 'namespace ensemble'.
######################################################################
proc ${NS}::Cget { handle option } {
# Return the value for one option of the paced loop configuration.
variable PL
variable OPTIONLIST
if {![IsHandleValid $handle]} {
return -code error "handle does not exist"
}
# This is somewhat inefficient, but results in short code.
foreach optitem $OPTIONLIST {
set descrlist [lassign $optitem fulloption gpattern permissions]
if {[string match $gpattern [string trimleft $option "-"]]} {
return $PL($handle,$fulloption)
}
}
return -code error "unknown option '$option'"
}
######################################################################
proc ${NS}::ClearStats { handle } {
# Establishes variables/options associated with statistics to a
# starting values.
variable PL
if {![IsHandleValid $handle]} {
return -code error "handle does not exist"
}
set PL($handle,minticktime) inf
set PL($handle,maxticktime) 0
set PL($handle,sumticktime) 0
set PL($handle,averageticktime) inf
set PL($handle,minexectime) inf
set PL($handle,maxexectime) 0
set PL($handle,averageexectime) inf
set PL($handle,sumexectime) 0
set PL($handle,exectoidleratio) 0.0
set PL($handle,overruncount) 0
set PL($handle,jittercount) 0
set PL($handle,thisticktime) 0
set PL($handle,thisexectime) 0
set PL($handle,pausecount) 0
set PL($handle,loopcount) 0
# This flag in a way indicates that the stats are fresh: it
# prevents averages from being calculated from invalid information
# among other things.
set PL($handle,lasttickstart) 0
return -code ok
}
######################################################################
proc ${NS}::Configure { handle args } {
# Returns full current configuration with no args provided.
# Returns a specific option (via cget) with one argument.
# Sets (writable) configuration values if provided
# with more than one argument (which are then assumed to be in
# pairs).
variable PL
variable OPTIONLIST
if {![IsHandleValid $handle]} {
return -code error "handle does not exist"
}
set argc [llength $args]
# If no arguments are provided, return a list of the options
# and current values.
if {$argc == 0} {
set rlist {}
foreach olistitem $OPTIONLIST {
set descrlist [lassign $olistitem option pattern permissions]
lappend rlist [list "-$option" $PL($handle,$option)]
}
return $rlist
}
# If a single argument is provided, then return the value
# via call to Cget.
if {$argc == 1} {
return [Cget $handle [lindex $args 0]]
}
# If two or more options are provided, they are supposed to be in
# option, value pairs with the intention of setting the option
# the value.
if {$argc % 2} {
return -code error \
"arguments to configure must be in option,value pairs"
}
# I could possibly spend some time to make OPTIONLIST more
# comprehensive to simplify this code, but here I am going for
# what I see as the simplest of approaches: using that list for
# some, but not all things.
# Process option, value pairs, if there are any.
foreach {option value} $args {
switch -glob -- [string trimleft $option "-"] {
tick* {
# ticktime
# Parameter checking: either an integer number of
# milliseconds or "freerun" as a special value.
if {[string match free* $value]} {
set PL($handle,ticktime) freerun
} elseif {[string is integer $value]} {
if {$value > 0} {
set PL($handle,ticktime) $value
} else {
return -code error \
"ticktime value must be a positive integer"
}
} else {
return -code error \
"ticktime value must be a positive integer or 'freerun'"
}
}
count* {
# countdown: either empty or an integer greater than 0
if {$value eq {}} {
set PL($handle,countdown) {}
} else {
if {[string is integer $value]} {
if {$value > 0} {
set PL($handle,countdown) $value
} else {
return -code error \
"countdown must be empty or an integer greater than 0"
}
} else {
return -code error \
"countdown must be empty or an integer greater than 0"
}
}
}
init* -
loopcod* {
# These are the code-type R/W options.
set idx [lsearch -index 0 $OPTIONLIST [string trimleft $option -]]
if {$idx == -1} {
return -code error "unknown option '$option'"
}
set hlist [lassign [lindex $OPTIONLIST $idx] opt gpattern perm]
set PL($handle,$opt) $value
}
looperr* -
stop* -
tim* {
# These are the callback handlers. These should hold proc names.
set idx [lsearch -index 0 $OPTIONLIST [string trimleft $option -]]
if {$idx == -1} {
return -code error "unknown option '$option'"
}
if {[llength $value] > 1} {
return -code error "$option callback should be a procedure name"
}
set hlist [lassign [lindex $OPTIONLIST $idx] opt gpattern perm]
set PL($handle,$opt) $value
}
fail* {
# This is either the failexecratio or failjitterratio, both of
# which need to be between 0.0 and 1.0.
# Ensure this is a number.
set idx [lsearch -index 0 $OPTIONLIST [string trimleft $option -]]
if {$idx == -1} {
return -code error "unknown option '$option'"
}
if {![string is double $value]} {
return -code error "$option value must be a number"
}
set hlist [lassign [lindex $OPTIONLIST $idx] opt gpattern perm]
# Ensure it is greater than 0.0 and less than 1.0.
if { ($value > 0.0) && ($value < 1.0) } {
set PL($handle,$opt) $value
} else {
return -code error "$option must be between 0.0 and 1.0"
}
}
default {
# The rest of the parameters are read-only statistics
# options. Ensure that it is one of those and
# report a read-only error, and a more general
# error if unidentified.
set idx [lsearch -index 0 $OPTIONLIST [string trimleft $option -]]
if {$idx == -1} {
return -code error "unknown option '$option'"
}
set hlist [lassign [lindex $OPTIONLIST $idx] opt gpattern perm]
return -code error "option '$opt' is read-only"
}
}
}
return -code ok
}
######################################################################
proc ${NS}::Delete { handle } {
# Deletes the paced loop identified by handle. Note that this
# deletion is really not quite an entire deletion since the
# ensemble command will still exist, but it will no longer be able
# to do anything.
variable HANDLES
variable PL
# Stop the paced loop, if necessary.
Stop $handle
# Delete the elements from the PL array. Due to the index naming
# convention, this is relatively straight-forward.
array unset PL $handle,*
# Delete the handle from the list of handles.
set idx [lsearch -exact $HANDLES $handle]
if {$idx != -1} {
set HANDLES [lreplace $HANDLES $idx $idx]
}
return -code ok
}
######################################################################
proc ${NS}::GetHandles { handle } {
# Returns the handles to (the name of ensemble commands of) the
# paced loops managed by this package. Note that there may be
# defunct ensemble commands in existence, though not reported
# here: see the Design Note at the top.
variable PL
return $HANDLES
}
######################################################################
proc ${NS}::GetVarName { handle option } {
# Returns the name of the variable associated with particular
# configuration value, allowing the user to, for instance, display
# one of the statistics in a UI or to add a trace, etc. Note that
# this should be used with caution since if any variable reported
# by this routine is modified externally it can cause serious
# problems: a risk vs. reward situation.
variable PL
variable OPTIONLIST
if {![IsHandleValid $handle]} {
return -code error "handle does not exist"
}
# Once again, I have opted for short code over efficiency.
foreach optitem $OPTIONLIST {
set hlist [lassign $optitem fulloption gpattern permissions]
if {[string match $gpattern [string trimleft $option "-"]]} {
return [namespace current]::PL($handle,$fulloption)
}
}
return -code error "unknown option, $option"
}
######################################################################
proc ${NS}::Initialize { handle } {
# Routine to (possibly re-) initialize the paced loop. Statistics
# are left untouched.
variable PL
# Stop if the loop was running.
Stop $handle
if {[catch {uplevel #0 $PL($handle,initcode)} result]} {
return -code error "paced loop initialization code failure:\n$result"
}
# Indicate the new state.
set PL($handle,state) initialized
}
######################################################################
proc ${NS}::Stop { handle } {
# Stop (pause) a paced loop identified by handle.
variable PL
if {![IsHandleValid $handle]} {
return -code error "handle does not exist"
}
if {$PL($handle,state) eq "running"} {
# In this situation, cancel the next iteration of the loop.
after cancel $PL($handle,afterid)
# Establish the next state.
set PL($handle,state) stopped
incr PL($handle,pausecount) 1
# Execute stoppedcallback if it exists.
if {$PL($handle,stoppedcallback) ne {}} {
uplevel #0 [list $PL($handle,stoppedcallback) [namespace current]::$handle]
}
}
# Prepare for statistics: tick time will be invalid; a value of
# zero is used as a sentinel for this situation.
set PL($handle,lasttickstart) 0
# No action needs to be taken if initialized or already stopped.
return -code ok
}
######################################################################
proc ${NS}::Start { handle } {
# Starts the paced loop identified by handle: it will start running
# via recursive call of (private procedure) Loop.
variable PL
if {![IsHandleValid $handle]} {
return -code error "handle does not exist"
}
# If currently uninitialized, then first do that.
if {$PL($handle,state) eq "uninitialized"} {
Initialize $handle
}
# Start the recursive routine only if currently in initialized
# or stopped state.
if {($PL($handle,state) eq "initialized") || ($PL($handle,state) eq "stopped")} {
set PL($handle,afterid) [after idle [list [namespace current]::Loop $handle]]
}
return -code ok
}
######################################################################
# Private routines.
######################################################################
proc ${NS}::IsHandleValid { handle } {
# Returns true or false as to whether or not paced loop identified
# by handle currently exists.
variable HANDLES
set idx [lsearch -exact $HANDLES $handle]
if {$idx == -1} {
return 0
} else {
return 1
}
}
######################################################################
proc ${NS}::Loop { handle } {
# This is the main part of the paced loop: a routine called
# recursively. Tracking statistics and allowing callbacks makes
# it look a little busy.
variable PL
# Record the current time: done early in a bid to accommodate
# (some of the) framework overhead: the overhead after the loop is
# not included since the end time needs to be used as part of the
# statistics calculations.
set starttime [clock microseconds]
# Detect unacceptable jitter if not in the first pass coming out
# of stopped or initialized states, and if not in free-run mode.
if {$PL($handle,lasttickstart)} {
set PL($handle,thisticktime) [expr {$starttime - $PL($handle,lasttickstart)}]
if {$PL($handle,ticktime) ne "freerun"} {
if { abs(1000.0 * $PL($handle,ticktime) - $PL($handle,thisticktime)) >
($PL($handle,failjitterratio) * $PL($handle,ticktime) * 1000.0) } {
# Jitter is too large.
incr PL($handle,jittercount) 1
# If a timing error callback is defined, run it.
if {$PL($handle,timingcallback) ne {}} {
uplevel #0 [list $PL($handle,timingcallback) [namespace current]::$handle] jitter
}
}
}
}
# To get relatively accurate scheduling, schedule the next run of
# this routine now. If it turns out that we need to cancel it
# later, then that is done later. A slight catch is is that if
# the loop is meant to run freely, it is run as soon as we go
# idle.
if {$PL($handle,ticktime) eq "freerun"} {
# Command 'after' is used to avoid putting more and more
# things on the stack during freerun mode, as would be the
# case with a recursive call.
set aftertime idle
} else {
# Schedule the next execution.
set aftertime $PL($handle,ticktime)
}
# If parameter countdown is active, maintain it, possibly stopping
# execution if done.
set RUNLOOP 1
if {$PL($handle,countdown) != {}} {
if {$PL($handle,countdown) > 1} {
incr PL($handle,countdown) -1
} else {
# Reset the value.
set PL($handle,countdown) {}
set RUNLOOP 0
}
}
# Schedule the next iteration.
if {$RUNLOOP} {
set PL($handle,afterid) [after $aftertime [list [namespace current]::Loop $handle]]
# Indicate that we are now running, necessarily established before
# Stop is possibly called on error.
set PL($handle,state) running
}
# Check the flag used to detect if there has been an over-run
# caused by this routine has been called before its last pass has
# completed. This can occur if a user's code includes an update
# or something that enters the event loop, and I am calling a
# 'scheduling' timing issue.
if {$PL($handle,inloop)} {
incr PL($handle,overruncount)
# This is a bad situation that needs to be terminated,
# otherwise the prior run will never finish running, and the
# situation will continue to unfold.
Stop $handle
# If a timing error callback is defined, call it.
if {$PL($handle,timingcallback) ne {}} {
uplevel #0 [list $PL($handle,timingcallback) [namespace current]::$handle] scheduling
# Since the error should be handled in the callback, make
# no report of this error.
return -code ok
} else {
# In the case of no callback, indicate that there has been
# an error.
return -code error "paced loop $handle has encountered a scheduling collision"
}
}
# Set a flag to indicate we are entering the loop.
set PL($handle,inloop) 1
# Run the loop code!
if {[catch {uplevel #0 $PL($handle,loopcode)} result]} {
# The loop is stopped if an error in code is encountered.
Stop $handle
# An error in execution of the loop has occurred.
if {$PL($handle,looperrorcallback) eq {}} {
# Use normal TCL error-reporting mechanisms.
return -code error $result
} else {
# Use the user-specified looperrorcallback routine.
uplevel #0 [list $PL($handle,looperrorcallback) [namespace current]::$handle]
return -code ok
}
}
set endtime [clock microseconds]
# Completed processing of a loop.
set PL($handle,inloop) 0
# Update statistics.
incr PL($handle,loopcount)
set PL($handle,thisexectime) [expr {$endtime - $starttime}]
incr PL($handle,sumexectime) $PL($handle,thisexectime)
set PL($handle,averageexectime) [expr {$PL($handle,sumexectime)/$PL($handle,loopcount)}]
if {$PL($handle,thisexectime) < $PL($handle,minexectime)} {
set PL($handle,minexectime) $PL($handle,thisexectime)
}
if {$PL($handle,thisexectime) > $PL($handle,maxexectime)} {
set PL($handle,maxexectime) $PL($handle,thisexectime)
}
# Can only track the tick time if this is the second time this
# routine has run once started, which adds some
# complications. This is detectable if the handle,lasttickstart is
# non-zero.
if {$PL($handle,lasttickstart)} {
incr PL($handle,sumticktime) $PL($handle,thisticktime)
set PL($handle,averageticktime) [expr {$PL($handle,sumticktime)/ \
($PL($handle,loopcount) - \
($PL($handle,pausecount) + 1))}]
set PL($handle,exectoidleratio) [expr {double($PL($handle,averageexectime))/ \
$PL($handle,averageticktime)}]
if {$PL($handle,thisticktime) < $PL($handle,minticktime)} {
set PL($handle,minticktime) $PL($handle,thisticktime)
}
if {$PL($handle,thisticktime) > $PL($handle,maxticktime)} {
set PL($handle,maxticktime) $PL($handle,thisticktime)
}
} else {
# Handle the case where this was the first loop (or the first
# coming out of the 'stopped' state. This means that the sumticktime
# should not be incremented, and there should be no adjustments to the
# averageticktime.
# For ratio reporting, report as if the tick time was exact.
if {$PL($handle,ticktime) ne "freerun"} {
set PL($handle,exectoidleratio) [expr {double($PL($handle,averageexectime))/ \
($PL($handle,ticktime) * 1000)}]
} else {
# If in freerun mode, the ratio should be close to 1.0.
# Design choice:
# a) either set to the exectoidleratio as a 1.0 (always a number); or
# b) set it to it a "freerun". This will make handling of the value
# less predictable, but freerun shouldn't be used in normal
# operation anyway.
# I am picking option b.
set PL($handle,exectoidleratio) "freerun"
}
}
# Assess if there has been an over-run.
if {$PL($handle,ticktime) ne "freerun"} {
if {$PL($handle,thisexectime) > [expr {int(1000.0 * $PL($handle,failexecratio) * \
$PL($handle,ticktime))}]} {
incr PL($handle,overruncount)
# If a timing error callback is defined, call it.
if {$PL($handle,timingcallback) ne {}} {
uplevel #0 [list $PL($handle,timingcallback) [namespace current]::$handle] exectime
}
}
}
# Keep a copy of the tick start time for for tick-time reporting.
set PL($handle,lasttickstart) $starttime
# If this was to run only so many times and that has been done,
# then stop the loop. Done in this way to maintain state information.
if {!$RUNLOOP} {
Stop $handle
}
return -code ok
}