taskmanager.tcl

SMC takes a state machine stored in a .sm file and generates a State pattern in twelve programming l

                                  $TaskIndex \
                                  $TaskIndex];
            } elseif {[set TaskIndex [lsearch -exact $_blockedTaskList $Task]] >= 0} {
                # Move the task from the blocked queue to the
                # runnable queue.
                set _blockedTaskList \
                        [lreplace $_blockedTaskList \
                                  $TaskIndex \
                                  $TaskIndex];
            }

            ZombifyTask $Task;
        }

        return -code ok;
    }

    # State machine actions.

    # getRunnableTaskCount --
    #
    #   Return the number of runnable tasks.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   Return the number of runnable tasks.
    
    public method getRunnableTaskCount {} {
        return -code ok [llength $_runnableTaskQueue];
    }

    # getBlockedTaskCount --
    #
    #   Return the number of blocked tasks.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   Return the number of blocked tasks.
    
    public method getBlockedTaskCount {} {
        return -code ok [llength $_blockedTaskList];
    }

    # getRunningTask --
    #
    #   Return the currently running task.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   Return the currently running task.

    public method getRunningTask {} {
        return -code ok _runningTask;
    }

    # setTimer --
    #
    #   Create a timer for the specified period. When the timer
    #   expires, issue the specified transition to the state
    #   machine.
    #
    # Arguments:
    #   name    The timer's name.
    #   period  The time in milliseconds.
    #
    # Results:
    #   None.

    public method setTimer {name period} {
        # If there a timer with this name already active?
        if {[llength [array names _timerTable $name]] > 0 && \
                $_timerTable($name) >= 0} {
            # Yes, there is. Stop the current timer and then
            # start it again.
            stopTimer $name;
        }

        set _timerTable($name) [after $period [list $this timeout $name]];

        return -code ok;
    }

    # stopTimer --
    #
    #   Stop the specified timer if it is running.
    #
    # Arguments:
    #   name   The timer's name.
    #
    # Results:
    #   None.

    public method stopTimer {name} {
        # Get the Tcl timer ID from the table.
        if {[catch "set TimerID $_timerTable($name)"] == 0} {
            after cancel $TimerID;
            set _timerTable($name) -1;
        }

        return -code ok;
    }

    # sendMessage --
    #
    #   Send a message to the GUI controller so it can be
    #   posted on the message display.
    #
    # Arguments:
    #   level     The message's importance where 0 is the most
    #            important message and decreasing as the level
    #            increases.
    #   message   The message to be posted.
    #
    # Results:
    #   None.

    public method sendMessage {level message} {
        guiController postMessage \
                messageGUI postMessage $level "TaskManager" $message;
        return -code ok;
    }

    # checkTaskQueue --
    #
    #   Check if there are any tasks to run. If yes, then
    #   asynchronously issue a RunTask transition using the
    #   setTimer() method.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   None.

    public method checkTaskQueue {} {
        if {[llength $_runnableTaskQueue] > 0} {
            setTimer RunTask idle;
        }

        return -code ok;
    }

    # startTask --
    #
    #   Take the highest priority task off the runnable queue
    #   and have it start running.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   None.

    public method startTask {} {
        # Sort the queue by priority.
        set _runnableTaskQueue [lsort -decreasing -command comparePriority $_runnableTaskQueue];

        # Remove the first task from the queue tell it to
        # start up.
        set _runningTask [lindex $_runnableTaskQueue 0];
        set _runnableTaskQueue [lrange $_runnableTaskQueue 1 end];

        sendMessage 2 "Attempting to run task [$_runningTask getName].";

        guiController postMessage \
                $_runningTask start;

        return -code ok;
    }

    # stopAllTimers --
    #
    #   Cancel all Tcl timers.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   None.

    public method stopAllTimers {} {
        # If the garbage collection timer is set, then
        # cancel it.
        if {$_garbageTimerID >= 0} {
            after cancel $_garbageTimerID;
            set _garbageTimerID -1;
        }

        # Cancel all other timers.
        foreach Timer [array names _timerTable] {
            if {$_timerTable($Timer) >= 0} {
                after cancel $_timerTable($Timer);
                set _timerTable($Timer) -1;
            }
        }

        return -code ok;
    }

    # stopAllTasks --
    #
    #   Stop all tasks.
    #
    # Arguments:
    #   None.
    #
    # Results:
    #   None.

    public method stopAllTasks {} {
        # Put all tasks into the blocked list. As they report
        # that they are stopped, move the tasks into the zombie
        # list.
        #
        # Do the blocked list first.
        foreach Task $_blockedTaskList {
            sendMessage 3 "Stopping task [$Task getName].";
            guiController postMessage \
                    $Task stop;
        }

        # Do the waiting tasks next.
        foreach Task $_runnableTaskQueue {
            sendMessage 3 "Stopping task [$Task getName].";
            guiController postMessage \
                    $Task stop;
            lappend _blockedTaskList $Task;
        }
        set _runnableTaskQueue {};

        # Do the running task last.
        if {[string length $_runningTask] > 0} {
            sendMessage 3 "Stopping task [$_runningTask getName].";
            guiController postMessage \
                    $_runningTask stop;
            lappend _blockedTaskList $_runningTask;
            set _runningTask "";
        }

        return -code ok;
    }

    # deleteRunningTask --
    #
    #   Delete the running task object.
    #
    # Arugments:
    #   None.
    #
    # Results:
    #   None.

    public method deleteRunningTask {} {
        if {[string length $_runningTask] > 0} {
            ZombifyTask $_runningTask;
            set _runningTask "";
        }

        return -code ok;
    }

    # deleteAllTasks --
    #
    #   Forcibly delete all existing tasks with predjudice.
    #
    # Arugments:
    #   None.
    #
    # Results:
    #   None.

    public method deleteAllTasks {} {
        if {[string length $_runningTask] > 0} {
            delete object $_runningTask;
            set _runningTask "";
        }

        foreach Task $_runnableTaskQueue {
            delete object $Task;
        }
        set _runnableTaskQueue {};

        foreach Task $_blockedTaskList {
            delete object $Task;
        }
        set _blockedTaskList {};
        
        return -code ok;
    }

    # exitApplication --
    #
    #   Exit this application.
    #
    # Arugments:
    #   exitCode  Upon exit, return this integer value.
    #
    # Results:
    #   None.

    public method exitApplication {exitCode} {
        after 1500 [list exit $exitCode];
        return -code ok;
    }

    # ZombifyTask --
    #
    #   Put a task on the zombie list for later deletion.
    #   Start the garbage collection timer. When it expires,
    #   delete all the tasks on the zombie list.
    #
    # Arguments:
    #   task   A task object.
    #
    # Results:
    #   None.

    private method ZombifyTask {task} {
        # Check if this object is already a zombie.
        if {[lsearch -exact $_zombieTaskList $task] < 0} {
            lappend _zombieTaskList $task;
        }

        # If the garbage collection timer is not running,
        # then start it now.
        if {$_garbageTimerID < 0} {
            after idle [list $this collectGarbage];
        }

        return -code ok;
    }

    # FindTask --
    #
    #   Find a task object with the specified name and return
    #   the object.
    #
    # Arguments:
    #   taskName   A task object's name.
    #
    # Results:
    #   If a task is found with the given name, then the task
    #   object is returned. If not found, then the empty string
    #   is returned.

    private method FindTask {taskName} {
        set Retval "";

        # Is the running task the one we are looking for?
        if {[string length $_runningTask] > 0 && \
                [string compare [$_runningTask getName] $taskName] == 0} {
            set Retval $_runningTask;
        } else {
            # Is the task in the runnable queue?
            foreach Task $_runnableTaskQueue {
                if {[string compare [$Task getName] $taskName] == 0} {
                    set Retval $Task;
                    break;
                }
            }

            # Is the task in the blocked list?
            if {[string length $Retval] == 0} {
                foreach Task $_blockedTaskList {
                    if {[string compare [$Task getName] $taskName] == 0} {
                        set Retval $Task;
                        break;
                    }
                }
            }
        }

        return -code ok $Retval;
    }
}

# comparePriority --
#
#   Have both tasks return their dynamic priorities and compare
#   the returned values.
#
# Arguments:
#   lhs   A task object.
#   rhs   A task object.
#
# Results:
#   If the lhs task's priority is less than the rhs task, then
#   -1 is returned. If the lhs task's priority is equal to the
#   rhs, then 0 is returned. If the lhs task's priority is
#   greater than the rhs, then 1 is returned.

proc comparePriority {lhs rhs} {
    set LhsPriority [$lhs getDynamicPriority];
    set RhsPriority [$rhs getDynamicPriority];

    if {$LhsPriority < $RhsPriority} {
        set Retval -1;
    } elseif {$LhsPriority > $RhsPriority} {
        set Retval 1;
    } else {
        set Retval 0;
    }

    return -code ok $Retval;
}