/* * 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. */ #include "tclInt.h" /* * 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. */ Tcl_Obj *selfPtr; /* Points to the handle object (self) */ unsigned int id; /* Integer identifier for command */ struct AfterInfo *nextPtr; /* Next in list of all "after" commands for * this interpreter. */ struct AfterInfo *prevPtr; /* Prev 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. */ AfterInfo *lastAfterPtr; /* Last in list of all "after" commands. */ } AfterAssocData; /* * 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 { Tcl_WideInt relTimerBase; /* Time base of the first known relative */ /* timer, used to revert all events to the new * base after possible time-jump (adjustment).*/ TclTimerEvent *promptList; /* First immediate event in queue. */ TclTimerEvent *promptTail; /* Last immediate event in queue. */ TclTimerEvent *relTimerList;/* First event in queue of relative timers. */ TclTimerEvent *relTimerTail;/* Last event in queue of relative timers. */ TclTimerEvent *absTimerList;/* First event in queue of absolute timers. */ TclTimerEvent *absTimerTail;/* Last event in queue of absolute timers. */ size_t timerListEpoch; /* Used for safe process of event queue (stop * the cycle after modifying of event queue) */ int lastTimerId; /* Timer identifier of most recently created * timer event. */ int timerPending; /* 1 if a timer event is in the queue. */ TclTimerEvent *idleList; /* First in list of all idle handlers. */ TclTimerEvent *idleTail; /* Last in list (or NULL for empty list). */ size_t timerGeneration; /* Used to fill in the "generation" fields of */ size_t idleGeneration; /* timer or idle structures. Increments each * time we place a new handler to queue inside, * a new loop, so that all old handlers can be * called without calling any of the new ones * created by old ones. */ unsigned int afterId; /* For unique identifiers of after events. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Helper macros to wrap AfterInfo and handlers (and vice versa) */ #define TclpTimerEvent2AfterInfo(ptr) \ ( (AfterInfo*)TclpTimerEvent2ExtraData(ptr) ) #define TclpAfterInfo2TimerEvent(ptr) \ TclpExtraData2TimerEvent(ptr) #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) /* * 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 functions referenced only in this file: */ static void AfterCleanupProc(ClientData clientData, Tcl_Interp *interp); static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt usec, int absolute); static void AfterProc(ClientData clientData); static void FreeAfterPtr(ClientData clientData); static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *objPtr); static ThreadSpecificData *InitTimer(void); static void TimerExitProc(ClientData clientData); static void TimerCheckProc(ClientData clientData, int flags); static void TimerSetupProc(ClientData clientData, int flags); static void AfterObj_DupInternalRep(Tcl_Obj *, Tcl_Obj *); static void AfterObj_FreeInternalRep(Tcl_Obj *); static void AfterObj_UpdateString(Tcl_Obj *); /* * Type definition. */ Tcl_ObjType afterObjType = { "after", /* name */ AfterObj_FreeInternalRep, /* freeIntRepProc */ AfterObj_DupInternalRep, /* dupIntRepProc */ AfterObj_UpdateString, /* updateStringProc */ NULL /* setFromAnyProc */ }; /* *---------------------------------------------------------------------- */ static void AfterObj_DupInternalRep(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { /* * Because we should have only a single reference to the after event, * we'll copy string representation only. */ if (dupPtr->bytes == NULL) { if (srcPtr->bytes == NULL) { AfterObj_UpdateString(srcPtr); } if (srcPtr->bytes != tclEmptyStringRep) { TclInitStringRep(dupPtr, srcPtr->bytes, srcPtr->length); } else { dupPtr->bytes = tclEmptyStringRep; } } } /* *---------------------------------------------------------------------- */ static void AfterObj_FreeInternalRep(objPtr) Tcl_Obj *objPtr; { /* * Because we should always have a reference by active after event, * so it is a triggered / canceled event - just reset type and pointers */ objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; /* prevent no string representation bug */ if (objPtr->bytes == NULL) { objPtr->length = 0; objPtr->bytes = tclEmptyStringRep; } } /* *---------------------------------------------------------------------- */ static void AfterObj_UpdateString(objPtr) Tcl_Obj *objPtr; { char buf[16 + TCL_INTEGER_SPACE]; int len; AfterInfo *afterPtr = (AfterInfo*)objPtr->internalRep.twoPtrValue.ptr1; /* if already triggered / canceled - equivalent not found, we can use empty */ if (!afterPtr) { objPtr->length = 0; objPtr->bytes = tclEmptyStringRep; return; } len = sprintf(buf, "after#%u", afterPtr->id); objPtr->length = len; objPtr->bytes = ckalloc((size_t)++len); if (objPtr->bytes) memcpy(objPtr->bytes, buf, len); } /* *---------------------------------------------------------------------- */ Tcl_Obj* GetAfterObj( AfterInfo *afterPtr) { Tcl_Obj * objPtr = afterPtr->selfPtr; if (objPtr != NULL) { return objPtr; } TclNewObj(objPtr); objPtr->typePtr = &afterObjType; objPtr->bytes = NULL; objPtr->internalRep.twoPtrValue.ptr1 = afterPtr; objPtr->internalRep.twoPtrValue.ptr2 = NULL; Tcl_IncrRefCount(objPtr); afterPtr->selfPtr = objPtr; return objPtr; }; /* *---------------------------------------------------------------------- * * 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 = TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); Tcl_CreateThreadExitHandler(TimerExitProc, NULL); } return tsdPtr; } static void AttachTimerEvent( ThreadSpecificData *tsdPtr, TclTimerEvent *tmrEvent) { TclTimerEvent **tmrList, **tmrTail; tmrEvent->flags |= TCL_TMREV_LISTED; if (tmrEvent->flags & TCL_TMREV_PROMPT) { /* use timer generation, because usually no differences between * call of "after 0" and "after 1" */ tmrEvent->generation = tsdPtr->timerGeneration; /* attach to the prompt queue */ TclSpliceTailEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail); /* execute immediately: signal pending and set timer marker */ tsdPtr->timerPending = 1; TclSetTimerEventMarker(0); return; } if (tmrEvent->flags & TCL_TMREV_IDLE) { /* idle generation */ tmrEvent->generation = tsdPtr->idleGeneration; /* attach to the idle queue */ TclSpliceTailEx(tmrEvent, tsdPtr->idleList, tsdPtr->idleTail); return; } /* current timer generation */ tmrEvent->generation = tsdPtr->timerGeneration; /* * Add the event to the queue in the correct position * (ordered by event firing time). */ tsdPtr->timerListEpoch++; /* signal - timer list was changed */ if (!(tmrEvent->flags & TCL_TMREV_AT)) { tmrList = &tsdPtr->relTimerList; tmrTail = &tsdPtr->relTimerTail; } else { tmrList = &tsdPtr->absTimerList; tmrTail = &tsdPtr->absTimerTail; } /* if before current first (e. g. "after 1" before first "after 1000") */ if ( !(*tmrList) || tmrEvent->time < (*tmrList)->time) { /* splice to the head */ TclSpliceInEx(tmrEvent, *tmrList, *tmrTail); } else { TclTimerEvent *tmrEventPos; Tcl_WideInt usec = tmrEvent->time; /* search from end as long as one with time before not found */ for (tmrEventPos = *tmrTail; tmrEventPos != NULL; tmrEventPos = tmrEventPos->prevPtr) { if (usec >= tmrEventPos->time) { break; } } /* normally it should be always true, because checked above, but ... */ if (tmrEventPos != NULL) { /* insert after found element (with time before new) */ tmrEvent->prevPtr = tmrEventPos; if ((tmrEvent->nextPtr = tmrEventPos->nextPtr)) { tmrEventPos->nextPtr->prevPtr = tmrEvent; } else { *tmrTail = tmrEvent; } tmrEventPos->nextPtr = tmrEvent; } else { /* unexpected case, but ... splice to the head */ TclSpliceInEx(tmrEvent, *tmrList, *tmrTail); } } } static void DetachTimerEvent( ThreadSpecificData *tsdPtr, TclTimerEvent *tmrEvent) { tmrEvent->flags &= ~TCL_TMREV_LISTED; if (tmrEvent->flags & TCL_TMREV_PROMPT) { /* prompt handler */ TclSpliceOutEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail); return; } if (tmrEvent->flags & TCL_TMREV_IDLE) { /* idle handler */ TclSpliceOutEx(tmrEvent, tsdPtr->idleList, tsdPtr->idleTail); return; } /* timer event-handler */ tsdPtr->timerListEpoch++; /* signal - timer list was changed */ if (!(tmrEvent->flags & TCL_TMREV_AT)) { TclSpliceOutEx(tmrEvent, tsdPtr->relTimerList, tsdPtr->relTimerTail); } else { TclSpliceOutEx(tmrEvent, tsdPtr->absTimerList, tsdPtr->absTimerTail); } } static Tcl_WideInt TimerMakeRelativeTime( ThreadSpecificData *tsdPtr, Tcl_WideInt usec) { Tcl_WideInt now = TclpGetUTimeMonotonic(); /* * We should have the ability to ajust end-time of relative events, * for possible time-jumps. */ if (tsdPtr->relTimerList) { /* * end-time = now + usec * Adjust value of usec relative current base (to now), so * end-time = base + relative event-time, which corresponds * original end-time. */ usec += now - tsdPtr->relTimerBase; } else { /* first event here - initial values (base/epoch) */ tsdPtr->relTimerBase = now; } return usec; } /* *---------------------------------------------------------------------- * * 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 = TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); while ((tsdPtr->promptTail) != NULL) { TclpDeleteTimerEvent(tsdPtr->promptTail); } while ((tsdPtr->relTimerTail) != NULL) { TclpDeleteTimerEvent(tsdPtr->relTimerTail); } while ((tsdPtr->absTimerTail) != NULL) { TclpDeleteTimerEvent(tsdPtr->absTimerTail); } while ((tsdPtr->idleTail) != NULL) { TclpDeleteTimerEvent(tsdPtr->idleTail); } } } /* *-------------------------------------------------------------- * * 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. */ { register TclTimerEvent *tmrEvent; Tcl_WideInt usec; /* * Compute when the event should fire (avoid overflow). */ if (milliseconds < 0x7FFFFFFFFFFFFFFFL / 1000) { usec = (Tcl_WideInt)milliseconds*1000; } else { usec = 0x7FFFFFFFFFFFFFFFL; } tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, 0); if (tmrEvent == NULL) { return NULL; } tmrEvent->clientData = clientData; return tmrEvent->token; } /* *-------------------------------------------------------------- * * TclpCreateTimerEvent -- * * Arrange for a given function to be invoked at or in a particular time * in the future (microseconds). * * Results: * The return value is a handler entry of the timer event, which may be * used to access the event entry, e. g. delete the event before it fires. * * Side effects: * When the time or offset in timePtr has been reached, proc will be invoked * exactly once. * *-------------------------------------------------------------- */ TclTimerEvent* TclpCreateTimerEvent( Tcl_WideInt usec, /* Time to be invoked (absolute/relative) */ Tcl_TimerProc *proc, /* Function to invoke */ Tcl_TimerDeleteProc *deleteProc,/* Function to cleanup */ size_t extraDataSize, /* Size of extra data to allocate */ int flags) /* Flags corresponding type of event */ { register TclTimerEvent *tmrEvent; ThreadSpecificData *tsdPtr; tsdPtr = InitTimer(); tmrEvent = (TclTimerEvent *)ckalloc( sizeof(TclTimerEvent) + extraDataSize); if (tmrEvent == NULL) { return NULL; } if (usec <= 0 && !(flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) { usec = 0; flags |= TCL_TMREV_PROMPT; } /* * Fill in fields for the event. */ tmrEvent->proc = proc; tmrEvent->deleteProc = deleteProc; tmrEvent->clientData = TclpTimerEvent2ExtraData(tmrEvent); tmrEvent->flags = flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE); tsdPtr->lastTimerId++; tmrEvent->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); /* * If TCL_TMREV_AT (and TCL_TMREV_PROMPT) are not specified, event observes * due-time considering possible time-jump. */ if (!(flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) { /* relative event - realign time using current relative base */ usec = TimerMakeRelativeTime(tsdPtr, usec); } tmrEvent->time = usec; tmrEvent->refCount = 0; /* * Attach the event to the corresponding queue in the correct position * (ordered by event firing time, if time specified). */ AttachTimerEvent(tsdPtr, tmrEvent); return tmrEvent; } /* *-------------------------------------------------------------- * * TclpCreatePromptTimerEvent -- * * Arrange for proc to be invoked delayed (but prompt) as timer event, * without time ("after 0"). * Or as idle event (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). * * Providing the flag TCL_TMREV_PROMPT ensures that timer event-handler * will be queued immediately to guarantee the execution of timer-event * as soon as possible * * Results: * Returns the created timer entry. * * Side effects: * None. * *-------------------------------------------------------------- */ TclTimerEvent * TclpCreatePromptTimerEvent( Tcl_TimerProc *proc, /* Function to invoke. */ Tcl_TimerDeleteProc *deleteProc, /* Function to cleanup */ size_t extraDataSize, int flags) { register TclTimerEvent *tmrEvent; ThreadSpecificData *tsdPtr = InitTimer(); tmrEvent = (TclTimerEvent *) ckalloc(sizeof(TclTimerEvent) + extraDataSize); if (tmrEvent == NULL) { return NULL; } tmrEvent->proc = proc; tmrEvent->deleteProc = deleteProc; tmrEvent->clientData = TclpTimerEvent2ExtraData(tmrEvent); tmrEvent->flags = flags; tmrEvent->time = 0; tmrEvent->refCount = 0; AttachTimerEvent(tsdPtr, tmrEvent); return tmrEvent; } /* *-------------------------------------------------------------- * * TclCreateAbsoluteTimerHandler -- * * Arrange for a given function to be invoked at a particular time in the * future (absolute time). * * Results: * The return value is a token of 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 TclTimerEvent *tmrEvent; Tcl_WideInt usec; /* * Compute when the event should fire (avoid overflow). */ if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) { usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec; } else { usec = 0x7FFFFFFFFFFFFFFFL; } tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, TCL_TMREV_AT); if (tmrEvent == NULL) { return NULL; } tmrEvent->clientData = clientData; return tmrEvent->token; } /* *-------------------------------------------------------------- * * TclCreateRelativeTimerHandler -- * * Arrange for a given function to be invoked in a particular time offset * in the future. * * Results: * The return value is token of the timer event, which * may be used to delete the event before it fires. * * Side effects: * In contrary to absolute timer functions operate on relative time. * *-------------------------------------------------------------- */ Tcl_TimerToken TclCreateTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData, int flags) { register TclTimerEvent *tmrEvent; Tcl_WideInt usec; /* * Compute when the event should fire (avoid overflow). */ if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) { usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec; } else { usec = 0x7FFFFFFFFFFFFFFFL; } tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, flags); if (tmrEvent == NULL) { return NULL; } tmrEvent->clientData = clientData; return tmrEvent->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_CreateTimerHandler. */ { register TclTimerEvent *tmrEvent; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } for (tmrEvent = tsdPtr->relTimerTail; tmrEvent != NULL; tmrEvent = tmrEvent->prevPtr ) { if (tmrEvent->token != token) { continue; } TclpDeleteTimerEvent(tmrEvent); return; } for (tmrEvent = tsdPtr->absTimerTail; tmrEvent != NULL; tmrEvent = tmrEvent->prevPtr ) { if (tmrEvent->token != token) { continue; } TclpDeleteTimerEvent(tmrEvent); return; } } /* *-------------------------------------------------------------- * * TclpDeleteTimerEvent -- * * Delete a previously-registered prompt, timer or idle handler. * * Results: * None. * * Side effects: * Destroy the timer callback, so that its associated function will * not be called. If the callback has already fired this will be executed * internally. * *-------------------------------------------------------------- */ void TclpDeleteTimerEvent( TclTimerEvent *tmrEvent) /* Result previously returned by */ /* TclpCreateTimerEvent or derivatives. */ { ThreadSpecificData *tsdPtr; if (tmrEvent == NULL) { return; } tsdPtr = InitTimer(); /* detach from list */ if (tmrEvent->flags & TCL_TMREV_LISTED) { DetachTimerEvent(tsdPtr, tmrEvent); } /* free it via deleteProc and ckfree */ if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) { /* * Mark this entry will be deleted, so it can avoid double delete and * caller can check in delete callback, the time entry handle is still * the same (was not overriden in some recursive async-envent). */ tmrEvent->flags |= TCL_TMREV_DELETE; (*tmrEvent->deleteProc)(tmrEvent->clientData); } /* if frozen somewhere (nested service cycle) */ if (tmrEvent->refCount > 0) { /* do nothing - event will be automatically deleted hereafter */ return; } ckfree(tmrEvent); } TclTimerEvent * TclpProlongTimerEvent( TclTimerEvent *tmrEvent, Tcl_WideInt usec, int flags) { #if 0 return NULL; #else ThreadSpecificData *tsdPtr = InitTimer(); if (tmrEvent->flags & TCL_TMREV_DELETE) { return NULL; } /* if still belong to the queue, detach it from corresponding list */ if (tmrEvent->flags & TCL_TMREV_LISTED) { DetachTimerEvent(tsdPtr, tmrEvent); } /* set wanted flags and prolong */ tmrEvent->flags |= (flags & (TCL_TMREV_AT|TCL_TMREV_PROMPT|TCL_TMREV_IDLE)); /* new firing time */ if (!(flags & (TCL_TMREV_PROMPT|TCL_TMREV_IDLE))) { /* if relative event - realign time using current relative base */ if (!(flags & TCL_TMREV_AT)) { usec = TimerMakeRelativeTime(tsdPtr, usec); } tmrEvent->time = usec; } /* attach to the queue again (new generation) */ AttachTimerEvent(tsdPtr, tmrEvent); return tmrEvent; #endif } /* *-------------------------------------------------------------- * * TimerGetDueTime -- * * Find the execution time offset of first relative or absolute timer * starting from given heads. * * Results: * A wide integer representing the due time (as microseconds) of first * timer event to execute. * * Side effects: * If time-jump recognized, may adjust the base for relative timers. * *-------------------------------------------------------------- */ static Tcl_WideInt TimerGetDueTime( ThreadSpecificData *tsdPtr, TclTimerEvent *relTimerList, TclTimerEvent *absTimerList, TclTimerEvent **dueEventPtr) { TclTimerEvent *tmrEvent; Tcl_WideInt timeOffs = 0x7FFFFFFFFFFFFFFFL; /* find shortest due-time */ if ((tmrEvent = relTimerList) != NULL) { /* offset to now (monotonic base) */ timeOffs = tsdPtr->relTimerBase + tmrEvent->time - TclpGetUTimeMonotonic(); } if (absTimerList) { Tcl_WideInt absOffs; /* offset to now (real-time base) */ absOffs = absTimerList->time - TclpGetMicroseconds(); if (!tmrEvent || absOffs < timeOffs) { tmrEvent = absTimerList; timeOffs = absOffs; } } if (dueEventPtr) { *dueEventPtr = tmrEvent; } return timeOffs; } /* *---------------------------------------------------------------------- * * 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, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; if ( ((flags & TCL_TIMER_EVENTS) && (tsdPtr->timerPending || tsdPtr->promptList)) || ((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList ) ) { /* * There is a pending timer event or an idle handler, so just poll. */ blockTime.sec = 0; blockTime.usec = 0; } else if ( (flags & TCL_TIMER_EVENTS) && (tsdPtr->relTimerList || tsdPtr->absTimerList) ) { /* * Compute the timeout for the next timer on the list. */ Tcl_WideInt timeOffs; timeOffs = TimerGetDueTime(tsdPtr, tsdPtr->relTimerList, tsdPtr->absTimerList, NULL); #ifdef TMR_RES_TOLERANCE /* consider timer resolution tolerance (avoid busy wait) */ timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) * TMR_RES_TOLERANCE / 100; #endif if (timeOffs > 0) { blockTime.sec = 0; if (timeOffs >= 1000000) { /* * Note we use monotonic time by all wait functions, so to * avoid too long wait by the absolute timers (to be able * to trigger it) if time jumped to the expected time, just * let block for maximal 1s if absolute timers available. */ if (tsdPtr->absTimerList) { /* we've some absolute timers - won't wait longer as 1s. */ timeOffs = 1000000; } blockTime.sec = (long) (timeOffs / 1000000); blockTime.usec = (unsigned long)(timeOffs % 1000000); } else { blockTime.sec = 0; blockTime.usec = (unsigned long)timeOffs; } } else { 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 the first timer in the list. * * Results: * None. * * Side effects: * May queue an event and update the maximum notifier block time. * *---------------------------------------------------------------------- */ static void TimerCheckProc( ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_WideInt timeOffs = 0; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; if (!(flags & TCL_TIMER_EVENTS)) { return; } if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; /* If already pending (or prompt-events) */ if (tsdPtr->timerPending || tsdPtr->promptList) { goto mark; } /* * Verify the first timer on the queue. */ if (!tsdPtr->relTimerList && !tsdPtr->absTimerList) { return; } timeOffs = TimerGetDueTime(tsdPtr, tsdPtr->relTimerList, tsdPtr->absTimerList, NULL); #ifdef TMR_RES_TOLERANCE /* consider timer resolution tolerance (avoid busy wait) */ timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) * TMR_RES_TOLERANCE / 100; #endif /* * If the first timer has expired, stick an event on the queue. */ if (timeOffs <= 0) { mark: TclSetTimerEventMarker(flags); /* force timer execution */ tsdPtr->timerPending = 1; } } /* *---------------------------------------------------------------------- * * TclServiceTimerEvents -- * * This function is called by Tcl_ServiceEvent when a timer events should * be processed. 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 (no timer events). * Returns -1 if pending timer events available, meaning the marker should * stay on the head of queue. * * Side effects: * Whatever the timer handler callback functions do. * *---------------------------------------------------------------------- */ int TclServiceTimerEvents(void) { TclTimerEvent *tmrEvent, *relTimerList, *absTimerList; size_t currentGeneration, currentEpoch; int result = 0; int prevTmrPending; ThreadSpecificData *tsdPtr = InitTimer(); if (!tsdPtr->timerPending) { return 0; /* no timer events */ } /* * 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 check of the generation epoch. * 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. */ currentGeneration = tsdPtr->timerGeneration++; tsdPtr->timerPending = 0; /* First process all prompt (immediate) events */ while ((tmrEvent = tsdPtr->promptList) != NULL && tmrEvent->generation <= currentGeneration ) { /* freeze / detach entry from the owner's list */ tmrEvent->refCount++; tmrEvent->flags &= ~TCL_TMREV_LISTED; TclSpliceOutEx(tmrEvent, tsdPtr->promptList, tsdPtr->promptTail); /* reset current timer pending (correct process nested wait event) */ prevTmrPending = tsdPtr->timerPending; tsdPtr->timerPending = 0; /* execute event */ (*tmrEvent->proc)(tmrEvent->clientData); result = 1; /* restore current timer pending */ tsdPtr->timerPending += prevTmrPending; /* unfreeze / if used somewhere else (nested) or prolongation (reattached) */ if (tmrEvent->refCount-- > 1 || (tmrEvent->flags & TCL_TMREV_LISTED)) { continue; }; /* free it via deleteProc and ckfree */ if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) { tmrEvent->flags |= TCL_TMREV_DELETE; (*tmrEvent->deleteProc)(tmrEvent->clientData); } ckfree(tmrEvent); } /* if stil pending prompt events (new generation) - repeat event cycle as * soon as possible */ if (tsdPtr->promptList) { tsdPtr->timerPending = 1; return -1; } /* Hereafter all relative and absolute timer events with time before now */ relTimerList = tsdPtr->relTimerList; absTimerList = tsdPtr->absTimerList; while (relTimerList || absTimerList) { Tcl_WideInt timeOffs; /* find timer (absolute/relative) with shortest due-time */ timeOffs = TimerGetDueTime(tsdPtr, relTimerList, absTimerList, &tmrEvent); /* the same tolerance logic as in TimerSetupProc/TimerCheckProc */ #ifdef TMR_RES_TOLERANCE timeOffs -= ((timeOffs <= 1000000) ? timeOffs : 1000000) * TMR_RES_TOLERANCE / 100; #endif /* still not reached */ if (timeOffs > 0) { break; } /* for the next iteration */ if (tmrEvent == relTimerList) { relTimerList = tmrEvent->nextPtr; } else { absTimerList = tmrEvent->nextPtr; } /* * Bypass timers of newer generation. */ if (tmrEvent->generation > currentGeneration) { /* increase pending to signal repeat */ tsdPtr->timerPending++; continue; } tsdPtr->timerListEpoch++; /* signal - timer list was changed */ currentEpoch = tsdPtr->timerListEpoch; /* save it to compare */ /* * Remove the handler from the queue before invoking it, to avoid * potential reentrancy problems. */ tmrEvent->refCount++; /* freeze */ tmrEvent->flags &= ~TCL_TMREV_LISTED; if (!(tmrEvent->flags & TCL_TMREV_AT)) { TclSpliceOutEx(tmrEvent, tsdPtr->relTimerList, tsdPtr->relTimerTail); } else { TclSpliceOutEx(tmrEvent, tsdPtr->absTimerList, tsdPtr->absTimerTail); } /* reset current timer pending (correct process nested wait event) */ prevTmrPending = tsdPtr->timerPending; tsdPtr->timerPending = 0; /* invoke timer proc */ (*tmrEvent->proc)(tmrEvent->clientData); result = 1; /* restore current timer pending */ tsdPtr->timerPending += prevTmrPending; /* unfreeze / if used somewhere else (nested) or prolongation (reattached) */ if (tmrEvent->refCount-- > 1 || (tmrEvent->flags & TCL_TMREV_LISTED)) { goto nextEvent; }; /* free it via deleteProc and ckfree */ if (tmrEvent->deleteProc && !(tmrEvent->flags & TCL_TMREV_DELETE)) { tmrEvent->flags |= TCL_TMREV_DELETE; (*tmrEvent->deleteProc)(tmrEvent->clientData); } ckfree(tmrEvent); nextEvent: /* be sure that timer-list was not changed inside the proc call */ if (currentEpoch != tsdPtr->timerListEpoch) { /* timer-list was changed - stop processing */ tsdPtr->timerPending++; break; } } /* pending timer events, so mark (queue) timer events */ if (tsdPtr->timerPending >= 1) { tsdPtr->timerPending = 1; return -1; } /* Reset generation if both timer queue are empty */ if (!tsdPtr->promptList && !tsdPtr->relTimerList && !tsdPtr->absTimerList) { tsdPtr->timerGeneration = 0; } /* Compute the next timeout (later via TimerSetupProc using the first timer). */ tsdPtr->timerPending = 0; return result; /* processing done, again later via TimerCheckProc */ } /* *-------------------------------------------------------------- * * 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. */ { TclTimerEvent *idlePtr = TclpCreatePromptTimerEvent(proc, NULL, 0, TCL_TMREV_IDLE); if (idlePtr) { idlePtr->clientData = clientData; } } /* *---------------------------------------------------------------------- * * 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 TclTimerEvent *idlePtr, *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); for (idlePtr = tsdPtr->idleList; idlePtr != NULL; idlePtr = nextPtr ) { nextPtr = idlePtr->nextPtr; if ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { /* detach entry from the owner list */ idlePtr->flags &= ~TCL_TMREV_LISTED; TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail); /* free it via deleteProc and ckfree */ if (idlePtr->deleteProc && !(idlePtr->flags & TCL_TMREV_DELETE)) { idlePtr->flags |= TCL_TMREV_DELETE; (*idlePtr->deleteProc)(idlePtr->clientData); } ckfree(idlePtr); } } } /* *---------------------------------------------------------------------- * * TclServiceIdle -- , TclServiceIdleEx -- * * 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 TclServiceIdleEx( int flags, int count) { TclTimerEvent *idlePtr; size_t currentGeneration; ThreadSpecificData *tsdPtr = InitTimer(); if ((idlePtr = tsdPtr->idleList) == NULL) { return 0; } currentGeneration = 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. */ while (idlePtr->generation <= currentGeneration) { /* freeze / detach entry from the owner's list */ idlePtr->refCount++; idlePtr->flags &= ~TCL_TMREV_LISTED; TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail); /* execute event */ (*idlePtr->proc)(idlePtr->clientData); /* unfreeze / if used somewhere else (nested) or prolongation (reattached) */ if (idlePtr->refCount-- > 1 || (idlePtr->flags & TCL_TMREV_LISTED)) { goto nextEvent; }; /* free it via deleteProc and ckfree */ if (idlePtr->deleteProc && !(idlePtr->flags & TCL_TMREV_DELETE)) { idlePtr->flags |= TCL_TMREV_DELETE; (*idlePtr->deleteProc)(idlePtr->clientData); } ckfree(idlePtr); nextEvent: /* * Stop processing idle if idle queue empty, count reached or other * events queued (only if not idle events only to service). */ if ( (idlePtr = tsdPtr->idleList) == NULL || !--count || ((flags & TCL_ALL_EVENTS) != TCL_IDLE_EVENTS && TclPeekEventQueued(flags)) ) { break; } } /* Reset generation */ if (!tsdPtr->idleList) { tsdPtr->idleGeneration = 0; } return 1; } int TclServiceIdle(void) { return TclServiceIdleEx(TCL_ALL_EVENTS, INT_MAX); } /* *---------------------------------------------------------------------- * * TclpGetUTimeFromObj -- * * This function converts numeric tcl-object contains decimal milliseconds, * (using milliseconds base) to time offset in microseconds, * * If input object contains double, the return time has microsecond * precision. * * Results: * A standard Tcl result. * * Side effects: * If possible leaves internal representation unchanged (e. g. integer). * *---------------------------------------------------------------------- */ int TclpGetUTimeFromObj( Tcl_Interp *interp, /* Current interpreter or NULL. */ Tcl_Obj *objPtr, /* Object to read numeric time (in units * corresponding given factor). */ Tcl_WideInt *timePtr, /* Resulting time if converted (in microseconds). */ int factor) /* Current factor of the time-object: * 1 - microseconds, * 1000 - milliseconds, * 1000000 - seconds */ { if (objPtr->typePtr != &tclDoubleType) { Tcl_WideInt tm; if (Tcl_GetWideIntFromObj(NULL, objPtr, &tm) == TCL_OK) { if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */ *timePtr = (tm * factor); return TCL_OK; } *timePtr = 0x7FFFFFFFFFFFFFFFL; return TCL_OK; } } if (1) { double tm; if (Tcl_GetDoubleFromObj(interp, objPtr, &tm) == TCL_OK) { if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */ /* use precise as possible calculation by double (microseconds) */ if (factor == 1) { *timePtr = (Tcl_WideInt)tm; } else { *timePtr = ((Tcl_WideInt)tm * factor) + (((Tcl_WideInt)(tm*factor)) % factor); } return TCL_OK; } *timePtr = 0x7FFFFFFFFFFFFFFFL; return TCL_OK; } } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * 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 usec; /* Number of microseconds to wait (or time to wakeup) */ AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; int index; static const char *afterSubCmds[] = { "at", "cancel", "idle", "info", NULL }; enum afterSubCmds { AFTER_AT, AFTER_CANCEL, AFTER_IDLE, AFTER_INFO }; ThreadSpecificData *tsdPtr = InitTimer(); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?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 = ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; assocPtr->lastAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); } /* * First lets see if the command was passed a number as the first argument. */ index = -1; if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds) || TclpGetUTimeFromObj(NULL, objv[1], &usec, 1000) != TCL_OK ) && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK ) { const char *arg = Tcl_GetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument \"%s\": must be " "at, cancel, idle, info or a time", arg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", arg, NULL); return TCL_ERROR; } /* * At this point, either index = -1 and usec contains the time * to wait, or else index is the index of a subcommand. */ switch (index) { case -1: /* usec already contains time-offset from objv[1] */ /* relative time offset should be positive */ if (usec < 0) { usec = 0; } if (objc == 2) { /* after */ return AfterDelay(interp, usec, 0); } case AFTER_AT: { TclTimerEvent *tmrEvent; int flags = 0; if (index == AFTER_AT) { flags = TCL_TMREV_AT; objc--; objv++; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?option? time"); return TCL_ERROR; } /* get time from object, default factor for "at" - 1000000 (s) */ if (TclpGetUTimeFromObj(interp, objv[1], &usec, 1000000) != TCL_OK) { return TCL_ERROR; } if (objc == 2) { /* after at