diff options
author | sebres <sebres@users.sourceforge.net> | 2017-07-10 08:53:28 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-07-10 08:53:28 (GMT) |
commit | 0682a9d1c29428c039fde55c05a2d45eca36a1a1 (patch) | |
tree | 61f9b018146fc5d79c283977a3ac2863abefd951 /generic/tclTimer.c | |
parent | 4a5d28ee4e72a4e58dc65546f814c1cd71f3accc (diff) | |
parent | 3e7f9a47b4949a000fe065bb42a55163056cc1b7 (diff) | |
download | tcl-0682a9d1c29428c039fde55c05a2d45eca36a1a1.zip tcl-0682a9d1c29428c039fde55c05a2d45eca36a1a1.tar.gz tcl-0682a9d1c29428c039fde55c05a2d45eca36a1a1.tar.bz2 |
merge resp. reintegrate sebres-8-5-event-perf-branch to 8.6
Diffstat (limited to 'generic/tclTimer.c')
-rw-r--r-- | generic/tclTimer.c | 1671 |
1 files changed, 1230 insertions, 441 deletions
diff --git a/generic/tclTimer.c b/generic/tclTimer.c index c10986a..81e79aa 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -13,22 +13,6 @@ #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. @@ -40,15 +24,12 @@ typedef struct AfterInfo { * 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. */ + 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; /* @@ -63,23 +44,10 @@ typedef struct AfterAssocData { 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; /* - * 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. * @@ -91,54 +59,48 @@ typedef struct IdleHandler { * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { - TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ +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. */ + * timer event. */ 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 + 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. */ - int afterId; /* For unique identifiers of after events. */ + unsigned 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); + * Helper macros to wrap AfterInfo and handlers (and vice versa) */ -#define TCL_TIME_BEFORE(t1, t2) \ - (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec)) - -#define TCL_TIME_DIFF_MS(t1, t2) \ - (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ - ((long)(t1).usec - (long)(t2).usec)/1000) +#define 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) /* - * Sleeps under that number of milliseconds don't get double-checked - * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s. - */ - -#define SLEEP_OFFLOAD_GETTIMEOFDAY 20 - -/* * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay. * This is used to limit the maximum lag between interp limit and script * cancellation checks. @@ -152,16 +114,126 @@ static Tcl_ThreadDataKey dataKey; static void AfterCleanupProc(ClientData clientData, Tcl_Interp *interp); -static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms); +static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt usec, + int absolute); static void AfterProc(ClientData clientData); -static void FreeAfterPtr(AfterInfo *afterPtr); -static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, - Tcl_Obj *commandPtr); +static void FreeAfterPtr(ClientData clientData); +static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *objPtr); 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); + +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; +}; /* *---------------------------------------------------------------------- @@ -186,12 +258,140 @@ InitTimer(void) if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); + 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; +} + /* *---------------------------------------------------------------------- * @@ -215,15 +415,20 @@ TimerExitProc( { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); - Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { - register TimerHandler *timerHandlerPtr; + Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); - timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; - while (timerHandlerPtr != NULL) { - tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - ckfree(timerHandlerPtr); - timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; + 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); } } } @@ -253,20 +458,151 @@ Tcl_CreateTimerHandler( Tcl_TimerProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { - Tcl_Time time; + register TclTimerEvent *tmrEvent; + Tcl_WideInt usec; /* - * Compute when the event should fire. + * Compute when the event should fire (avoid overflow). */ - Tcl_GetTime(&time); - time.sec += milliseconds/1000; - time.usec += (milliseconds%1000)*1000; - if (time.usec >= 1000000) { - time.usec -= 1000000; - time.sec += 1; + if (milliseconds < 0x7FFFFFFFFFFFFFFFL / 1000) { + usec = (Tcl_WideInt)milliseconds*1000; + } else { + usec = 0x7FFFFFFFFFFFFFFFL; + } + + tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, 0); + if (tmrEvent == NULL) { + return NULL; } - return TclCreateAbsoluteTimerHandler(&time, proc, clientData); + 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; } /* @@ -275,11 +611,11 @@ Tcl_CreateTimerHandler( * TclCreateAbsoluteTimerHandler -- * * Arrange for a given function to be invoked at a particular time in the - * future. + * future (absolute time). * * Results: - * The return value is a token for the timer event, which may be used to - * delete the event before it fires. + * The return value is a token 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 @@ -294,42 +630,73 @@ TclCreateAbsoluteTimerHandler( Tcl_TimerProc *proc, ClientData clientData) { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; - ThreadSpecificData *tsdPtr = InitTimer(); - - timerHandlerPtr = ckalloc(sizeof(TimerHandler)); + register TclTimerEvent *tmrEvent; + Tcl_WideInt usec; /* - * Fill in fields for the event. + * Compute when the event should fire (avoid overflow). */ - memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time)); - timerHandlerPtr->proc = proc; - timerHandlerPtr->clientData = clientData; - tsdPtr->lastTimerId++; - timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); + 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; /* - * Add the event to the queue in the correct position - * (ordered by event firing time). + * Compute when the event should fire (avoid overflow). */ - 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; + if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) { + usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec; } else { - prevPtr->nextPtr = timerHandlerPtr; + usec = 0x7FFFFFFFFFFFFFFFL; } - TimerSetupProc(NULL, TCL_ALL_EVENTS); + tmrEvent = TclpCreateTimerEvent(usec, proc, NULL, 0, flags); + if (tmrEvent == NULL) { + return NULL; + } + tmrEvent->clientData = clientData; - return timerHandlerPtr->token; + return tmrEvent->token; } /* @@ -353,30 +720,180 @@ TclCreateAbsoluteTimerHandler( void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by - * Tcl_DeleteTimerHandler. */ + * Tcl_CreateTimerHandler. */ { - register TimerHandler *timerHandlerPtr, *prevPtr; + register TclTimerEvent *tmrEvent; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } - for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; - timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, - timerHandlerPtr = timerHandlerPtr->nextPtr) { - if (timerHandlerPtr->token != token) { + for (tmrEvent = tsdPtr->relTimerTail; + tmrEvent != NULL; + tmrEvent = tmrEvent->prevPtr + ) { + if (tmrEvent->token != token) { continue; } - if (prevPtr == NULL) { - tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - } else { - prevPtr->nextPtr = timerHandlerPtr->nextPtr; + + TclpDeleteTimerEvent(tmrEvent); + return; + } + + for (tmrEvent = tsdPtr->absTimerTail; + tmrEvent != NULL; + tmrEvent = tmrEvent->prevPtr + ) { + if (tmrEvent->token != token) { + continue; } - ckfree(timerHandlerPtr); + + 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; +} /* *---------------------------------------------------------------------- @@ -398,37 +915,65 @@ Tcl_DeleteTimerHandler( static void TimerSetupProc( - ClientData data, /* Not used. */ + ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime; - ThreadSpecificData *tsdPtr = InitTimer(); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; - if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) - || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { + if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; + + if ( ((flags & TCL_TIMER_EVENTS) && (tsdPtr->timerPending || tsdPtr->promptList)) + || ((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList ) + ) { /* - * There is an idle handler or a pending timer event, so just poll. + * 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->firstTimerHandlerPtr) { + } else if ( + (flags & TCL_TIMER_EVENTS) + && (tsdPtr->relTimerList || tsdPtr->absTimerList) + ) { /* * Compute the timeout for the next timer on the list. */ + Tcl_WideInt timeOffs; - 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) { + 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; } @@ -442,8 +987,7 @@ TimerSetupProc( * 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. + * source for events. This routine checks the first timer in the list. * * Results: * None. @@ -456,59 +1000,65 @@ TimerSetupProc( static void TimerCheckProc( - ClientData data, /* Not used. */ + ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - Tcl_Event *timerEvPtr; - Tcl_Time blockTime; - ThreadSpecificData *tsdPtr = InitTimer(); + Tcl_WideInt timeOffs = 0; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; - if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { - /* - * Compute the timeout for the next timer on the list. - */ + if (!(flags & TCL_TIMER_EVENTS)) { + return; + } - 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 (tsdPtr == NULL) { tsdPtr = InitTimer(); }; - /* - * If the first timer has expired, stick an event on the queue. - */ + /* If already pending (or prompt-events) */ + if (tsdPtr->timerPending || tsdPtr->promptList) { + goto mark; + } - if (blockTime.sec == 0 && blockTime.usec == 0 && - !tsdPtr->timerPending) { - tsdPtr->timerPending = 1; - timerEvPtr = ckalloc(sizeof(Tcl_Event)); - timerEvPtr->proc = TimerHandlerEventProc; - Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); - } + /* + * 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; } } /* *---------------------------------------------------------------------- * - * TimerHandlerEventProc -- + * TclServiceTimerEvents -- * - * This function is called by Tcl_ServiceEvent when a timer event reaches - * the front of the event queue. This function handles the event by + * 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, 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. + * 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. @@ -516,25 +1066,17 @@ TimerCheckProc( *---------------------------------------------------------------------- */ -static int -TimerHandlerEventProc( - Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to handle, - * such as TCL_FILE_EVENTS. */ +int +TclServiceTimerEvents(void) { - TimerHandler *timerHandlerPtr, **nextPtrPtr; - Tcl_Time time; - int currentTimerId; + TclTimerEvent *tmrEvent, *relTimerList, *absTimerList; + size_t currentGeneration, currentEpoch; + int result = 0; + int prevTmrPending; 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; + if (!tsdPtr->timerPending) { + return 0; /* no timer events */ } /* @@ -543,9 +1085,7 @@ TimerHandlerEventProc( * 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. + * 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. @@ -562,39 +1102,140 @@ TimerHandlerEventProc( * timers appearing before later ones. */ + currentGeneration = tsdPtr->timerGeneration++; tsdPtr->timerPending = 0; - currentTimerId = tsdPtr->lastTimerId; - Tcl_GetTime(&time); - while (1) { - nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; - timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; - if (timerHandlerPtr == NULL) { - break; + + /* 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; + } - if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) { + /* 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; + } + /* - * Bail out if the next timer is of a newer generation. + * Bypass timers of newer generation. */ - if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) { - break; + 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; + } + } - *nextPtrPtr = timerHandlerPtr->nextPtr; - timerHandlerPtr->proc(timerHandlerPtr->clientData); - ckfree(timerHandlerPtr); + /* pending timer events, so mark (queue) timer events */ + if (tsdPtr->timerPending >= 1) { + tsdPtr->timerPending = 1; + return -1; } - TimerSetupProc(NULL, TCL_TIMER_EVENTS); - 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 */ } /* @@ -615,31 +1256,16 @@ TimerHandlerEventProc( * *-------------------------------------------------------------- */ - 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(); + TclTimerEvent *idlePtr = TclpCreatePromptTimerEvent(proc, NULL, 0, TCL_TMREV_IDLE); - idlePtr = 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; + if (idlePtr) { + idlePtr->clientData = clientData; } - tsdPtr->lastIdlePtr = idlePtr; - - blockTime.sec = 0; - blockTime.usec = 0; - Tcl_SetMaxBlockTime(&blockTime); } /* @@ -665,26 +1291,26 @@ Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr, *prevPtr; - IdleHandler *nextPtr; + register TclTimerEvent *idlePtr, *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); - for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; - prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { - while ((idlePtr->proc == proc) + for (idlePtr = tsdPtr->idleList; + idlePtr != NULL; + idlePtr = nextPtr + ) { + nextPtr = idlePtr->nextPtr; + if ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { - nextPtr = idlePtr->nextPtr; - ckfree(idlePtr); - idlePtr = nextPtr; - if (prevPtr == NULL) { - tsdPtr->idleList = idlePtr; - } else { - prevPtr->nextPtr = idlePtr; - } - if (idlePtr == NULL) { - tsdPtr->lastIdlePtr = prevPtr; - return; + /* 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); } } } @@ -692,7 +1318,7 @@ Tcl_CancelIdleCall( /* *---------------------------------------------------------------------- * - * TclServiceIdle -- + * 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 @@ -709,19 +1335,19 @@ Tcl_CancelIdleCall( */ int -TclServiceIdle(void) +TclServiceIdleEx( + int flags, + int count) { - IdleHandler *idlePtr; - int oldGeneration; - Tcl_Time blockTime; + TclTimerEvent *idlePtr; + size_t currentGeneration; ThreadSpecificData *tsdPtr = InitTimer(); - if (tsdPtr->idleList == NULL) { + if ((idlePtr = tsdPtr->idleList) == NULL) { return 0; } - oldGeneration = tsdPtr->idleGeneration; - tsdPtr->idleGeneration++; + currentGeneration = tsdPtr->idleGeneration++; /* * The code below is trickier than it may look, for the following reasons: @@ -740,24 +1366,113 @@ TclServiceIdle(void) * 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; + 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); } - idlePtr->proc(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; + } } - if (tsdPtr->idleList) { - blockTime.sec = 0; - blockTime.usec = 0; - Tcl_SetMaxBlockTime(&blockTime); + + /* 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; +} /* *---------------------------------------------------------------------- @@ -784,16 +1499,20 @@ Tcl_AfterObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_WideInt ms = 0; /* Number of milliseconds to wait */ - Tcl_Time wakeup; + + + + Tcl_WideInt usec; /* Number of microseconds to wait (or time to wakeup) */ AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; int index; - static const char *const afterSubCmds[] = { - "cancel", "idle", "info", NULL + static const char *afterSubCmds[] = { + "at", "cancel", "idle", "info", NULL + }; + enum afterSubCmds { + AFTER_AT, AFTER_CANCEL, AFTER_IDLE, AFTER_INFO }; - enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; ThreadSpecificData *tsdPtr = InitTimer(); if (objc < 2) { @@ -811,6 +1530,7 @@ Tcl_AfterObjCmd( assocPtr = ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; + assocPtr->lastAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); } @@ -818,45 +1538,84 @@ Tcl_AfterObjCmd( * First lets see if the command was passed a number as the first argument. */ - if (objv[1]->typePtr == &tclIntType -#ifndef TCL_WIDE_INT_IS_LONG - || objv[1]->typePtr == &tclWideIntType -#endif - || objv[1]->typePtr == &tclBignumType - || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK)) { - index = -1; - if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { - const char *arg = Tcl_GetString(objv[1]); - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument \"%s\": must be" - " cancel, idle, info, or an integer", arg)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", - arg, NULL); - return TCL_ERROR; - } + 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 ms contains the number of ms + /* + * 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: { - if (ms < 0) { - ms = 0; + case -1: + /* usec already contains time-offset from objv[1] */ + /* relative time offset should be positive */ + if (usec < 0) { + usec = 0; } if (objc == 2) { - return AfterDelay(interp, ms); + /* after <offset> */ + return AfterDelay(interp, usec, 0); } - afterPtr = ckalloc(sizeof(AfterInfo)); + 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 <time> */ + return AfterDelay(interp, usec, flags); + } + } + + if (usec || (index == AFTER_AT)) { + /* after ?at? <time|offset> <command> ... */ + tmrEvent = TclpCreateTimerEvent(usec, AfterProc, + FreeAfterPtr, sizeof(AfterInfo), flags); + } else { + /* after 0 <command> ... */ + tmrEvent = TclpCreatePromptTimerEvent(AfterProc, + FreeAfterPtr, sizeof(AfterInfo), TCL_TMREV_PROMPT); + } + + if (tmrEvent == NULL) { /* error handled in panic */ + return TCL_ERROR; + } + afterPtr = TclpTimerEvent2AfterInfo(tmrEvent); + + /* attach to the list */ afterPtr->assocPtr = assocPtr; + TclSpliceTailEx(afterPtr, + assocPtr->firstAfterPtr, assocPtr->lastAfterPtr); + afterPtr->selfPtr = NULL; + if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { - afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); + afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); } Tcl_IncrRefCount(afterPtr->commandPtr); @@ -870,20 +1629,9 @@ Tcl_AfterObjCmd( * 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, afterPtr); - afterPtr->nextPtr = assocPtr->firstAfterPtr; - assocPtr->firstAfterPtr = afterPtr; - Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); + afterPtr->id = tsdPtr->afterId++; + + Tcl_SetObjResult(interp, GetAfterObj(afterPtr)); return TCL_OK; } case AFTER_CANCEL: { @@ -895,94 +1643,116 @@ Tcl_AfterObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "id|command"); return TCL_ERROR; } + + afterPtr = NULL; 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) + if (commandPtr->typePtr == &afterObjType) { + afterPtr = (AfterInfo*)commandPtr->internalRep.twoPtrValue.ptr1; + } else { + command = Tcl_GetStringFromObj(commandPtr, &length); + for (afterPtr = assocPtr->lastAfterPtr; + afterPtr != NULL; + afterPtr = afterPtr->prevPtr + ) { + tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, + &tempLength); + if ((length == tempLength) && !memcmp(command, tempCommand, (unsigned) length)) { - break; + break; + } } - } - if (afterPtr == NULL) { - afterPtr = GetAfterEvent(assocPtr, commandPtr); - } - if (objc != 3) { - Tcl_DecrRefCount(commandPtr); - } - if (afterPtr != NULL) { - if (afterPtr->token != NULL) { - Tcl_DeleteTimerHandler(afterPtr->token); - } else { - Tcl_CancelIdleCall(AfterProc, afterPtr); + if (afterPtr == NULL) { + afterPtr = GetAfterEvent(assocPtr, commandPtr); + } + if (objc != 3) { + Tcl_DecrRefCount(commandPtr); } - FreeAfterPtr(afterPtr); + } + if (afterPtr != NULL && afterPtr->assocPtr->interp == interp) { + TclpDeleteTimerEvent(TclpAfterInfo2TimerEvent(afterPtr)); } break; } - case AFTER_IDLE: + case AFTER_IDLE: { + TclTimerEvent *idlePtr; + if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); return TCL_ERROR; } - afterPtr = ckalloc(sizeof(AfterInfo)); + + idlePtr = TclpCreatePromptTimerEvent(AfterProc, + FreeAfterPtr, sizeof(AfterInfo), TCL_TMREV_IDLE); + if (idlePtr == NULL) { /* error handled in panic */ + return TCL_ERROR; + } + afterPtr = TclpTimerEvent2AfterInfo(idlePtr); + + /* attach to the list */ afterPtr->assocPtr = assocPtr; + TclSpliceTailEx(afterPtr, + assocPtr->firstAfterPtr, assocPtr->lastAfterPtr); + afterPtr->selfPtr = NULL; + if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); } Tcl_IncrRefCount(afterPtr->commandPtr); - afterPtr->id = tsdPtr->afterId; - tsdPtr->afterId += 1; - afterPtr->token = NULL; - afterPtr->nextPtr = assocPtr->firstAfterPtr; - assocPtr->firstAfterPtr = afterPtr; - Tcl_DoWhenIdle(AfterProc, afterPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); - break; - case AFTER_INFO: + + afterPtr->id = tsdPtr->afterId++; + + Tcl_SetObjResult(interp, GetAfterObj(afterPtr)); + + return TCL_OK; + }; + case AFTER_INFO: { + Tcl_Obj *resultListPtr; + if (objc == 2) { + /* return list of all after-events */ Tcl_Obj *resultObj = Tcl_NewObj(); - - for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; - afterPtr = afterPtr->nextPtr) { - if (assocPtr->interp == interp) { - Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( - "after#%d", afterPtr->id)); + for (afterPtr = assocPtr->lastAfterPtr; + afterPtr != NULL; + afterPtr = afterPtr->prevPtr + ) { + if (assocPtr->interp != interp) { + continue; } + + Tcl_ListObjAppendElement(NULL, resultObj, GetAfterObj(afterPtr)); } - Tcl_SetObjResult(interp, resultObj); + + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?id?"); return TCL_ERROR; } - afterPtr = GetAfterEvent(assocPtr, objv[2]); - if (afterPtr == NULL) { - const char *eventStr = TclGetString(objv[2]); + afterPtr = GetAfterEvent(assocPtr, objv[2]); + if (afterPtr == NULL || afterPtr->assocPtr->interp != interp) { + const char *eventStr = TclGetString(objv[2]); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "event \"%s\" doesn't exist", eventStr)); - Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); + Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); return TCL_ERROR; - } else { - Tcl_Obj *resultListPtr = Tcl_NewObj(); - - Tcl_ListObjAppendElement(interp, resultListPtr, - afterPtr->commandPtr); - Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( - (afterPtr->token == NULL) ? "idle" : "timer", -1)); - Tcl_SetObjResult(interp, resultListPtr); - } + } + resultListPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); + Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( + (TclpAfterInfo2TimerEvent(afterPtr)->flags & TCL_TMREV_IDLE) ? + "idle" : "timer", -1)); + Tcl_SetObjResult(interp, resultListPtr); break; + } default: Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); } @@ -1010,22 +1780,33 @@ Tcl_AfterObjCmd( static int AfterDelay( Tcl_Interp *interp, - Tcl_WideInt ms) + Tcl_WideInt usec, + int absolute) { Interp *iPtr = (Interp *) interp; - Tcl_Time endTime, now; - Tcl_WideInt diff; + Tcl_WideInt endTime, now, diff, limOffs = 0x7FFFFFFFFFFFFFFFL; + long tolerance = 0; - Tcl_GetTime(&now); - endTime = now; - endTime.sec += (long)(ms/1000); - endTime.usec += ((int)(ms%1000))*1000; - if (endTime.usec >= 1000000) { - endTime.sec++; - endTime.usec -= 1000000; + if (usec > 0) { + /* calculate possible maximal tolerance (in usec) of original wait-time */ + #ifdef TMR_RES_TOLERANCE + tolerance = ((usec < 1000000) ? usec : 1000000) * TMR_RES_TOLERANCE / 100; + #endif } + if (!absolute) { + /* + * Note the time can be switched (time-jump), so use monotonic time here. + */ + now = TclpGetUTimeMonotonic(); + if ((endTime = (now + usec)) < now) { /* overflow */ + endTime = 0x7FFFFFFFFFFFFFFFL; + } + } else { + now = TclpGetMicroseconds(); + endTime = usec; + } do { if (Tcl_AsyncReady()) { if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { @@ -1035,41 +1816,48 @@ AfterDelay( if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { return TCL_ERROR; } - if (iPtr->limit.timeEvent != NULL - && TCL_TIME_BEFORE(iPtr->limit.time, now)) { + if ( iPtr->limit.timeEvent != NULL + && (limOffs = (TCL_TIME_TO_USEC(iPtr->limit.time) + - TclpGetMicroseconds())) <= 0 + ) { 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_CEILING(endTime, now); -#ifndef TCL_WIDE_INT_IS_LONG - if (diff > LONG_MAX) { - diff = LONG_MAX; - } -#endif - if (diff > TCL_TIME_MAXIMUM_SLICE) { - diff = TCL_TIME_MAXIMUM_SLICE; - } - if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1; + diff = endTime - now; + if (absolute && diff >= 1000000) { + /* + * Note by absolute sleep we should avoid too long waits, to be + * able to process further if time jumped to the expected time, so + * just let wait maximal 1 second. + */ + diff = 1000000; + } + if (iPtr->limit.timeEvent == NULL || diff < limOffs) { if (diff > 0) { - Tcl_Sleep((long) diff); - if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break; - } else break; - } else { - diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); -#ifndef TCL_WIDE_INT_IS_LONG - if (diff > LONG_MAX) { - diff = LONG_MAX; - } -#endif - if (diff > TCL_TIME_MAXIMUM_SLICE) { - diff = TCL_TIME_MAXIMUM_SLICE; + if (diff > TCL_TIME_MAXIMUM_SLICE) { + diff = TCL_TIME_MAXIMUM_SLICE; + } + TclpUSleep(diff); + if (!absolute) { + now = TclpGetUTimeMonotonic(); + } else { + now = TclpGetMicroseconds(); + } } + } else { + diff = limOffs; if (diff > 0) { - Tcl_Sleep((long) diff); + if (diff > TCL_TIME_MAXIMUM_SLICE) { + diff = TCL_TIME_MAXIMUM_SLICE; + } + TclpUSleep(diff); + if (!absolute) { + now = TclpGetUTimeMonotonic(); + } else { + now = TclpGetMicroseconds(); + } } if (Tcl_AsyncReady()) { if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { @@ -1083,8 +1871,9 @@ AfterDelay( return TCL_ERROR; } } - Tcl_GetTime(&now); - } while (TCL_TIME_BEFORE(now, endTime)); + + /* consider timer resolution tolerance (avoid busy wait) */ + } while (now < endTime - tolerance); return TCL_OK; } @@ -1111,7 +1900,7 @@ static AfterInfo * GetAfterEvent( AfterAssocData *assocPtr, /* Points to "after"-related information for * this interpreter. */ - Tcl_Obj *commandPtr) + Tcl_Obj *objPtr) { const char *cmdString; /* Textual identifier for after event, such as * "after#6". */ @@ -1119,7 +1908,11 @@ GetAfterEvent( int id; char *end; - cmdString = TclGetString(commandPtr); + if (objPtr->typePtr == &afterObjType) { + return (AfterInfo*)objPtr->internalRep.twoPtrValue.ptr1; + } + + cmdString = TclGetString(objPtr); if (strncmp(cmdString, "after#", 6) != 0) { return NULL; } @@ -1128,8 +1921,8 @@ GetAfterEvent( if ((end == cmdString) || (*end != 0)) { return NULL; } - for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; - afterPtr = afterPtr->nextPtr) { + for (afterPtr = assocPtr->lastAfterPtr; afterPtr != NULL; + afterPtr = afterPtr->prevPtr) { if (afterPtr->id == id) { return afterPtr; } @@ -1162,7 +1955,6 @@ AfterProc( { AfterInfo *afterPtr = clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; - AfterInfo *prevPtr; int result; Tcl_Interp *interp; @@ -1172,16 +1964,21 @@ AfterProc( * 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. */ + /* remove delete proc from handler (we'll do cleanup here) */ + TclpAfterInfo2TimerEvent(afterPtr)->deleteProc = NULL; + + /* release object (mark it was triggered) */ + if (afterPtr->selfPtr) { + if (afterPtr->selfPtr->typePtr == &afterObjType) { + afterPtr->selfPtr->internalRep.twoPtrValue.ptr1 = NULL; } - prevPtr->nextPtr = afterPtr->nextPtr; + Tcl_DecrRefCount(afterPtr->selfPtr); + afterPtr->selfPtr = NULL; } + /* detach after-entry from the owner's list */ + TclSpliceOutEx(afterPtr, assocPtr->firstAfterPtr, assocPtr->lastAfterPtr); + /* * Execute the callback. */ @@ -1200,7 +1997,6 @@ AfterProc( */ Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); } /* @@ -1216,29 +2012,32 @@ AfterProc( * None. * * Side effects: - * The memory associated with afterPtr is released. + * The memory associated with afterPtr is not released (owned by handler). * *---------------------------------------------------------------------- */ static void FreeAfterPtr( - AfterInfo *afterPtr) /* Command to be deleted. */ + ClientData clientData) /* Command to be deleted. */ { - AfterInfo *prevPtr; + AfterInfo *afterPtr = (AfterInfo *) clientData; 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. */ + /* release object (mark it was removed) */ + if (afterPtr->selfPtr) { + if (afterPtr->selfPtr->typePtr == &afterObjType) { + afterPtr->selfPtr->internalRep.twoPtrValue.ptr1 = NULL; } - prevPtr->nextPtr = afterPtr->nextPtr; + Tcl_DecrRefCount(afterPtr->selfPtr); + afterPtr->selfPtr = NULL; } + + /* detach after-entry from the owner's list */ + TclSpliceOutEx(afterPtr, assocPtr->firstAfterPtr, assocPtr->lastAfterPtr); + + /* free command of entry */ Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); } /* @@ -1266,20 +2065,10 @@ AfterCleanupProc( Tcl_Interp *interp) /* Interpreter that is being deleted. */ { AfterAssocData *assocPtr = 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, afterPtr); - } - Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + while ( assocPtr->lastAfterPtr ) { + TclpDeleteTimerEvent(TclpAfterInfo2TimerEvent(assocPtr->lastAfterPtr)); } - ckfree(assocPtr); } /* |