diff options
Diffstat (limited to 'generic/tclTimer.c')
| -rw-r--r-- | generic/tclTimer.c | 1155 |
1 files changed, 670 insertions, 485 deletions
diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 7bb8e7d..c10986a 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -1,4 +1,4 @@ -/* +/* * tclTimer.c -- * * This file provides timer event management facilities for Tcl, @@ -6,125 +6,162 @@ * * 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. - * - * SCCS: @(#) tclTimer.c 1.9 97/07/29 16:21:53 + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tclPort.h" - -/* - * This flag indicates whether this module has been initialized. - */ - -static int initialized = 0; /* * For each timer callback that's pending there is one record of the following - * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained + * 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; /* Procedure 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. */ + 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; -static TimerHandler *firstTimerHandlerPtr = NULL; - /* First event in queue. */ -static int lastTimerId; /* Timer identifier of most recently - * created timer. */ -static int timerPending; /* 1 if a timer event is in the queue. */ - /* - * 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. + * 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 + /* Pointer to the "tclAfter" assocData for the + * interp in which command will be * executed. */ - char *command; /* Command to execute. Malloc'ed, so must - * be freed when structure is deallocated. */ - int id; /* Integer identifier for command; used to + 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. */ + 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. + * 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. */ + 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. + * 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); /* Procedure to call. */ + 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; -static IdleHandler *idleList; - /* First in list of all idle handlers. */ -static IdleHandler *lastIdlePtr; - /* Last in list (or NULL for empty list). */ -static 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. */ +/* + * 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) + +#define TCL_TIME_DIFF_MS_CEILING(t1, t2) \ + (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ + ((long)(t1).usec - (long)(t2).usec + 999)/1000) + +/* + * Sleeps under that number of milliseconds don't get double-checked + * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s. + */ + +#define SLEEP_OFFLOAD_GETTIMEOFDAY 20 + +/* + * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay. + * This is used to limit the maximum lag between interp limit and script + * cancellation checks. + */ + +#define TCL_TIME_MAXIMUM_SLICE 500 /* - * Prototypes for procedures referenced only in this file: + * Prototypes for functions referenced only in this file: */ -static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp)); -static void AfterProc _ANSI_ARGS_((ClientData clientData)); -static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr)); -static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr, - char *string)); -static void InitTimer _ANSI_ARGS_((void)); -static void TimerExitProc _ANSI_ARGS_((ClientData clientData)); -static int TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr, - int flags)); -static void TimerCheckProc _ANSI_ARGS_((ClientData clientData, - int flags)); -static void TimerSetupProc _ANSI_ARGS_((ClientData clientData, - int flags)); +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); /* *---------------------------------------------------------------------- @@ -134,7 +171,7 @@ static void TimerSetupProc _ANSI_ARGS_((ClientData clientData, * This function initializes the timer module. * * Results: - * None. + * A pointer to the thread specific data. * * Side effects: * Registers the idle and timer event sources. @@ -142,19 +179,17 @@ static void TimerSetupProc _ANSI_ARGS_((ClientData clientData, *---------------------------------------------------------------------- */ -static void -InitTimer() +static ThreadSpecificData * +InitTimer(void) { - initialized = 1; - lastTimerId = 0; - timerPending = 0; - idleGeneration = 0; - firstTimerHandlerPtr = NULL; - lastIdlePtr = NULL; - idleList = NULL; - - Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); - Tcl_CreateExitHandler(TimerExitProc, NULL); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); + Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); + Tcl_CreateThreadExitHandler(TimerExitProc, NULL); + } + return tsdPtr; } /* @@ -162,24 +197,35 @@ InitTimer() * * TimerExitProc -- * - * This function is call at exit or unload time to remove the - * timer and idle event sources. + * 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. + * Removes the timer and idle event sources and remaining events. * *---------------------------------------------------------------------- */ static void -TimerExitProc(clientData) - ClientData clientData; /* Not used. */ +TimerExitProc( + ClientData clientData) /* Not used. */ { + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); - initialized = 0; + if (tsdPtr != NULL) { + register TimerHandler *timerHandlerPtr; + + timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; + while (timerHandlerPtr != NULL) { + tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; + ckfree(timerHandlerPtr); + timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; + } + } } /* @@ -187,78 +233,102 @@ TimerExitProc(clientData) * * Tcl_CreateTimerHandler -- * - * Arrange for a given procedure to be invoked at a particular - * time in the future. + * 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. + * 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. + * When milliseconds have elapsed, proc will be invoked exactly once. * *-------------------------------------------------------------- */ Tcl_TimerToken -Tcl_CreateTimerHandler(milliseconds, proc, clientData) - int milliseconds; /* How many milliseconds to wait - * before invoking proc. */ - Tcl_TimerProc *proc; /* Procedure to invoke. */ - ClientData clientData; /* Arbitrary data to pass to proc. */ +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. */ { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; Tcl_Time time; - if (!initialized) { - InitTimer(); - } - - timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); - /* * Compute when the event should fire. */ - TclpGetTime(&time); - timerHandlerPtr->time.sec = time.sec + milliseconds/1000; - timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000; - if (timerHandlerPtr->time.usec >= 1000000) { - timerHandlerPtr->time.usec -= 1000000; - timerHandlerPtr->time.sec += 1; + 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 = InitTimer(); + + timerHandlerPtr = ckalloc(sizeof(TimerHandler)); + /* - * Fill in other fields for the event. + * Fill in fields for the event. */ + memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time)); timerHandlerPtr->proc = proc; timerHandlerPtr->clientData = clientData; - lastTimerId++; - timerHandlerPtr->token = (Tcl_TimerToken) lastTimerId; + 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 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; + for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { - if ((tPtr2->time.sec > timerHandlerPtr->time.sec) - || ((tPtr2->time.sec == timerHandlerPtr->time.sec) - && (tPtr2->time.usec > timerHandlerPtr->time.usec))) { + if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) { break; } } timerHandlerPtr->nextPtr = tPtr2; if (prevPtr == NULL) { - firstTimerHandlerPtr = timerHandlerPtr; + tsdPtr->firstTimerHandlerPtr = timerHandlerPtr; } else { prevPtr->nextPtr = timerHandlerPtr; } TimerSetupProc(NULL, TCL_ALL_EVENTS); + return timerHandlerPtr->token; } @@ -273,33 +343,37 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData) * None. * * Side effects: - * Destroy the timer callback identified by TimerToken, - * so that its associated procedure will not be called. - * If the callback has already fired, or if the given - * token doesn't exist, then nothing happens. + * 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(token) - Tcl_TimerToken token; /* Result previously returned by +Tcl_DeleteTimerHandler( + Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { register TimerHandler *timerHandlerPtr, *prevPtr; + ThreadSpecificData *tsdPtr = InitTimer(); - for (timerHandlerPtr = firstTimerHandlerPtr, prevPtr = NULL; + 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) { - firstTimerHandlerPtr = timerHandlerPtr->nextPtr; + tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; } else { prevPtr->nextPtr = timerHandlerPtr->nextPtr; } - ckfree((char *) timerHandlerPtr); + ckfree(timerHandlerPtr); return; } } @@ -309,9 +383,9 @@ Tcl_DeleteTimerHandler(token) * * 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. + * 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. @@ -323,29 +397,30 @@ Tcl_DeleteTimerHandler(token) */ static void -TimerSetupProc(data, flags) - ClientData data; /* Not used. */ - int flags; /* Event flags as passed to Tcl_DoOneEvent. */ +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) && idleList) - || ((flags & TCL_TIMER_EVENTS) && timerPending)) { + 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) && firstTimerHandlerPtr) { + } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { /* * Compute the timeout for the next timer on the list. */ - TclpGetTime(&blockTime); - blockTime.sec = firstTimerHandlerPtr->time.sec - blockTime.sec; - blockTime.usec = firstTimerHandlerPtr->time.usec - blockTime.usec; + 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; @@ -357,7 +432,7 @@ TimerSetupProc(data, flags) } else { return; } - + Tcl_SetMaxBlockTime(&blockTime); } @@ -366,9 +441,9 @@ TimerSetupProc(data, flags) * * 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. + * 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. @@ -380,21 +455,23 @@ TimerSetupProc(data, flags) */ static void -TimerCheckProc(data, flags) - ClientData data; /* Not used. */ - int flags; /* Event flags as passed to Tcl_DoOneEvent. */ +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) && firstTimerHandlerPtr) { + if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { /* * Compute the timeout for the next timer on the list. */ - TclpGetTime(&blockTime); - blockTime.sec = firstTimerHandlerPtr->time.sec - blockTime.sec; - blockTime.usec = firstTimerHandlerPtr->time.usec - blockTime.usec; + 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; @@ -408,9 +485,10 @@ TimerCheckProc(data, flags) * If the first timer has expired, stick an event on the queue. */ - if (blockTime.sec == 0 && blockTime.usec == 0 && !timerPending) { - timerPending = 1; - timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event)); + if (blockTime.sec == 0 && blockTime.usec == 0 && + !tsdPtr->timerPending) { + tsdPtr->timerPending = 1; + timerEvPtr = ckalloc(sizeof(Tcl_Event)); timerEvPtr->proc = TimerHandlerEventProc; Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); } @@ -422,37 +500,37 @@ TimerCheckProc(data, flags) * * TimerHandlerEventProc -- * - * This procedure is called by Tcl_ServiceEvent when a timer event - * reaches the front of the event queue. This procedure handles - * the event by invoking the callbacks for all timers that are - * ready. + * 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. + * 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 procedures do. + * Whatever the timer handler callback functions do. * *---------------------------------------------------------------------- */ static int -TimerHandlerEventProc(evPtr, flags) - Tcl_Event *evPtr; /* Event to service. */ - int flags; /* Flags that indicate what events to - * handle, such as TCL_FILE_EVENTS. */ +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. + * 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)) { @@ -460,45 +538,41 @@ TimerHandlerEventProc(evPtr, flags) } /* - * The code below is trickier than it may look, for the following - * reasons: + * 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. + * 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. */ - timerPending = 0; - currentTimerId = lastTimerId; - TclpGetTime(&time); + tsdPtr->timerPending = 0; + currentTimerId = tsdPtr->lastTimerId; + Tcl_GetTime(&time); while (1) { - nextPtrPtr = &firstTimerHandlerPtr; - timerHandlerPtr = firstTimerHandlerPtr; + nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; + timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; if (timerHandlerPtr == NULL) { break; } - - if ((timerHandlerPtr->time.sec > time.sec) - || ((timerHandlerPtr->time.sec == time.sec) - && (timerHandlerPtr->time.usec > time.usec))) { + + if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) { break; } @@ -506,18 +580,18 @@ TimerHandlerEventProc(evPtr, flags) * Bail out if the next timer is of a newer generation. */ - if ((currentTimerId - (int)timerHandlerPtr->token) < 0) { + if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) { break; } /* - * Remove the handler from the queue before invoking it, - * to avoid potential reentrancy problems. + * Remove the handler from the queue before invoking it, to avoid + * potential reentrancy problems. */ - (*nextPtrPtr) = timerHandlerPtr->nextPtr; - (*timerHandlerPtr->proc)(timerHandlerPtr->clientData); - ckfree((char *) timerHandlerPtr); + *nextPtrPtr = timerHandlerPtr->nextPtr; + timerHandlerPtr->proc(timerHandlerPtr->clientData); + ckfree(timerHandlerPtr); } TimerSetupProc(NULL, TCL_TIMER_EVENTS); return 1; @@ -528,43 +602,40 @@ TimerHandlerEventProc(evPtr, flags) * * 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). + * 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. + * Proc will eventually be called, with clientData as argument. See the + * manual entry for details. * *-------------------------------------------------------------- */ void -Tcl_DoWhenIdle(proc, clientData) - Tcl_IdleProc *proc; /* Procedure to invoke. */ - ClientData clientData; /* Arbitrary value to pass to proc. */ +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(); - if (!initialized) { - InitTimer(); - } - - idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); + idlePtr = ckalloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; - idlePtr->generation = idleGeneration; + idlePtr->generation = tsdPtr->idleGeneration; idlePtr->nextPtr = NULL; - if (lastIdlePtr == NULL) { - idleList = idlePtr; + if (tsdPtr->lastIdlePtr == NULL) { + tsdPtr->idleList = idlePtr; } else { - lastIdlePtr->nextPtr = idlePtr; + tsdPtr->lastIdlePtr->nextPtr = idlePtr; } - lastIdlePtr = idlePtr; + tsdPtr->lastIdlePtr = idlePtr; blockTime.sec = 0; blockTime.usec = 0; @@ -576,41 +647,42 @@ Tcl_DoWhenIdle(proc, clientData) * * Tcl_CancelIdleCall -- * - * If there are any when-idle calls requested to a given procedure - * with given clientData, cancel all of them. + * 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. + * If the proc/clientData combination were on the when-idle list, they + * are removed so that they will never be called. * *---------------------------------------------------------------------- */ void -Tcl_CancelIdleCall(proc, clientData) - Tcl_IdleProc *proc; /* Procedure that was previously registered. */ - ClientData clientData; /* Arbitrary value to pass to proc. */ +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 = idleList; idlePtr != NULL; + 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); + ckfree(idlePtr); idlePtr = nextPtr; if (prevPtr == NULL) { - idleList = idlePtr; + tsdPtr->idleList = idlePtr; } else { prevPtr->nextPtr = idlePtr; } if (idlePtr == NULL) { - lastIdlePtr = prevPtr; + tsdPtr->lastIdlePtr = prevPtr; return; } } @@ -622,14 +694,13 @@ Tcl_CancelIdleCall(proc, clientData) * * TclServiceIdle -- * - * This procedure 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. + * 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. + * The return value is 1 if TclServiceIdle found something to do, + * otherwise return value is 0. * * Side effects: * Invokes all pending idle handlers. @@ -638,50 +709,49 @@ Tcl_CancelIdleCall(proc, clientData) */ int -TclServiceIdle() +TclServiceIdle(void) { IdleHandler *idlePtr; int oldGeneration; Tcl_Time blockTime; + ThreadSpecificData *tsdPtr = InitTimer(); - if (idleList == NULL) { + if (tsdPtr->idleList == NULL) { return 0; } - oldGeneration = idleGeneration; - idleGeneration++; + oldGeneration = tsdPtr->idleGeneration; + tsdPtr->idleGeneration++; /* - * The code below is trickier than it may look, for the following - * reasons: + * 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. + * 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 = idleList; + for (idlePtr = tsdPtr->idleList; ((idlePtr != NULL) && ((oldGeneration - idlePtr->generation) >= 0)); - idlePtr = idleList) { - idleList = idlePtr->nextPtr; - if (idleList == NULL) { - lastIdlePtr = NULL; + idlePtr = tsdPtr->idleList) { + tsdPtr->idleList = idlePtr->nextPtr; + if (tsdPtr->idleList == NULL) { + tsdPtr->lastIdlePtr = NULL; } - (*idlePtr->proc)(idlePtr->clientData); - ckfree((char *) idlePtr); + idlePtr->proc(idlePtr->clientData); + ckfree(idlePtr); } - if (idleList) { + if (tsdPtr->idleList) { blockTime.sec = 0; blockTime.usec = 0; Tcl_SetMaxBlockTime(&blockTime); @@ -694,8 +764,8 @@ TclServiceIdle() * * Tcl_AfterObjCmd -- * - * This procedure is invoked to process the "after" Tcl command. - * See the user documentation for details on what it does. + * 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. @@ -708,208 +778,313 @@ TclServiceIdle() /* ARGSUSED */ int -Tcl_AfterObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Points to the "tclAfter" assocData for - * this interpreter, or NULL if the assocData - * hasn't been created yet.*/ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_AfterObjCmd( + ClientData clientData, /* Unused */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - /* - * 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. - */ - - static int nextId = 1; - int ms; + Tcl_WideInt ms = 0; /* Number of milliseconds to wait */ + Tcl_Time wakeup; AfterInfo *afterPtr; - AfterAssocData *assocPtr = (AfterAssocData *) clientData; - Tcl_CmdInfo cmdInfo; + AfterAssocData *assocPtr; int length; - char *arg; - int index, result; - static char *subCmds[] = { - "cancel", "idle", "info", - (char *) NULL}; - + int index; + static const char *const 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 ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } /* - * Create the "after" information associated for this interpreter, - * if it doesn't already exist. Associate it with the command too, - * so that it will be passed in as the ClientData argument in the - * future. + * 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 = ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; - Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, - (ClientData) assocPtr); - cmdInfo.proc = NULL; - cmdInfo.clientData = (ClientData) NULL; - cmdInfo.objProc = Tcl_AfterObjCmd; - cmdInfo.objClientData = (ClientData) assocPtr; - cmdInfo.deleteProc = NULL; - cmdInfo.deleteData = (ClientData) assocPtr; - Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length), - &cmdInfo); + Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); } /* * First lets see if the command was passed a number as the first argument. */ - - arg = Tcl_GetStringFromObj(objv[1], &length); - if (isdigit(UCHAR(arg[0]))) { - if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { + + if (objv[1]->typePtr == &tclIntType +#ifndef TCL_WIDE_INT_IS_LONG + || 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) { + const char *arg = Tcl_GetString(objv[1]); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be" + " cancel, idle, info, or an integer", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", + arg, 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) { - Tcl_Sleep(ms); - return TCL_OK; + return AfterDelay(interp, ms); } - afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); + afterPtr = ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { - arg = Tcl_GetStringFromObj(objv[2], &length); - afterPtr->command = (char *) ckalloc((unsigned) (length + 1)); - strcpy(afterPtr->command, arg); + afterPtr->commandPtr = objv[2]; } else { - Tcl_Obj *objPtr = Tcl_ConcatObj(objc-2, objv+2); - arg = Tcl_GetStringFromObj(objPtr, &length); - afterPtr->command = (char *) ckalloc((unsigned) (length + 1)); - strcpy(afterPtr->command, arg); - Tcl_DecrRefCount(objPtr); + 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->id = nextId; - nextId += 1; - afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc, - (ClientData) afterPtr); + afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, + AfterProc, afterPtr); afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; - sprintf(interp->result, "after#%d", afterPtr->id); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); return TCL_OK; } + case AFTER_CANCEL: { + Tcl_Obj *commandPtr; + const char *command, *tempCommand; + int tempLength; - /* - * If it's not a number it must be a subcommand. - */ - result = Tcl_GetIndexFromObj(NULL, objv[1], subCmds, "option", - 0, (int *) &index); - if (result != TCL_OK) { - Tcl_AppendResult(interp, "bad argument \"", arg, - "\": must be cancel, idle, info, or a number", - (char *) NULL); - return TCL_ERROR; + 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(command, tempCommand, (unsigned) length)) { + 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, afterPtr); + } + FreeAfterPtr(afterPtr); + } + break; } + case AFTER_IDLE: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); + return TCL_ERROR; + } + afterPtr = ckalloc(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, afterPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); + break; + case AFTER_INFO: + if (objc == 2) { + Tcl_Obj *resultObj = Tcl_NewObj(); - switch (index) { - case 0: /* cancel */ - { - char *arg; - Tcl_Obj *objPtr = NULL; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "id|command"); - return TCL_ERROR; - } - if (objc == 3) { - arg = Tcl_GetStringFromObj(objv[2], &length); - } else { - objPtr = Tcl_ConcatObj(objc-2, objv+2);; - arg = Tcl_GetStringFromObj(objPtr, &length); - } - for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; - afterPtr = afterPtr->nextPtr) { - if (strcmp(afterPtr->command, arg) == 0) { - break; - } - } - if (afterPtr == NULL) { - afterPtr = GetAfterEvent(assocPtr, arg); + for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; + afterPtr = afterPtr->nextPtr) { + if (assocPtr->interp == interp) { + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "after#%d", afterPtr->id)); } - if (objPtr != NULL) { - Tcl_DecrRefCount(objPtr); - } - if (afterPtr != NULL) { - if (afterPtr->token != NULL) { - Tcl_DeleteTimerHandler(afterPtr->token); - } else { - Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); - } - FreeAfterPtr(afterPtr); - } - break; } - case 1: /* idle */ - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "script script ..."); + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + } + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?id?"); + return TCL_ERROR; + } + afterPtr = GetAfterEvent(assocPtr, objv[2]); + if (afterPtr == NULL) { + const char *eventStr = TclGetString(objv[2]); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "event \"%s\" doesn't exist", eventStr)); + Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); + return TCL_ERROR; + } else { + Tcl_Obj *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 or being canceled). + * + * 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(&now); + endTime = now; + endTime.sec += (long)(ms/1000); + endTime.usec += ((int)(ms%1000))*1000; + if (endTime.usec >= 1000000) { + endTime.sec++; + endTime.usec -= 1000000; + } + + do { + if (Tcl_AsyncReady()) { + if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { return TCL_ERROR; } - afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); - afterPtr->assocPtr = assocPtr; - if (objc == 3) { - arg = Tcl_GetStringFromObj(objv[2], &length); - afterPtr->command = (char *) ckalloc((unsigned) length + 1); - strcpy(afterPtr->command, arg); - } else { - Tcl_Obj *objPtr = Tcl_ConcatObj(objc-2, objv+2);; - arg = Tcl_GetStringFromObj(objPtr, &length); - afterPtr->command = (char *) ckalloc((unsigned) (length + 1)); - strcpy(afterPtr->command, arg); - Tcl_DecrRefCount(objPtr); + } + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + return TCL_ERROR; + } + 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; } - afterPtr->id = nextId; - nextId += 1; - afterPtr->token = NULL; - afterPtr->nextPtr = assocPtr->firstAfterPtr; - assocPtr->firstAfterPtr = afterPtr; - Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr); - sprintf(interp->result, "after#%d", afterPtr->id); - break; - case 2: /* info */ - if (objc == 2) { - char buffer[30]; - - for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; - afterPtr = afterPtr->nextPtr) { - if (assocPtr->interp == interp) { - sprintf(buffer, "after#%d", afterPtr->id); - Tcl_AppendElement(interp, buffer); - } + } + if (iPtr->limit.timeEvent == NULL + || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { + diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); +#ifndef TCL_WIDE_INT_IS_LONG + if (diff > LONG_MAX) { + diff = LONG_MAX; + } +#endif + if (diff > TCL_TIME_MAXIMUM_SLICE) { + diff = TCL_TIME_MAXIMUM_SLICE; + } + if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1; + if (diff > 0) { + Tcl_Sleep((long) diff); + if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break; + } else break; + } 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 > TCL_TIME_MAXIMUM_SLICE) { + diff = TCL_TIME_MAXIMUM_SLICE; + } + if (diff > 0) { + Tcl_Sleep((long) diff); + } + if (Tcl_AsyncReady()) { + if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { + return TCL_ERROR; } - return TCL_OK; } - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?id?"); + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[2], &length); - afterPtr = GetAfterEvent(assocPtr, arg); - if (afterPtr == NULL) { - Tcl_AppendResult(interp, "event \"", arg, - "\" doesn't exist", (char *) NULL); + if (Tcl_LimitCheck(interp) != TCL_OK) { return TCL_ERROR; } - Tcl_AppendElement(interp, afterPtr->command); - Tcl_AppendElement(interp, - (afterPtr->token == NULL) ? "idle" : "timer"); - break; - } + } + Tcl_GetTime(&now); + } while (TCL_TIME_BEFORE(now, endTime)); return TCL_OK; } @@ -918,13 +1093,13 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv) * * GetAfterEvent -- * - * This procedure parses an "after" id such as "after#4" and - * returns a pointer to the AfterInfo structure. + * 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 "string" and is for interp, - * or NULL if no corresponding after event can be found. + * 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. @@ -933,22 +1108,24 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv) */ static AfterInfo * -GetAfterEvent(assocPtr, string) - AfterAssocData *assocPtr; /* Points to "after"-related information for +GetAfterEvent( + AfterAssocData *assocPtr, /* Points to "after"-related information for * this interpreter. */ - char *string; /* Textual identifier for after event, such - * as "after#6". */ + Tcl_Obj *commandPtr) { + const char *cmdString; /* Textual identifier for after event, such as + * "after#6". */ AfterInfo *afterPtr; int id; char *end; - if (strncmp(string, "after#", 6) != 0) { + cmdString = TclGetString(commandPtr); + if (strncmp(cmdString, "after#", 6) != 0) { return NULL; } - string += 6; - id = strtoul(string, &end, 10); - if ((end == string) || (*end != 0)) { + cmdString += 6; + id = strtoul(cmdString, &end, 10); + if ((end == cmdString) || (*end != 0)) { return NULL; } for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; @@ -965,35 +1142,34 @@ GetAfterEvent(assocPtr, string) * * AfterProc -- * - * Timer callback to execute commands registered with the - * "after" command. + * 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. + * 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 clientData; /* Describes command to execute. */ +AfterProc( + ClientData clientData) /* Describes command to execute. */ { - AfterInfo *afterPtr = (AfterInfo *) clientData; + AfterInfo *afterPtr = clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; AfterInfo *prevPtr; int result; Tcl_Interp *interp; /* - * 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. + * 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) { @@ -1011,20 +1187,20 @@ AfterProc(clientData) */ interp = assocPtr->interp; - Tcl_Preserve((ClientData) interp); - result = Tcl_GlobalEval(interp, afterPtr->command); + Tcl_Preserve(interp); + result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (\"after\" script)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } - Tcl_Release((ClientData) interp); - + Tcl_Release(interp); + /* * Free the memory for the callback. */ - ckfree(afterPtr->command); - ckfree((char *) afterPtr); + Tcl_DecrRefCount(afterPtr->commandPtr); + ckfree(afterPtr); } /* @@ -1032,10 +1208,9 @@ AfterProc(clientData) * * FreeAfterPtr -- * - * This procedure removes an "after" command from the list of - * those that are pending and frees its resources. This procedure - * does *not* cancel the timer handler; if that's needed, the - * caller must do it. + * 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. @@ -1047,8 +1222,8 @@ AfterProc(clientData) */ static void -FreeAfterPtr(afterPtr) - AfterInfo *afterPtr; /* Command to be deleted. */ +FreeAfterPtr( + AfterInfo *afterPtr) /* Command to be deleted. */ { AfterInfo *prevPtr; AfterAssocData *assocPtr = afterPtr->assocPtr; @@ -1062,8 +1237,8 @@ FreeAfterPtr(afterPtr) } prevPtr->nextPtr = afterPtr->nextPtr; } - ckfree(afterPtr->command); - ckfree((char *) afterPtr); + Tcl_DecrRefCount(afterPtr->commandPtr); + ckfree(afterPtr); } /* @@ -1071,7 +1246,7 @@ FreeAfterPtr(afterPtr) * * AfterCleanupProc -- * - * This procedure is invoked whenever an interpreter is deleted + * This function is invoked whenever an interpreter is deleted * to cleanup the AssocData for "tclAfter". * * Results: @@ -1085,12 +1260,12 @@ FreeAfterPtr(afterPtr) /* ARGSUSED */ static void -AfterCleanupProc(clientData, interp) - ClientData clientData; /* Points to AfterAssocData for the +AfterCleanupProc( + ClientData clientData, /* Points to AfterAssocData for the * interpreter. */ - Tcl_Interp *interp; /* Interpreter that is being deleted. */ + Tcl_Interp *interp) /* Interpreter that is being deleted. */ { - AfterAssocData *assocPtr = (AfterAssocData *) clientData; + AfterAssocData *assocPtr = clientData; AfterInfo *afterPtr; while (assocPtr->firstAfterPtr != NULL) { @@ -1099,10 +1274,20 @@ AfterCleanupProc(clientData, interp) if (afterPtr->token != NULL) { Tcl_DeleteTimerHandler(afterPtr->token); } else { - Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); + Tcl_CancelIdleCall(AfterProc, afterPtr); } - ckfree(afterPtr->command); - ckfree((char *) afterPtr); + Tcl_DecrRefCount(afterPtr->commandPtr); + ckfree(afterPtr); } - ckfree((char *) assocPtr); + ckfree(assocPtr); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil + * End: + */ |