sl@0: /* sl@0: * tclTimer.c -- sl@0: * sl@0: * This file provides timer event management facilities for Tcl, sl@0: * including the "after" command. sl@0: * sl@0: * Copyright (c) 1997 by Sun Microsystems, Inc. sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclTimer.c,v 1.6.2.4 2005/11/09 21:46:20 kennykb Exp $ sl@0: */ sl@0: sl@0: #include "tclInt.h" sl@0: #include "tclPort.h" sl@0: #if defined(__SYMBIAN32__) && defined(__WINSCW__) sl@0: #include "tclSymbianGlobals.h" sl@0: #define dataKey getdataKey(7) sl@0: #endif sl@0: sl@0: /* sl@0: * For each timer callback that's pending there is one record of the following sl@0: * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained sl@0: * together in a list sorted by time (earliest event first). sl@0: */ sl@0: sl@0: typedef struct TimerHandler { sl@0: Tcl_Time time; /* When timer is to fire. */ sl@0: Tcl_TimerProc *proc; /* Procedure to call. */ sl@0: ClientData clientData; /* Argument to pass to proc. */ sl@0: Tcl_TimerToken token; /* Identifies handler so it can be sl@0: * deleted. */ sl@0: struct TimerHandler *nextPtr; /* Next event in queue, or NULL for sl@0: * end of queue. */ sl@0: } TimerHandler; sl@0: sl@0: /* sl@0: * The data structure below is used by the "after" command to remember sl@0: * the command to be executed later. All of the pending "after" commands sl@0: * for an interpreter are linked together in a list. sl@0: */ sl@0: sl@0: typedef struct AfterInfo { sl@0: struct AfterAssocData *assocPtr; sl@0: /* Pointer to the "tclAfter" assocData for sl@0: * the interp in which command will be sl@0: * executed. */ sl@0: Tcl_Obj *commandPtr; /* Command to execute. */ sl@0: int id; /* Integer identifier for command; used to sl@0: * cancel it. */ sl@0: Tcl_TimerToken token; /* Used to cancel the "after" command. NULL sl@0: * means that the command is run as an sl@0: * idle handler rather than as a timer sl@0: * handler. NULL means this is an "after sl@0: * idle" handler rather than a sl@0: * timer handler. */ sl@0: struct AfterInfo *nextPtr; /* Next in list of all "after" commands for sl@0: * this interpreter. */ sl@0: } AfterInfo; sl@0: sl@0: /* sl@0: * One of the following structures is associated with each interpreter sl@0: * for which an "after" command has ever been invoked. A pointer to sl@0: * this structure is stored in the AssocData for the "tclAfter" key. sl@0: */ sl@0: sl@0: typedef struct AfterAssocData { sl@0: Tcl_Interp *interp; /* The interpreter for which this data is sl@0: * registered. */ sl@0: AfterInfo *firstAfterPtr; /* First in list of all "after" commands sl@0: * still pending for this interpreter, or sl@0: * NULL if none. */ sl@0: } AfterAssocData; sl@0: sl@0: /* sl@0: * There is one of the following structures for each of the sl@0: * handlers declared in a call to Tcl_DoWhenIdle. All of the sl@0: * currently-active handlers are linked together into a list. sl@0: */ sl@0: sl@0: typedef struct IdleHandler { sl@0: Tcl_IdleProc (*proc); /* Procedure to call. */ sl@0: ClientData clientData; /* Value to pass to proc. */ sl@0: int generation; /* Used to distinguish older handlers from sl@0: * recently-created ones. */ sl@0: struct IdleHandler *nextPtr;/* Next in list of active handlers. */ sl@0: } IdleHandler; sl@0: sl@0: /* sl@0: * The timer and idle queues are per-thread because they are associated sl@0: * with the notifier, which is also per-thread. sl@0: * sl@0: * All static variables used in this file are collected into a single sl@0: * instance of the following structure. For multi-threaded implementations, sl@0: * there is one instance of this structure for each thread. sl@0: * sl@0: * Notice that different structures with the same name appear in other sl@0: * files. The structure defined below is used in this file only. sl@0: */ sl@0: sl@0: typedef struct ThreadSpecificData { sl@0: TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ sl@0: int lastTimerId; /* Timer identifier of most recently sl@0: * created timer. */ sl@0: int timerPending; /* 1 if a timer event is in the queue. */ sl@0: IdleHandler *idleList; /* First in list of all idle handlers. */ sl@0: IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */ sl@0: int idleGeneration; /* Used to fill in the "generation" fields sl@0: * of IdleHandler structures. Increments sl@0: * each time Tcl_DoOneEvent starts calling sl@0: * idle handlers, so that all old handlers sl@0: * can be called without calling any of the sl@0: * new ones created by old ones. */ sl@0: int afterId; /* For unique identifiers of after events. */ sl@0: } ThreadSpecificData; sl@0: sl@0: #if !defined(__SYMBIAN32__) || !defined(__WINSCW__) sl@0: static Tcl_ThreadDataKey dataKey; sl@0: #endif sl@0: sl@0: /* sl@0: * Prototypes for procedures referenced only in this file: sl@0: */ sl@0: sl@0: static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData, sl@0: Tcl_Interp *interp)); sl@0: static void AfterProc _ANSI_ARGS_((ClientData clientData)); sl@0: static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr)); sl@0: static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr, sl@0: Tcl_Obj *commandPtr)); sl@0: static ThreadSpecificData *InitTimer _ANSI_ARGS_((void)); sl@0: static void TimerExitProc _ANSI_ARGS_((ClientData clientData)); sl@0: static int TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr, sl@0: int flags)); sl@0: static void TimerCheckProc _ANSI_ARGS_((ClientData clientData, sl@0: int flags)); sl@0: static void TimerSetupProc _ANSI_ARGS_((ClientData clientData, sl@0: int flags)); sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * InitTimer -- sl@0: * sl@0: * This function initializes the timer module. sl@0: * sl@0: * Results: sl@0: * A pointer to the thread specific data. sl@0: * sl@0: * Side effects: sl@0: * Registers the idle and timer event sources. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static ThreadSpecificData * sl@0: InitTimer() sl@0: { sl@0: ThreadSpecificData *tsdPtr = sl@0: (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); sl@0: sl@0: if (tsdPtr == NULL) { sl@0: tsdPtr = TCL_TSD_INIT(&dataKey); sl@0: Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); sl@0: Tcl_CreateThreadExitHandler(TimerExitProc, NULL); sl@0: } sl@0: return tsdPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TimerExitProc -- sl@0: * sl@0: * This function is call at exit or unload time to remove the sl@0: * timer and idle event sources. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Removes the timer and idle event sources and remaining events. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: TimerExitProc(clientData) sl@0: ClientData clientData; /* Not used. */ sl@0: { sl@0: ThreadSpecificData *tsdPtr = sl@0: (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); sl@0: sl@0: Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); sl@0: if (tsdPtr != NULL) { sl@0: register TimerHandler *timerHandlerPtr; sl@0: timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; sl@0: while (timerHandlerPtr != NULL) { sl@0: tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; sl@0: ckfree((char *) timerHandlerPtr); sl@0: timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------- sl@0: * sl@0: * Tcl_CreateTimerHandler -- sl@0: * sl@0: * Arrange for a given procedure to be invoked at a particular sl@0: * time in the future. sl@0: * sl@0: * Results: sl@0: * The return value is a token for the timer event, which sl@0: * may be used to delete the event before it fires. sl@0: * sl@0: * Side effects: sl@0: * When milliseconds have elapsed, proc will be invoked sl@0: * exactly once. sl@0: * sl@0: *-------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C Tcl_TimerToken sl@0: Tcl_CreateTimerHandler(milliseconds, proc, clientData) sl@0: int milliseconds; /* How many milliseconds to wait sl@0: * before invoking proc. */ sl@0: Tcl_TimerProc *proc; /* Procedure to invoke. */ sl@0: ClientData clientData; /* Arbitrary data to pass to proc. */ sl@0: { sl@0: register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; sl@0: Tcl_Time time; sl@0: ThreadSpecificData *tsdPtr; sl@0: sl@0: tsdPtr = InitTimer(); sl@0: sl@0: timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); sl@0: sl@0: /* sl@0: * Compute when the event should fire. sl@0: */ sl@0: sl@0: Tcl_GetTime(&time); sl@0: timerHandlerPtr->time.sec = time.sec + milliseconds/1000; sl@0: timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000; sl@0: if (timerHandlerPtr->time.usec >= 1000000) { sl@0: timerHandlerPtr->time.usec -= 1000000; sl@0: timerHandlerPtr->time.sec += 1; sl@0: } sl@0: sl@0: /* sl@0: * Fill in other fields for the event. sl@0: */ sl@0: sl@0: timerHandlerPtr->proc = proc; sl@0: timerHandlerPtr->clientData = clientData; sl@0: tsdPtr->lastTimerId++; sl@0: timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId; sl@0: sl@0: /* sl@0: * Add the event to the queue in the correct position sl@0: * (ordered by event firing time). sl@0: */ sl@0: sl@0: for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; sl@0: prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { sl@0: if ((tPtr2->time.sec > timerHandlerPtr->time.sec) sl@0: || ((tPtr2->time.sec == timerHandlerPtr->time.sec) sl@0: && (tPtr2->time.usec > timerHandlerPtr->time.usec))) { sl@0: break; sl@0: } sl@0: } sl@0: timerHandlerPtr->nextPtr = tPtr2; sl@0: if (prevPtr == NULL) { sl@0: tsdPtr->firstTimerHandlerPtr = timerHandlerPtr; sl@0: } else { sl@0: prevPtr->nextPtr = timerHandlerPtr; sl@0: } sl@0: sl@0: TimerSetupProc(NULL, TCL_ALL_EVENTS); sl@0: sl@0: return timerHandlerPtr->token; sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------- sl@0: * sl@0: * Tcl_DeleteTimerHandler -- sl@0: * sl@0: * Delete a previously-registered timer handler. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Destroy the timer callback identified by TimerToken, sl@0: * so that its associated procedure will not be called. sl@0: * If the callback has already fired, or if the given sl@0: * token doesn't exist, then nothing happens. sl@0: * sl@0: *-------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_DeleteTimerHandler(token) sl@0: Tcl_TimerToken token; /* Result previously returned by sl@0: * Tcl_DeleteTimerHandler. */ sl@0: { sl@0: register TimerHandler *timerHandlerPtr, *prevPtr; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: if (token == NULL) { sl@0: return; sl@0: } sl@0: sl@0: for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; sl@0: timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, sl@0: timerHandlerPtr = timerHandlerPtr->nextPtr) { sl@0: if (timerHandlerPtr->token != token) { sl@0: continue; sl@0: } sl@0: if (prevPtr == NULL) { sl@0: tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; sl@0: } else { sl@0: prevPtr->nextPtr = timerHandlerPtr->nextPtr; sl@0: } sl@0: ckfree((char *) timerHandlerPtr); sl@0: return; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TimerSetupProc -- sl@0: * sl@0: * This function is called by Tcl_DoOneEvent to setup the timer sl@0: * event source for before blocking. This routine checks both the sl@0: * idle and after timer lists. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May update the maximum notifier block time. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: TimerSetupProc(data, flags) sl@0: ClientData data; /* Not used. */ sl@0: int flags; /* Event flags as passed to Tcl_DoOneEvent. */ sl@0: { sl@0: Tcl_Time blockTime; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) sl@0: || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { sl@0: /* sl@0: * There is an idle handler or a pending timer event, so just poll. sl@0: */ sl@0: sl@0: blockTime.sec = 0; sl@0: blockTime.usec = 0; sl@0: sl@0: } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { sl@0: /* sl@0: * Compute the timeout for the next timer on the list. sl@0: */ sl@0: sl@0: Tcl_GetTime(&blockTime); sl@0: blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; sl@0: blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - sl@0: blockTime.usec; sl@0: if (blockTime.usec < 0) { sl@0: blockTime.sec -= 1; sl@0: blockTime.usec += 1000000; sl@0: } sl@0: if (blockTime.sec < 0) { sl@0: blockTime.sec = 0; sl@0: blockTime.usec = 0; sl@0: } sl@0: } else { sl@0: return; sl@0: } sl@0: sl@0: Tcl_SetMaxBlockTime(&blockTime); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TimerCheckProc -- sl@0: * sl@0: * This function is called by Tcl_DoOneEvent to check the timer sl@0: * event source for events. This routine checks both the sl@0: * idle and after timer lists. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * May queue an event and update the maximum notifier block time. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: TimerCheckProc(data, flags) sl@0: ClientData data; /* Not used. */ sl@0: int flags; /* Event flags as passed to Tcl_DoOneEvent. */ sl@0: { sl@0: Tcl_Event *timerEvPtr; sl@0: Tcl_Time blockTime; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { sl@0: /* sl@0: * Compute the timeout for the next timer on the list. sl@0: */ sl@0: sl@0: Tcl_GetTime(&blockTime); sl@0: blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; sl@0: blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - sl@0: blockTime.usec; sl@0: if (blockTime.usec < 0) { sl@0: blockTime.sec -= 1; sl@0: blockTime.usec += 1000000; sl@0: } sl@0: if (blockTime.sec < 0) { sl@0: blockTime.sec = 0; sl@0: blockTime.usec = 0; sl@0: } sl@0: sl@0: /* sl@0: * If the first timer has expired, stick an event on the queue. sl@0: */ sl@0: sl@0: if (blockTime.sec == 0 && blockTime.usec == 0 && sl@0: !tsdPtr->timerPending) { sl@0: tsdPtr->timerPending = 1; sl@0: timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event)); sl@0: timerEvPtr->proc = TimerHandlerEventProc; sl@0: Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TimerHandlerEventProc -- sl@0: * sl@0: * This procedure is called by Tcl_ServiceEvent when a timer event sl@0: * reaches the front of the event queue. This procedure handles sl@0: * the event by invoking the callbacks for all timers that are sl@0: * ready. sl@0: * sl@0: * Results: sl@0: * Returns 1 if the event was handled, meaning it should be removed sl@0: * from the queue. Returns 0 if the event was not handled, meaning sl@0: * it should stay on the queue. The only time the event isn't sl@0: * handled is if the TCL_TIMER_EVENTS flag bit isn't set. sl@0: * sl@0: * Side effects: sl@0: * Whatever the timer handler callback procedures do. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: TimerHandlerEventProc(evPtr, flags) sl@0: Tcl_Event *evPtr; /* Event to service. */ sl@0: int flags; /* Flags that indicate what events to sl@0: * handle, such as TCL_FILE_EVENTS. */ sl@0: { sl@0: TimerHandler *timerHandlerPtr, **nextPtrPtr; sl@0: Tcl_Time time; sl@0: int currentTimerId; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: /* sl@0: * Do nothing if timers aren't enabled. This leaves the event on the sl@0: * queue, so we will get to it as soon as ServiceEvents() is called sl@0: * with timers enabled. sl@0: */ sl@0: sl@0: if (!(flags & TCL_TIMER_EVENTS)) { sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * The code below is trickier than it may look, for the following sl@0: * reasons: sl@0: * sl@0: * 1. New handlers can get added to the list while the current sl@0: * one is being processed. If new ones get added, we don't sl@0: * want to process them during this pass through the list to avoid sl@0: * starving other event sources. This is implemented using the sl@0: * token number in the handler: new handlers will have a sl@0: * newer token than any of the ones currently on the list. sl@0: * 2. The handler can call Tcl_DoOneEvent, so we have to remove sl@0: * the handler from the list before calling it. Otherwise an sl@0: * infinite loop could result. sl@0: * 3. Tcl_DeleteTimerHandler can be called to remove an element from sl@0: * the list while a handler is executing, so the list could sl@0: * change structure during the call. sl@0: * 4. Because we only fetch the current time before entering the loop, sl@0: * the only way a new timer will even be considered runnable is if sl@0: * its expiration time is within the same millisecond as the sl@0: * current time. This is fairly likely on Windows, since it has sl@0: * a course granularity clock. Since timers are placed sl@0: * on the queue in time order with the most recently created sl@0: * handler appearing after earlier ones with the same expiration sl@0: * time, we don't have to worry about newer generation timers sl@0: * appearing before later ones. sl@0: */ sl@0: sl@0: tsdPtr->timerPending = 0; sl@0: currentTimerId = tsdPtr->lastTimerId; sl@0: Tcl_GetTime(&time); sl@0: while (1) { sl@0: nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; sl@0: timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; sl@0: if (timerHandlerPtr == NULL) { sl@0: break; sl@0: } sl@0: sl@0: if ((timerHandlerPtr->time.sec > time.sec) sl@0: || ((timerHandlerPtr->time.sec == time.sec) sl@0: && (timerHandlerPtr->time.usec > time.usec))) { sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * Bail out if the next timer is of a newer generation. sl@0: */ sl@0: sl@0: if ((currentTimerId - (int)timerHandlerPtr->token) < 0) { sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * Remove the handler from the queue before invoking it, sl@0: * to avoid potential reentrancy problems. sl@0: */ sl@0: sl@0: (*nextPtrPtr) = timerHandlerPtr->nextPtr; sl@0: (*timerHandlerPtr->proc)(timerHandlerPtr->clientData); sl@0: ckfree((char *) timerHandlerPtr); sl@0: } sl@0: TimerSetupProc(NULL, TCL_TIMER_EVENTS); sl@0: return 1; sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------- sl@0: * sl@0: * Tcl_DoWhenIdle -- sl@0: * sl@0: * Arrange for proc to be invoked the next time the system is sl@0: * idle (i.e., just before the next time that Tcl_DoOneEvent sl@0: * would have to wait for something to happen). sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Proc will eventually be called, with clientData as argument. sl@0: * See the manual entry for details. sl@0: * sl@0: *-------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_DoWhenIdle(proc, clientData) sl@0: Tcl_IdleProc *proc; /* Procedure to invoke. */ sl@0: ClientData clientData; /* Arbitrary value to pass to proc. */ sl@0: { sl@0: register IdleHandler *idlePtr; sl@0: Tcl_Time blockTime; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); sl@0: idlePtr->proc = proc; sl@0: idlePtr->clientData = clientData; sl@0: idlePtr->generation = tsdPtr->idleGeneration; sl@0: idlePtr->nextPtr = NULL; sl@0: if (tsdPtr->lastIdlePtr == NULL) { sl@0: tsdPtr->idleList = idlePtr; sl@0: } else { sl@0: tsdPtr->lastIdlePtr->nextPtr = idlePtr; sl@0: } sl@0: tsdPtr->lastIdlePtr = idlePtr; sl@0: sl@0: blockTime.sec = 0; sl@0: blockTime.usec = 0; sl@0: Tcl_SetMaxBlockTime(&blockTime); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_CancelIdleCall -- sl@0: * sl@0: * If there are any when-idle calls requested to a given procedure sl@0: * with given clientData, cancel all of them. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * If the proc/clientData combination were on the when-idle list, sl@0: * they are removed so that they will never be called. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_CancelIdleCall(proc, clientData) sl@0: Tcl_IdleProc *proc; /* Procedure that was previously registered. */ sl@0: ClientData clientData; /* Arbitrary value to pass to proc. */ sl@0: { sl@0: register IdleHandler *idlePtr, *prevPtr; sl@0: IdleHandler *nextPtr; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; sl@0: prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { sl@0: while ((idlePtr->proc == proc) sl@0: && (idlePtr->clientData == clientData)) { sl@0: nextPtr = idlePtr->nextPtr; sl@0: ckfree((char *) idlePtr); sl@0: idlePtr = nextPtr; sl@0: if (prevPtr == NULL) { sl@0: tsdPtr->idleList = idlePtr; sl@0: } else { sl@0: prevPtr->nextPtr = idlePtr; sl@0: } sl@0: if (idlePtr == NULL) { sl@0: tsdPtr->lastIdlePtr = prevPtr; sl@0: return; sl@0: } sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclServiceIdle -- sl@0: * sl@0: * This procedure is invoked by the notifier when it becomes sl@0: * idle. It will invoke all idle handlers that are present at sl@0: * the time the call is invoked, but not those added during idle sl@0: * processing. sl@0: * sl@0: * Results: sl@0: * The return value is 1 if TclServiceIdle found something to sl@0: * do, otherwise return value is 0. sl@0: * sl@0: * Side effects: sl@0: * Invokes all pending idle handlers. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclServiceIdle() sl@0: { sl@0: IdleHandler *idlePtr; sl@0: int oldGeneration; sl@0: Tcl_Time blockTime; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: if (tsdPtr->idleList == NULL) { sl@0: return 0; sl@0: } sl@0: sl@0: oldGeneration = tsdPtr->idleGeneration; sl@0: tsdPtr->idleGeneration++; sl@0: sl@0: /* sl@0: * The code below is trickier than it may look, for the following sl@0: * reasons: sl@0: * sl@0: * 1. New handlers can get added to the list while the current sl@0: * one is being processed. If new ones get added, we don't sl@0: * want to process them during this pass through the list (want sl@0: * to check for other work to do first). This is implemented sl@0: * using the generation number in the handler: new handlers sl@0: * will have a different generation than any of the ones currently sl@0: * on the list. sl@0: * 2. The handler can call Tcl_DoOneEvent, so we have to remove sl@0: * the handler from the list before calling it. Otherwise an sl@0: * infinite loop could result. sl@0: * 3. Tcl_CancelIdleCall can be called to remove an element from sl@0: * the list while a handler is executing, so the list could sl@0: * change structure during the call. sl@0: */ sl@0: sl@0: for (idlePtr = tsdPtr->idleList; sl@0: ((idlePtr != NULL) sl@0: && ((oldGeneration - idlePtr->generation) >= 0)); sl@0: idlePtr = tsdPtr->idleList) { sl@0: tsdPtr->idleList = idlePtr->nextPtr; sl@0: if (tsdPtr->idleList == NULL) { sl@0: tsdPtr->lastIdlePtr = NULL; sl@0: } sl@0: (*idlePtr->proc)(idlePtr->clientData); sl@0: ckfree((char *) idlePtr); sl@0: } sl@0: if (tsdPtr->idleList) { sl@0: blockTime.sec = 0; sl@0: blockTime.usec = 0; sl@0: Tcl_SetMaxBlockTime(&blockTime); sl@0: } sl@0: return 1; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_AfterObjCmd -- sl@0: * sl@0: * This procedure is invoked to process the "after" Tcl command. sl@0: * See the user documentation for details on what it does. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * See the user documentation. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: /* ARGSUSED */ sl@0: int sl@0: Tcl_AfterObjCmd(clientData, interp, objc, objv) sl@0: ClientData clientData; /* Unused */ sl@0: Tcl_Interp *interp; /* Current interpreter. */ sl@0: int objc; /* Number of arguments. */ sl@0: Tcl_Obj *CONST objv[]; /* Argument objects. */ sl@0: { sl@0: int ms; sl@0: AfterInfo *afterPtr; sl@0: AfterAssocData *assocPtr; sl@0: int length; sl@0: char *argString; sl@0: int index; sl@0: char buf[16 + TCL_INTEGER_SPACE]; sl@0: static CONST char *afterSubCmds[] = { sl@0: "cancel", "idle", "info", (char *) NULL sl@0: }; sl@0: enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; sl@0: ThreadSpecificData *tsdPtr = InitTimer(); sl@0: sl@0: if (objc < 2) { sl@0: Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * Create the "after" information associated for this interpreter, sl@0: * if it doesn't already exist. sl@0: */ sl@0: sl@0: assocPtr = Tcl_GetAssocData( interp, "tclAfter", NULL ); sl@0: if (assocPtr == NULL) { sl@0: assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData)); sl@0: assocPtr->interp = interp; sl@0: assocPtr->firstAfterPtr = NULL; sl@0: Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, sl@0: (ClientData) assocPtr); sl@0: } sl@0: sl@0: /* sl@0: * First lets see if the command was passed a number as the first argument. sl@0: */ sl@0: sl@0: if (objv[1]->typePtr == &tclIntType) { sl@0: ms = (int) objv[1]->internalRep.longValue; sl@0: goto processInteger; sl@0: } sl@0: argString = Tcl_GetStringFromObj(objv[1], &length); sl@0: if (argString[0] == '+' || argString[0] == '-' sl@0: || isdigit(UCHAR(argString[0]))) { /* INTL: digit */ sl@0: if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { sl@0: return TCL_ERROR; sl@0: } sl@0: processInteger: sl@0: if (ms < 0) { sl@0: ms = 0; sl@0: } sl@0: if (objc == 2) { sl@0: Tcl_Sleep(ms); sl@0: return TCL_OK; sl@0: } sl@0: afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); sl@0: afterPtr->assocPtr = assocPtr; sl@0: if (objc == 3) { sl@0: afterPtr->commandPtr = objv[2]; sl@0: } else { sl@0: afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); sl@0: } sl@0: Tcl_IncrRefCount(afterPtr->commandPtr); sl@0: /* sl@0: * The variable below is used to generate unique identifiers for sl@0: * after commands. This id can wrap around, which can potentially sl@0: * cause problems. However, there are not likely to be problems sl@0: * in practice, because after commands can only be requested to sl@0: * about a month in the future, and wrap-around is unlikely to sl@0: * occur in less than about 1-10 years. Thus it's unlikely that sl@0: * any old ids will still be around when wrap-around occurs. sl@0: */ sl@0: afterPtr->id = tsdPtr->afterId; sl@0: tsdPtr->afterId += 1; sl@0: afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc, sl@0: (ClientData) afterPtr); sl@0: afterPtr->nextPtr = assocPtr->firstAfterPtr; sl@0: assocPtr->firstAfterPtr = afterPtr; sl@0: sprintf(buf, "after#%d", afterPtr->id); sl@0: Tcl_AppendResult(interp, buf, (char *) NULL); sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * If it's not a number it must be a subcommand. sl@0: */ sl@0: sl@0: if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument", sl@0: 0, &index) != TCL_OK) { sl@0: Tcl_AppendResult(interp, "bad argument \"", argString, sl@0: "\": must be cancel, idle, info, or a number", sl@0: (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: switch ((enum afterSubCmds) index) { sl@0: case AFTER_CANCEL: { sl@0: Tcl_Obj *commandPtr; sl@0: char *command, *tempCommand; sl@0: int tempLength; sl@0: sl@0: if (objc < 3) { sl@0: Tcl_WrongNumArgs(interp, 2, objv, "id|command"); sl@0: return TCL_ERROR; sl@0: } sl@0: if (objc == 3) { sl@0: commandPtr = objv[2]; sl@0: } else { sl@0: commandPtr = Tcl_ConcatObj(objc-2, objv+2);; sl@0: } sl@0: command = Tcl_GetStringFromObj(commandPtr, &length); sl@0: for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; sl@0: afterPtr = afterPtr->nextPtr) { sl@0: tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, sl@0: &tempLength); sl@0: if ((length == tempLength) sl@0: && (memcmp((void*) command, (void*) tempCommand, sl@0: (unsigned) length) == 0)) { sl@0: break; sl@0: } sl@0: } sl@0: if (afterPtr == NULL) { sl@0: afterPtr = GetAfterEvent(assocPtr, commandPtr); sl@0: } sl@0: if (objc != 3) { sl@0: Tcl_DecrRefCount(commandPtr); sl@0: } sl@0: if (afterPtr != NULL) { sl@0: if (afterPtr->token != NULL) { sl@0: Tcl_DeleteTimerHandler(afterPtr->token); sl@0: } else { sl@0: Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); sl@0: } sl@0: FreeAfterPtr(afterPtr); sl@0: } sl@0: break; sl@0: } sl@0: case AFTER_IDLE: sl@0: if (objc < 3) { sl@0: Tcl_WrongNumArgs(interp, 2, objv, "script script ..."); sl@0: return TCL_ERROR; sl@0: } sl@0: afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); sl@0: afterPtr->assocPtr = assocPtr; sl@0: if (objc == 3) { sl@0: afterPtr->commandPtr = objv[2]; sl@0: } else { sl@0: afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); sl@0: } sl@0: Tcl_IncrRefCount(afterPtr->commandPtr); sl@0: afterPtr->id = tsdPtr->afterId; sl@0: tsdPtr->afterId += 1; sl@0: afterPtr->token = NULL; sl@0: afterPtr->nextPtr = assocPtr->firstAfterPtr; sl@0: assocPtr->firstAfterPtr = afterPtr; sl@0: Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr); sl@0: sprintf(buf, "after#%d", afterPtr->id); sl@0: Tcl_AppendResult(interp, buf, (char *) NULL); sl@0: break; sl@0: case AFTER_INFO: { sl@0: Tcl_Obj *resultListPtr; sl@0: sl@0: if (objc == 2) { sl@0: for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; sl@0: afterPtr = afterPtr->nextPtr) { sl@0: if (assocPtr->interp == interp) { sl@0: sprintf(buf, "after#%d", afterPtr->id); sl@0: Tcl_AppendElement(interp, buf); sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: if (objc != 3) { sl@0: Tcl_WrongNumArgs(interp, 2, objv, "?id?"); sl@0: return TCL_ERROR; sl@0: } sl@0: afterPtr = GetAfterEvent(assocPtr, objv[2]); sl@0: if (afterPtr == NULL) { sl@0: Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]), sl@0: "\" doesn't exist", (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: resultListPtr = Tcl_GetObjResult(interp); sl@0: Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); sl@0: Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( sl@0: (afterPtr->token == NULL) ? "idle" : "timer", -1)); sl@0: Tcl_SetObjResult(interp, resultListPtr); sl@0: break; sl@0: } sl@0: default: { sl@0: panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetAfterEvent -- sl@0: * sl@0: * This procedure parses an "after" id such as "after#4" and sl@0: * returns a pointer to the AfterInfo structure. sl@0: * sl@0: * Results: sl@0: * The return value is either a pointer to an AfterInfo structure, sl@0: * if one is found that corresponds to "cmdString" and is for interp, sl@0: * or NULL if no corresponding after event can be found. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static AfterInfo * sl@0: GetAfterEvent(assocPtr, commandPtr) sl@0: AfterAssocData *assocPtr; /* Points to "after"-related information for sl@0: * this interpreter. */ sl@0: Tcl_Obj *commandPtr; sl@0: { sl@0: char *cmdString; /* Textual identifier for after event, such sl@0: * as "after#6". */ sl@0: AfterInfo *afterPtr; sl@0: int id; sl@0: char *end; sl@0: sl@0: cmdString = Tcl_GetString(commandPtr); sl@0: if (strncmp(cmdString, "after#", 6) != 0) { sl@0: return NULL; sl@0: } sl@0: cmdString += 6; sl@0: id = strtoul(cmdString, &end, 10); sl@0: if ((end == cmdString) || (*end != 0)) { sl@0: return NULL; sl@0: } sl@0: for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; sl@0: afterPtr = afterPtr->nextPtr) { sl@0: if (afterPtr->id == id) { sl@0: return afterPtr; sl@0: } sl@0: } sl@0: return NULL; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * AfterProc -- sl@0: * sl@0: * Timer callback to execute commands registered with the sl@0: * "after" command. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Executes whatever command was specified. If the command sl@0: * returns an error, then the command "bgerror" is invoked sl@0: * to process the error; if bgerror fails then information sl@0: * about the error is output on stderr. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: AfterProc(clientData) sl@0: ClientData clientData; /* Describes command to execute. */ sl@0: { sl@0: AfterInfo *afterPtr = (AfterInfo *) clientData; sl@0: AfterAssocData *assocPtr = afterPtr->assocPtr; sl@0: AfterInfo *prevPtr; sl@0: int result; sl@0: Tcl_Interp *interp; sl@0: char *script; sl@0: int numBytes; sl@0: sl@0: /* sl@0: * First remove the callback from our list of callbacks; otherwise sl@0: * someone could delete the callback while it's being executed, which sl@0: * could cause a core dump. sl@0: */ sl@0: sl@0: if (assocPtr->firstAfterPtr == afterPtr) { sl@0: assocPtr->firstAfterPtr = afterPtr->nextPtr; sl@0: } else { sl@0: for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; sl@0: prevPtr = prevPtr->nextPtr) { sl@0: /* Empty loop body. */ sl@0: } sl@0: prevPtr->nextPtr = afterPtr->nextPtr; sl@0: } sl@0: sl@0: /* sl@0: * Execute the callback. sl@0: */ sl@0: sl@0: interp = assocPtr->interp; sl@0: Tcl_Preserve((ClientData) interp); sl@0: script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes); sl@0: result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL); sl@0: if (result != TCL_OK) { sl@0: Tcl_AddErrorInfo(interp, "\n (\"after\" script)"); sl@0: Tcl_BackgroundError(interp); sl@0: } sl@0: Tcl_Release((ClientData) interp); sl@0: sl@0: /* sl@0: * Free the memory for the callback. sl@0: */ sl@0: sl@0: Tcl_DecrRefCount(afterPtr->commandPtr); sl@0: ckfree((char *) afterPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * FreeAfterPtr -- sl@0: * sl@0: * This procedure removes an "after" command from the list of sl@0: * those that are pending and frees its resources. This procedure sl@0: * does *not* cancel the timer handler; if that's needed, the sl@0: * caller must do it. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * The memory associated with afterPtr is released. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: FreeAfterPtr(afterPtr) sl@0: AfterInfo *afterPtr; /* Command to be deleted. */ sl@0: { sl@0: AfterInfo *prevPtr; sl@0: AfterAssocData *assocPtr = afterPtr->assocPtr; sl@0: sl@0: if (assocPtr->firstAfterPtr == afterPtr) { sl@0: assocPtr->firstAfterPtr = afterPtr->nextPtr; sl@0: } else { sl@0: for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; sl@0: prevPtr = prevPtr->nextPtr) { sl@0: /* Empty loop body. */ sl@0: } sl@0: prevPtr->nextPtr = afterPtr->nextPtr; sl@0: } sl@0: Tcl_DecrRefCount(afterPtr->commandPtr); sl@0: ckfree((char *) afterPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * AfterCleanupProc -- sl@0: * sl@0: * This procedure is invoked whenever an interpreter is deleted sl@0: * to cleanup the AssocData for "tclAfter". sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * After commands are removed. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: /* ARGSUSED */ sl@0: static void sl@0: AfterCleanupProc(clientData, interp) sl@0: ClientData clientData; /* Points to AfterAssocData for the sl@0: * interpreter. */ sl@0: Tcl_Interp *interp; /* Interpreter that is being deleted. */ sl@0: { sl@0: AfterAssocData *assocPtr = (AfterAssocData *) clientData; sl@0: AfterInfo *afterPtr; sl@0: sl@0: while (assocPtr->firstAfterPtr != NULL) { sl@0: afterPtr = assocPtr->firstAfterPtr; sl@0: assocPtr->firstAfterPtr = afterPtr->nextPtr; sl@0: if (afterPtr->token != NULL) { sl@0: Tcl_DeleteTimerHandler(afterPtr->token); sl@0: } else { sl@0: Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); sl@0: } sl@0: Tcl_DecrRefCount(afterPtr->commandPtr); sl@0: ckfree((char *) afterPtr); sl@0: } sl@0: ckfree((char *) assocPtr); sl@0: }