tclTimer.c Go to the documentation of this file. /* * 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.31 2008/01/22 20:52:10 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; /* * 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); result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL); 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: */

• ソフトウェア開発
• ホームページ制作
• Doxygen版
• STLport版