Logo Search packages:      
Sourcecode: tcl8.5 version File versions  Download package

tclTimer.c

/*
 * tclTimer.c --
 *
 *    This file provides timer event management facilities for Tcl,
 *    including the "after" command.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTimer.c,v 1.30 2007/12/13 15:23:20 dgp Exp $
 */

#include "tclInt.h"

/*
 * For each timer callback that's pending there is one record of the following
 * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
 * together in a list sorted by time (earliest event first).
 */

typedef struct TimerHandler {
    Tcl_Time time;            /* When timer is to fire. */
    Tcl_TimerProc *proc;      /* Function to call. */
    ClientData clientData;    /* Argument to pass to proc. */
    Tcl_TimerToken token;     /* Identifies handler so it can be deleted. */
    struct TimerHandler *nextPtr;
                        /* Next event in queue, or NULL for end of
                         * queue. */
} TimerHandler;

/*
 * The data structure below is used by the "after" command to remember the
 * command to be executed later. All of the pending "after" commands for an
 * interpreter are linked together in a list.
 */

typedef struct AfterInfo {
    struct AfterAssocData *assocPtr;
                        /* Pointer to the "tclAfter" assocData for the
                         * interp in which command will be
                         * executed. */
    Tcl_Obj *commandPtr;      /* Command to execute. */
    int id;             /* Integer identifier for command; used to
                         * cancel it. */
    Tcl_TimerToken token;     /* Used to cancel the "after" command. NULL
                         * means that the command is run as an idle
                         * handler rather than as a timer handler.
                         * NULL means this is an "after idle" handler
                         * rather than a timer handler. */
    struct AfterInfo *nextPtr;      /* Next in list of all "after" commands for
                         * this interpreter. */
} AfterInfo;

/*
 * One of the following structures is associated with each interpreter for
 * which an "after" command has ever been invoked. A pointer to this structure
 * is stored in the AssocData for the "tclAfter" key.
 */

typedef struct AfterAssocData {
    Tcl_Interp *interp;       /* The interpreter for which this data is
                         * registered. */
    AfterInfo *firstAfterPtr; /* First in list of all "after" commands still
                         * pending for this interpreter, or NULL if
                         * none. */
} AfterAssocData;

/*
 * There is one of the following structures for each of the handlers declared
 * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
 * linked together into a list.
 */

typedef struct IdleHandler {
    Tcl_IdleProc (*proc);     /* Function to call. */
    ClientData clientData;    /* Value to pass to proc. */
    int generation;           /* Used to distinguish older handlers from
                         * recently-created ones. */
    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;

/*
 * The timer and idle queues are per-thread because they are associated with
 * the notifier, which is also per-thread.
 *
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.
 */

typedef struct ThreadSpecificData {
    TimerHandler *firstTimerHandlerPtr;   /* First event in queue. */
    int lastTimerId;          /* Timer identifier of most recently created
                         * timer. */
    int timerPending;         /* 1 if a timer event is in the queue. */
    IdleHandler *idleList;    /* First in list of all idle handlers. */
    IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */
    int idleGeneration;       /* Used to fill in the "generation" fields of
                         * IdleHandler structures. Increments each
                         * time Tcl_DoOneEvent starts calling idle
                         * handlers, so that all old handlers can be
                         * called without calling any of the new ones
                         * created by old ones. */
    int afterId;        /* For unique identifiers of after events. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write
 * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes
 * the number of milliseconds difference between two times. Both macros use
 * both of their arguments multiple times, so make sure they are cheap and
 * side-effect free. The "prototypes" for these macros are:
 *
 * static int     TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2);
 * static long    TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2);
 */

#define TCL_TIME_BEFORE(t1, t2) \
    (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))

#define TCL_TIME_DIFF_MS(t1, t2) \
    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
          ((long)(t1).usec - (long)(t2).usec)/1000)

/*
 * Prototypes for functions referenced only in this file:
 */

static void       AfterCleanupProc(ClientData clientData,
                      Tcl_Interp *interp);
static int        AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
static void       AfterProc(ClientData clientData);
static void       FreeAfterPtr(AfterInfo *afterPtr);
static AfterInfo *      GetAfterEvent(AfterAssocData *assocPtr,
                      Tcl_Obj *commandPtr);
static ThreadSpecificData *InitTimer(void);
static void       TimerExitProc(ClientData clientData);
static int        TimerHandlerEventProc(Tcl_Event *evPtr, int flags);
static void       TimerCheckProc(ClientData clientData, int flags);
static void       TimerSetupProc(ClientData clientData, int flags);

/*
 *----------------------------------------------------------------------
 *
 * InitTimer --
 *
 *    This function initializes the timer module.
 *
 * Results:
 *    A pointer to the thread specific data.
 *
 * Side effects:
 *    Registers the idle and timer event sources.
 *
 *----------------------------------------------------------------------
 */

static ThreadSpecificData *
InitTimer(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
          TclThreadDataKeyGet(&dataKey);

    if (tsdPtr == NULL) {
      tsdPtr = TCL_TSD_INIT(&dataKey);
      Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
      Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
    }
    return tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TimerExitProc --
 *
 *    This function is call at exit or unload time to remove the timer and
 *    idle event sources.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Removes the timer and idle event sources and remaining events.
 *
 *----------------------------------------------------------------------
 */

static void
TimerExitProc(
    ClientData clientData)    /* Not used. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
          TclThreadDataKeyGet(&dataKey);

    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
      register TimerHandler *timerHandlerPtr;

      timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
      while (timerHandlerPtr != NULL) {
          tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
          ckfree((char *) timerHandlerPtr);
          timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
      }
    }
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_CreateTimerHandler --
 *
 *    Arrange for a given function to be invoked at a particular time in the
 *    future.
 *
 * Results:
 *    The return value is a token for the timer event, which may be used to
 *    delete the event before it fires.
 *
 * Side effects:
 *    When milliseconds have elapsed, proc will be invoked exactly once.
 *
 *--------------------------------------------------------------
 */

Tcl_TimerToken
Tcl_CreateTimerHandler(
    int milliseconds,         /* How many milliseconds to wait before
                         * invoking proc. */
    Tcl_TimerProc *proc,      /* Function to invoke. */
    ClientData clientData)    /* Arbitrary data to pass to proc. */
{
    Tcl_Time time;

    /*
     * Compute when the event should fire.
     */

    Tcl_GetTime(&time);
    time.sec += milliseconds/1000;
    time.usec += (milliseconds%1000)*1000;
    if (time.usec >= 1000000) {
      time.usec -= 1000000;
      time.sec += 1;
    }
    return TclCreateAbsoluteTimerHandler(&time, proc, clientData);
}

/*
 *--------------------------------------------------------------
 *
 * TclCreateAbsoluteTimerHandler --
 *
 *    Arrange for a given function to be invoked at a particular time in the
 *    future.
 *
 * Results:
 *    The return value is a token for the timer event, which may be used to
 *    delete the event before it fires.
 *
 * Side effects:
 *    When the time in timePtr has been reached, proc will be invoked
 *    exactly once.
 *
 *--------------------------------------------------------------
 */

Tcl_TimerToken
TclCreateAbsoluteTimerHandler(
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr;

    tsdPtr = InitTimer();
    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;
    timerHandlerPtr->clientData = clientData;
    tsdPtr->lastTimerId++;
    timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);

    /*
     * Add the event to the queue in the correct position
     * (ordered by event firing time).
     */

    for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
          prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
      if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) {
          break;
      }
    }
    timerHandlerPtr->nextPtr = tPtr2;
    if (prevPtr == NULL) {
      tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;
    } else {
      prevPtr->nextPtr = timerHandlerPtr;
    }

    TimerSetupProc(NULL, TCL_ALL_EVENTS);

    return timerHandlerPtr->token;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_DeleteTimerHandler --
 *
 *    Delete a previously-registered timer handler.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Destroy the timer callback identified by TimerToken, so that its
 *    associated function will not be called. If the callback has already
 *    fired, or if the given token doesn't exist, then nothing happens.
 *
 *--------------------------------------------------------------
 */

void
Tcl_DeleteTimerHandler(
    Tcl_TimerToken token)     /* Result previously returned by
                         * Tcl_DeleteTimerHandler. */
{
    register TimerHandler *timerHandlerPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    if (token == NULL) {
      return;
    }

    for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
          timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
          timerHandlerPtr = timerHandlerPtr->nextPtr) {
      if (timerHandlerPtr->token != token) {
          continue;
      }
      if (prevPtr == NULL) {
          tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
      } else {
          prevPtr->nextPtr = timerHandlerPtr->nextPtr;
      }
      ckfree((char *) timerHandlerPtr);
      return;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TimerSetupProc --
 *
 *    This function is called by Tcl_DoOneEvent to setup the timer event
 *    source for before blocking. This routine checks both the idle and
 *    after timer lists.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    May update the maximum notifier block time.
 *
 *----------------------------------------------------------------------
 */

static void
TimerSetupProc(
    ClientData data,          /* Not used. */
    int flags)                /* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
          || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
      /*
       * There is an idle handler or a pending timer event, so just poll.
       */

      blockTime.sec = 0;
      blockTime.usec = 0;

    } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
      /*
       * Compute the timeout for the next timer on the list.
       */

      Tcl_GetTime(&blockTime);
      blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
      blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
            blockTime.usec;
      if (blockTime.usec < 0) {
          blockTime.sec -= 1;
          blockTime.usec += 1000000;
      }
      if (blockTime.sec < 0) {
          blockTime.sec = 0;
          blockTime.usec = 0;
      }
    } else {
      return;
    }

    Tcl_SetMaxBlockTime(&blockTime);
}

/*
 *----------------------------------------------------------------------
 *
 * TimerCheckProc --
 *
 *    This function is called by Tcl_DoOneEvent to check the timer event
 *    source for events. This routine checks both the idle and after timer
 *    lists.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    May queue an event and update the maximum notifier block time.
 *
 *----------------------------------------------------------------------
 */

static void
TimerCheckProc(
    ClientData data,          /* Not used. */
    int flags)                /* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Event *timerEvPtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
      /*
       * Compute the timeout for the next timer on the list.
       */

      Tcl_GetTime(&blockTime);
      blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
      blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
            blockTime.usec;
      if (blockTime.usec < 0) {
          blockTime.sec -= 1;
          blockTime.usec += 1000000;
      }
      if (blockTime.sec < 0) {
          blockTime.sec = 0;
          blockTime.usec = 0;
      }

      /*
       * If the first timer has expired, stick an event on the queue.
       */

      if (blockTime.sec == 0 && blockTime.usec == 0 &&
            !tsdPtr->timerPending) {
          tsdPtr->timerPending = 1;
          timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
          timerEvPtr->proc = TimerHandlerEventProc;
          Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
      }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TimerHandlerEventProc --
 *
 *    This function is called by Tcl_ServiceEvent when a timer event reaches
 *    the front of the event queue. This function handles the event by
 *    invoking the callbacks for all timers that are ready.
 *
 * Results:
 *    Returns 1 if the event was handled, meaning it should be removed from
 *    the queue. Returns 0 if the event was not handled, meaning it should
 *    stay on the queue. The only time the event isn't handled is if the
 *    TCL_TIMER_EVENTS flag bit isn't set.
 *
 * Side effects:
 *    Whatever the timer handler callback functions do.
 *
 *----------------------------------------------------------------------
 */

static int
TimerHandlerEventProc(
    Tcl_Event *evPtr,         /* Event to service. */
    int flags)                /* Flags that indicate what events to handle,
                         * such as TCL_FILE_EVENTS. */
{
    TimerHandler *timerHandlerPtr, **nextPtrPtr;
    Tcl_Time time;
    int currentTimerId;
    ThreadSpecificData *tsdPtr = InitTimer();

    /*
     * Do nothing if timers aren't enabled. This leaves the event on the
     * queue, so we will get to it as soon as ServiceEvents() is called with
     * timers enabled.
     */

    if (!(flags & TCL_TIMER_EVENTS)) {
      return 0;
    }

    /*
     * The code below is trickier than it may look, for the following reasons:
     *
     * 1. New handlers can get added to the list while the current one is
     *        being processed. If new ones get added, we don't want to process
     *        them during this pass through the list to avoid starving other event
     *        sources. This is implemented using the token number in the handler:
     *        new handlers will have a newer token than any of the ones currently
     *        on the list.
     * 2. The handler can call Tcl_DoOneEvent, so we have to remove the
     *        handler from the list before calling it. Otherwise an infinite loop
     *        could result.
     * 3. Tcl_DeleteTimerHandler can be called to remove an element from the
     *        list while a handler is executing, so the list could change
     *        structure during the call.
     * 4. Because we only fetch the current time before entering the loop, the
     *        only way a new timer will even be considered runnable is if its
     *        expiration time is within the same millisecond as the current time.
     *        This is fairly likely on Windows, since it has a course granularity
     *        clock. Since timers are placed on the queue in time order with the
     *        most recently created handler appearing after earlier ones with the
     *        same expiration time, we don't have to worry about newer generation
     *        timers appearing before later ones.
     */

    tsdPtr->timerPending = 0;
    currentTimerId = tsdPtr->lastTimerId;
    Tcl_GetTime(&time);
    while (1) {
      nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
      timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
      if (timerHandlerPtr == NULL) {
          break;
      }

      if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) {
          break;
      }

      /*
       * Bail out if the next timer is of a newer generation.
       */

      if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
          break;
      }

      /*
       * Remove the handler from the queue before invoking it, to avoid
       * potential reentrancy problems.
       */

      (*nextPtrPtr) = timerHandlerPtr->nextPtr;
      (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
      ckfree((char *) timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_DoWhenIdle --
 *
 *    Arrange for proc to be invoked the next time the system is idle (i.e.,
 *    just before the next time that Tcl_DoOneEvent would have to wait for
 *    something to happen).
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Proc will eventually be called, with clientData as argument. See the
 *    manual entry for details.
 *
 *--------------------------------------------------------------
 */

void
Tcl_DoWhenIdle(
    Tcl_IdleProc *proc,       /* Function to invoke. */
    ClientData clientData)    /* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = tsdPtr->idleGeneration;
    idlePtr->nextPtr = NULL;
    if (tsdPtr->lastIdlePtr == NULL) {
      tsdPtr->idleList = idlePtr;
    } else {
      tsdPtr->lastIdlePtr->nextPtr = idlePtr;
    }
    tsdPtr->lastIdlePtr = idlePtr;

    blockTime.sec = 0;
    blockTime.usec = 0;
    Tcl_SetMaxBlockTime(&blockTime);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CancelIdleCall --
 *
 *    If there are any when-idle calls requested to a given function with
 *    given clientData, cancel all of them.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    If the proc/clientData combination were on the when-idle list, they
 *    are removed so that they will never be called.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CancelIdleCall(
    Tcl_IdleProc *proc,       /* Function that was previously registered. */
    ClientData clientData)    /* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr, *prevPtr;
    IdleHandler *nextPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
          prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
      while ((idlePtr->proc == proc)
            && (idlePtr->clientData == clientData)) {
          nextPtr = idlePtr->nextPtr;
          ckfree((char *) idlePtr);
          idlePtr = nextPtr;
          if (prevPtr == NULL) {
            tsdPtr->idleList = idlePtr;
          } else {
            prevPtr->nextPtr = idlePtr;
          }
          if (idlePtr == NULL) {
            tsdPtr->lastIdlePtr = prevPtr;
            return;
          }
      }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclServiceIdle --
 *
 *    This function is invoked by the notifier when it becomes idle. It will
 *    invoke all idle handlers that are present at the time the call is
 *    invoked, but not those added during idle processing.
 *
 * Results:
 *    The return value is 1 if TclServiceIdle found something to do,
 *    otherwise return value is 0.
 *
 * Side effects:
 *    Invokes all pending idle handlers.
 *
 *----------------------------------------------------------------------
 */

int
TclServiceIdle(void)
{
    IdleHandler *idlePtr;
    int oldGeneration;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    if (tsdPtr->idleList == NULL) {
      return 0;
    }

    oldGeneration = tsdPtr->idleGeneration;
    tsdPtr->idleGeneration++;

    /*
     * The code below is trickier than it may look, for the following reasons:
     *
     * 1. New handlers can get added to the list while the current one is
     *        being processed. If new ones get added, we don't want to process
     *        them during this pass through the list (want to check for other work
     *        to do first). This is implemented using the generation number in the
     *        handler: new handlers will have a different generation than any of
     *        the ones currently on the list.
     * 2. The handler can call Tcl_DoOneEvent, so we have to remove the
     *        handler from the list before calling it. Otherwise an infinite loop
     *        could result.
     * 3. Tcl_CancelIdleCall can be called to remove an element from the list
     *        while a handler is executing, so the list could change structure
     *        during the call.
     */

    for (idlePtr = tsdPtr->idleList;
          ((idlePtr != NULL)
                && ((oldGeneration - idlePtr->generation) >= 0));
          idlePtr = tsdPtr->idleList) {
      tsdPtr->idleList = idlePtr->nextPtr;
      if (tsdPtr->idleList == NULL) {
          tsdPtr->lastIdlePtr = NULL;
      }
      (*idlePtr->proc)(idlePtr->clientData);
      ckfree((char *) idlePtr);
    }
    if (tsdPtr->idleList) {
      blockTime.sec = 0;
      blockTime.usec = 0;
      Tcl_SetMaxBlockTime(&blockTime);
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AfterObjCmd --
 *
 *    This function is invoked to process the "after" Tcl command. See the
 *    user documentation for details on what it does.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    See the user documentation.
 *
 *----------------------------------------------------------------------
 */

      /* ARGSUSED */
int
Tcl_AfterObjCmd(
    ClientData clientData,    /* Unused */
    Tcl_Interp *interp,       /* Current interpreter. */
    int objc,                 /* Number of arguments. */
    Tcl_Obj *CONST objv[])    /* Argument objects. */
{
    Tcl_WideInt ms;           /* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    int length;
    int index;
    char buf[16 + TCL_INTEGER_SPACE];
    static CONST char *afterSubCmds[] = {
      "cancel", "idle", "info", NULL
    };
    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();

    if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
      return TCL_ERROR;
    }

    /*
     * Create the "after" information associated for this interpreter, if it
     * doesn't already exist.
     */

    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
    if (assocPtr == NULL) {
      assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
      assocPtr->interp = interp;
      assocPtr->firstAfterPtr = NULL;
      Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
            (ClientData) assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.
     */

    if (objv[1]->typePtr == &tclIntType
#ifndef NO_WIDE_TYPE
      || objv[1]->typePtr == &tclWideIntType
#endif
      || objv[1]->typePtr == &tclBignumType
      || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, 
                         &index) != TCL_OK )) {
      index = -1;
      if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
          Tcl_AppendResult(interp, "bad argument \"",
                       Tcl_GetString(objv[1]),
                       "\": must be cancel, idle, info, or an integer",
                       NULL);
          return TCL_ERROR;
      }
    }

    /* 
     * At this point, either index = -1 and ms contains the number of ms
     * to wait, or else index is the index of a subcommand.
     */

    switch (index) {
    case -1: {
      if (ms < 0) {
          ms = 0;
      }
      if (objc == 2) {
          return AfterDelay(interp, ms);
      }
      afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
      afterPtr->assocPtr = assocPtr;
      if (objc == 3) {
          afterPtr->commandPtr = objv[2];
      } else {
          afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
      }
      Tcl_IncrRefCount(afterPtr->commandPtr);

      /*
       * The variable below is used to generate unique identifiers for after
       * commands. This id can wrap around, which can potentially cause
       * problems. However, there are not likely to be problems in practice,
       * because after commands can only be requested to about a month in
       * the future, and wrap-around is unlikely to occur in less than about
       * 1-10 years. Thus it's unlikely that any old ids will still be
       * around when wrap-around occurs.
       */

      afterPtr->id = tsdPtr->afterId;
      tsdPtr->afterId += 1;
      Tcl_GetTime(&wakeup);
      wakeup.sec += (long)(ms / 1000);
      wakeup.usec += ((long)(ms % 1000)) * 1000;
      if (wakeup.usec > 1000000) {
          wakeup.sec++;
          wakeup.usec -= 1000000;
      }
      afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc,
                                          (ClientData) afterPtr);
      afterPtr->nextPtr = assocPtr->firstAfterPtr;
      assocPtr->firstAfterPtr = afterPtr;
      Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
      return TCL_OK;
    }
    case AFTER_CANCEL: {
      Tcl_Obj *commandPtr;
      char *command, *tempCommand;
      int tempLength;

      if (objc < 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "id|command");
          return TCL_ERROR;
      }
      if (objc == 3) {
          commandPtr = objv[2];
      } else {
          commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
      }
      command = Tcl_GetStringFromObj(commandPtr, &length);
      for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
            afterPtr = afterPtr->nextPtr) {
          tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
                &tempLength);
          if ((length == tempLength)
                && (memcmp((void*) command, (void*) tempCommand,
                      (unsigned) length) == 0)) {
            break;
          }
      }
      if (afterPtr == NULL) {
          afterPtr = GetAfterEvent(assocPtr, commandPtr);
      }
      if (objc != 3) {
          Tcl_DecrRefCount(commandPtr);
      }
      if (afterPtr != NULL) {
          if (afterPtr->token != NULL) {
            Tcl_DeleteTimerHandler(afterPtr->token);
          } else {
            Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
          }
          FreeAfterPtr(afterPtr);
      }
      break;
    }
    case AFTER_IDLE:
      if (objc < 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
          return TCL_ERROR;
      }
      afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
      afterPtr->assocPtr = assocPtr;
      if (objc == 3) {
          afterPtr->commandPtr = objv[2];
      } else {
          afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
      }
      Tcl_IncrRefCount(afterPtr->commandPtr);
      afterPtr->id = tsdPtr->afterId;
      tsdPtr->afterId += 1;
      afterPtr->token = NULL;
      afterPtr->nextPtr = assocPtr->firstAfterPtr;
      assocPtr->firstAfterPtr = afterPtr;
      Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
      Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
      break;
    case AFTER_INFO: {
      Tcl_Obj *resultListPtr;

      if (objc == 2) {
          for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
                afterPtr = afterPtr->nextPtr) {
            if (assocPtr->interp == interp) {
                sprintf(buf, "after#%d", afterPtr->id);
                Tcl_AppendElement(interp, buf);
            }
          }
          return TCL_OK;
      }
      if (objc != 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "?id?");
          return TCL_ERROR;
      }
      afterPtr = GetAfterEvent(assocPtr, objv[2]);
      if (afterPtr == NULL) {
          Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]),
                "\" doesn't exist", NULL);
          return TCL_ERROR;
      }
      resultListPtr = Tcl_NewObj();
      Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
      Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
            (afterPtr->token == NULL) ? "idle" : "timer", -1));
      Tcl_SetObjResult(interp, resultListPtr);
      break;
    }
    default:
      Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AfterDelay --
 *
 *    Implements the blocking delay behaviour of [after $time]. Tricky
 *    because it has to take into account any time limit that has been set.
 *
 * Results:
 *    Standard Tcl result code (with error set if an error occurred due to a
 *    time limit being exceeded).
 *
 * Side effects:
 *    May adjust the time limit granularity marker.
 *
 *----------------------------------------------------------------------
 */

static int
AfterDelay(
    Tcl_Interp *interp,
    Tcl_WideInt ms)
{
    Interp *iPtr = (Interp *) interp;

    Tcl_Time endTime, now;
    Tcl_WideInt diff;

    Tcl_GetTime(&endTime);
    endTime.sec += (long)(ms/1000);
    endTime.usec += ((int)(ms%1000))*1000;
    if (endTime.usec >= 1000000) {
      endTime.sec++;
      endTime.usec -= 1000000;
    }

    do {
      Tcl_GetTime(&now);
      if (iPtr->limit.timeEvent != NULL
          && TCL_TIME_BEFORE(iPtr->limit.time, now)) {
          iPtr->limit.granularityTicker = 0;
          if (Tcl_LimitCheck(interp) != TCL_OK) {
            return TCL_ERROR;
          }
      }
      if (iPtr->limit.timeEvent == NULL
          || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
          diff = TCL_TIME_DIFF_MS(endTime, now);
#ifndef TCL_WIDE_INT_IS_LONG
          if (diff > LONG_MAX) {
            diff = LONG_MAX;
          }
#endif
          if (diff > 0) {
            Tcl_Sleep((long)diff);
          }
      } else {
          diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
          if (diff > LONG_MAX) {
            diff = LONG_MAX;
          }
#endif
          if (diff > 0) {
            Tcl_Sleep((long)diff);
          }
          if (Tcl_LimitCheck(interp) != TCL_OK) {
            return TCL_ERROR;
          }
      }
    } while (TCL_TIME_BEFORE(now, endTime));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetAfterEvent --
 *
 *    This function parses an "after" id such as "after#4" and returns a
 *    pointer to the AfterInfo structure.
 *
 * Results:
 *    The return value is either a pointer to an AfterInfo structure, if one
 *    is found that corresponds to "cmdString" and is for interp, or NULL if
 *    no corresponding after event can be found.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

static AfterInfo *
GetAfterEvent(
    AfterAssocData *assocPtr, /* Points to "after"-related information for
                         * this interpreter. */
    Tcl_Obj *commandPtr)
{
    char *cmdString;          /* Textual identifier for after event, such as
                         * "after#6". */
    AfterInfo *afterPtr;
    int id;
    char *end;

    cmdString = TclGetString(commandPtr);
    if (strncmp(cmdString, "after#", 6) != 0) {
      return NULL;
    }
    cmdString += 6;
    id = strtoul(cmdString, &end, 10);
    if ((end == cmdString) || (*end != 0)) {
      return NULL;
    }
    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
          afterPtr = afterPtr->nextPtr) {
      if (afterPtr->id == id) {
          return afterPtr;
      }
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * AfterProc --
 *
 *    Timer callback to execute commands registered with the "after"
 *    command.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Executes whatever command was specified. If the command returns an
 *    error, then the command "bgerror" is invoked to process the error; if
 *    bgerror fails then information about the error is output on stderr.
 *
 *----------------------------------------------------------------------
 */

static void
AfterProc(
    ClientData clientData)    /* Describes command to execute. */
{
    AfterInfo *afterPtr = (AfterInfo *) clientData;
    AfterAssocData *assocPtr = afterPtr->assocPtr;
    AfterInfo *prevPtr;
    int result;
    Tcl_Interp *interp;
    char *script;
    int numBytes;

    /*
     * First remove the callback from our list of callbacks; otherwise someone
     * could delete the callback while it's being executed, which could cause
     * a core dump.
     */

    if (assocPtr->firstAfterPtr == afterPtr) {
      assocPtr->firstAfterPtr = afterPtr->nextPtr;
    } else {
      for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
            prevPtr = prevPtr->nextPtr) {
          /* Empty loop body. */
      }
      prevPtr->nextPtr = afterPtr->nextPtr;
    }

    /*
     * Execute the callback.
     */

    interp = assocPtr->interp;
    Tcl_Preserve((ClientData) interp);
#if 0
    /* DKF: Why not just do this? */
    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
#else
    script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
    result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
#endif
    if (result != TCL_OK) {
      Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
      TclBackgroundException(interp, result);
    }
    Tcl_Release((ClientData) interp);

    /*
     * Free the memory for the callback.
     */

    Tcl_DecrRefCount(afterPtr->commandPtr);
    ckfree((char *) afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *
 *    This function removes an "after" command from the list of those that
 *    are pending and frees its resources. This function does *not* cancel
 *    the timer handler; if that's needed, the caller must do it.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The memory associated with afterPtr is released.
 *
 *----------------------------------------------------------------------
 */

static void
FreeAfterPtr(
    AfterInfo *afterPtr)            /* Command to be deleted. */
{
    AfterInfo *prevPtr;
    AfterAssocData *assocPtr = afterPtr->assocPtr;

    if (assocPtr->firstAfterPtr == afterPtr) {
      assocPtr->firstAfterPtr = afterPtr->nextPtr;
    } else {
      for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
            prevPtr = prevPtr->nextPtr) {
          /* Empty loop body. */
      }
      prevPtr->nextPtr = afterPtr->nextPtr;
    }
    Tcl_DecrRefCount(afterPtr->commandPtr);
    ckfree((char *) afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AfterCleanupProc --
 *
 *    This function is invoked whenever an interpreter is deleted
 *    to cleanup the AssocData for "tclAfter".
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    After commands are removed.
 *
 *----------------------------------------------------------------------
 */

      /* ARGSUSED */
static void
AfterCleanupProc(
    ClientData clientData,    /* Points to AfterAssocData for the
                         * interpreter. */
    Tcl_Interp *interp)       /* Interpreter that is being deleted. */
{
    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
    AfterInfo *afterPtr;

    while (assocPtr->firstAfterPtr != NULL) {
      afterPtr = assocPtr->firstAfterPtr;
      assocPtr->firstAfterPtr = afterPtr->nextPtr;
      if (afterPtr->token != NULL) {
          Tcl_DeleteTimerHandler(afterPtr->token);
      } else {
          Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
      }
      Tcl_DecrRefCount(afterPtr->commandPtr);
      ckfree((char *) afterPtr);
    }
    ckfree((char *) assocPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Generated by  Doxygen 1.6.0   Back to index