diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 2 | ||||
| -rw-r--r-- | generic/tclClock.c | 38 | ||||
| -rw-r--r-- | generic/tclEvent.c | 216 | ||||
| -rw-r--r-- | generic/tclIO.c | 102 | ||||
| -rw-r--r-- | generic/tclIO.h | 2 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 55 | ||||
| -rw-r--r-- | generic/tclInt.h | 191 | ||||
| -rw-r--r-- | generic/tclInterp.c | 65 | ||||
| -rw-r--r-- | generic/tclNotify.c | 520 | ||||
| -rw-r--r-- | generic/tclTimer.c | 1671 |
10 files changed, 2243 insertions, 619 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 759f824..538821a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -759,6 +759,7 @@ typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (ClientData clientData); +typedef void (Tcl_TimerDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, @@ -1363,6 +1364,7 @@ typedef struct { * events: */ +#define TCL_ASYNC_EVENTS (1<<0) #define TCL_DONT_WAIT (1<<1) #define TCL_WINDOW_EVENTS (1<<2) #define TCL_FILE_EVENTS (1<<3) diff --git a/generic/tclClock.c b/generic/tclClock.c index a24b126..f928c94 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -184,6 +184,9 @@ static int ClockMicrosecondsObjCmd( static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockMonotonicObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int ClockParseformatargsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -257,6 +260,7 @@ TclClockInit( {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0}, {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0}, + {"monotonic", ClockMonotonicObjCmd, NULL, NULL, NULL, 0}, {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0}, {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0}, {NULL, NULL, NULL, NULL, NULL, 0} @@ -1852,6 +1856,40 @@ ClockMicrosecondsObjCmd( return TCL_OK; } +/*---------------------------------------------------------------------- + * + * ClockMonotonicObjCmd - + * + * Returns a count of microseconds since some starting point. + * This represents monotonic time not affected from the time-jumps. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + * This function implements the 'clock monotonic' Tcl command. Refer to the + * user documentation for details on what it does. + * + *---------------------------------------------------------------------- + */ + +int +ClockMonotonicObjCmd( + ClientData clientData, /* Client data is unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj* const* objv) /* Parameter values */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetUTimeMonotonic())); + return TCL_OK; +} + /* *----------------------------------------------------------------------------- * diff --git a/generic/tclEvent.c b/generic/tclEvent.c index b0b8188..0d89b19 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1368,6 +1368,62 @@ TclInThreadExit(void) } return tsdPtr->inExit; } + + +static CONST char *updateEventOptions[] = { + "-idle", "-noidle", /* new options */ + "-timer", "-notimer", + "-file", "-nofile", + "-window", "-nowindow", + "-async", "-noasync", + "-nowait", "-wait", + "idletasks", /* backwards compat. */ + NULL +}; + +static int +GetEventFlagsFromOpts( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[], /* Arguments containing the option to lookup. */ + int *flagsPtr) /* Input and resulting flags. */ +{ + int i, optionIndex, result = TCL_ERROR; + int flags = *flagsPtr; /* default flags */ + static CONST struct { + int mask; + int flags; + } *updateFlag, updateFlags[] = { + {0, TCL_IDLE_EVENTS}, {TCL_IDLE_EVENTS, 0}, /* -idle, -noidle */ + {0, TCL_TIMER_EVENTS}, {TCL_TIMER_EVENTS, 0}, /* -timer, -notimer */ + {0, TCL_FILE_EVENTS}, {TCL_FILE_EVENTS, 0}, /* -file, -nofile */ + {0, TCL_WINDOW_EVENTS}, {TCL_WINDOW_EVENTS, 0}, /* -window, -nowindow */ + {0, TCL_ASYNC_EVENTS}, {TCL_ASYNC_EVENTS, 0}, /* -async, -noasync */ + {0, TCL_DONT_WAIT}, {TCL_DONT_WAIT, 0}, /* -nowait, -wait */ + {TCL_ALL_EVENTS, TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS}, /* idletasks */ + {0, 0} /* dummy / place holder */ + }; + + for (i = 0; i < objc; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i], updateEventOptions, + "option", 0, &optionIndex) != TCL_OK) { + goto done; + } + updateFlag = &updateFlags[optionIndex]; + /* pure positive option and still default, + * reset all events (only this flag) */ + if (!updateFlag->mask && flags == *flagsPtr) { + flags &= ~TCL_ALL_EVENTS; + } + flags &= ~updateFlag->mask; + flags |= updateFlag->flags; + } + result = TCL_OK; + + done: + *flagsPtr = flags; + return result; +} /* *---------------------------------------------------------------------- @@ -1394,45 +1450,131 @@ Tcl_VwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int done, foundEvent; + int done = 0, foundEvent = 1, checktime = 0; + int flags = TCL_ALL_EVENTS; /* default flags */ const char *nameString; + int optc = objc - 2; /* options count without cmd and varname */ + Tcl_WideInt usec = -1; + Tcl_WideInt now = 0, wakeup = 0; - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "name"); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?options? ?timeout? name"); return TCL_ERROR; } - nameString = Tcl_GetString(objv[1]); + + /* if arguments available - wrap options to flags */ + if (objc >= 3) { + /* first try to recognize options up to the possible end, thereby + * we assume that option is not an integer, try to get numeric timeout + */ + if (!TclObjIsIndexOfTable(objv[optc], updateEventOptions) + && TclpGetUTimeFromObj(NULL, objv[optc], &usec, 1000) == TCL_OK) { + if (usec < 0) { usec = 0; }; + optc--; + } + + /* now try to parse options (if available) */ + if ( optc > 0 + && GetEventFlagsFromOpts(interp, optc, objv+1, &flags) != TCL_OK + ) { + return TCL_ERROR; + } + } + + /* + * If timeout specified - create timer event or no-wait by 0ms. + * Note the time can be switched (time-jump), so use monotonic time here. + */ + if (usec != -1) { + if (usec > 0) { + now = TclpGetUTimeMonotonic(); + wakeup = now + usec; + } else { + flags |= TCL_DONT_WAIT; + } + } + + nameString = Tcl_GetString(objv[objc-1]); if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done) != TCL_OK) { return TCL_ERROR; }; - done = 0; - foundEvent = 1; - while (!done && foundEvent) { - foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); + + do { + /* if wait - set blocking time */ + if (usec > 0) { + Tcl_Time blockTime; + Tcl_WideInt diff; + + now = TclpGetUTimeMonotonic(); + + /* calculate blocking time */ + diff = wakeup - now; + diff -= 1; /* overhead for this code (e. g. Tcl_TraceVar/Tcl_UntraceVar) */ + /* be sure process at least one event */ + if (diff <= 0) { + /* timeout occurs */ + if (checktime) { + done = -1; + break; + } + /* expired, be sure non-negative values here */ + diff = 0; + checktime = 1; + } + blockTime.sec = diff / 1000000; + blockTime.usec = diff % 1000000; + Tcl_SetMaxBlockTime(&blockTime); + } + if ((foundEvent = Tcl_DoOneEvent(flags)) <= 0) { + /* + * If don't wait flag set - no error, and two cases: + * option -nowait for vwait means - we don't wait for events; + * if no timeout (0) - just stop waiting (no more events) + */ + if (foundEvent == 0 && (flags & TCL_DONT_WAIT || usec != -1)) { + foundEvent = 1; + if (usec == 0) { /* timeout occurs */ + done = -1; + break; + } + } + /* don't stop wait - no event expected here + * (stop only on error case foundEvent <= 0). */ + if (foundEvent < 0) { + done = -2; + } + } + /* check canceled or interpreter limit exceeded */ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + done = -3; break; } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); + done = -4; break; } - } + } while (!done); + Tcl_UntraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done); - if (!foundEvent) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't wait for variable \"%s\": would wait forever", - nameString)); - Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); - return TCL_ERROR; - } - if (!done) { + /* if some error */ + if (done <= -2) { + + if (done == -2) { + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't wait for variable \"%s\": would wait forever", + nameString)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); + return TCL_ERROR; + } + /* * The interpreter's result was already set to the right error message * prior to exiting the loop above. @@ -1441,6 +1583,16 @@ Tcl_VwaitObjCmd( return TCL_ERROR; } + /* if timeout specified (and no errors) */ + if (usec != -1) { + Tcl_Obj *objPtr; + + /* done - true, timeout false */ + TclNewLongObj(objPtr, (done > 0)); + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + } + /* * Clear out the interpreter's result, since it may have been set by event * handlers. @@ -1492,28 +1644,13 @@ Tcl_UpdateObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int optionIndex; - int flags = 0; /* Initialized to avoid compiler warning. */ - static const char *const updateOptions[] = {"idletasks", NULL}; - enum updateOptions {OPT_IDLETASKS}; - - if (objc == 1) { - flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; - } else if (objc == 2) { - if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, - "option", 0, &optionIndex) != TCL_OK) { + int flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; /* default flags */ + + /* if arguments available - wrap options to flags */ + if (objc > 1) { + if (GetEventFlagsFromOpts(interp, objc-1, objv+1, &flags) != TCL_OK) { return TCL_ERROR; } - switch ((enum updateOptions) optionIndex) { - case OPT_IDLETASKS: - flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; - break; - default: - Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); - } - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); - return TCL_ERROR; } while (Tcl_DoOneEvent(flags) != 0) { @@ -1525,6 +1662,9 @@ Tcl_UpdateObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); return TCL_ERROR; } + + /* be sure not to produce infinite wait (wait only once) */ + flags |= TCL_DONT_WAIT; } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 64501fd..b761e1d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -156,7 +156,7 @@ static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); static void ChannelFree(Channel *chanPtr); -static void ChannelTimerProc(ClientData clientData); +static int ChannelScheduledProc(Tcl_Event *evPtr, int flags); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, int direction); @@ -1693,7 +1693,7 @@ Tcl_CreateChannel( statePtr->interestMask = 0; statePtr->scriptRecordPtr = NULL; statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; - statePtr->timer = NULL; + statePtr->schedEvent = NULL; statePtr->csPtrR = NULL; statePtr->csPtrW = NULL; statePtr->outputStage = NULL; @@ -3081,10 +3081,17 @@ CloseChannel( } /* - * Cancel any outstanding timer. + * Cancel any outstanding scheduled event. */ - Tcl_DeleteTimerHandler(statePtr->timer); + if (statePtr->schedEvent) { + /* reset channel in event (cancel delayed) */ + *(Channel**)(statePtr->schedEvent+1) = NULL; +#if 0 + TclpCancelEvent(statePtr->schedEvent); +#endif + statePtr->schedEvent = NULL; + } /* * Mark the channel as deleted by clearing the type structure. @@ -3877,10 +3884,17 @@ Tcl_ClearChannelHandlers( chanPtr = statePtr->topChanPtr; /* - * Cancel any outstanding timer. + * Cancel any outstanding scheduled event. */ - Tcl_DeleteTimerHandler(statePtr->timer); + if (statePtr->schedEvent) { + /* reset channel in event (cancel delayed) */ + *(Channel**)(statePtr->schedEvent+1) = NULL; +#if 0 + TclpCancelEvent(statePtr->schedEvent); +#endif + statePtr->schedEvent = NULL; + } /* * Remove any references to channel handlers for this channel that may be @@ -4816,7 +4830,7 @@ Tcl_GetsObj( /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing a - * timer, avoiding a busy wait. This is where we are assuming that the + * event, avoiding a busy wait. This is where we are assuming that the * next operation is a gets. No more file events will be delivered on this * channel until new data arrives or some operation is performed on the * channel (e.g. gets, read, fconfigure) that changes the blocking state. @@ -5101,7 +5115,7 @@ TclGetsObjBinary( /* * We didn't get a complete line so we need to indicate to UpdateInterest * that the gets blocked. It will wait for more data instead of firing a - * timer, avoiding a busy wait. This is where we are assuming that the + * event, avoiding a busy wait. This is where we are assuming that the * next operation is a gets. No more file events will be delivered on this * channel until new data arrives or some operation is performed on the * channel (e.g. gets, read, fconfigure) that changes the blocking state. @@ -8397,7 +8411,7 @@ Tcl_NotifyChannel( * None. * * Side effects: - * May schedule a timer or driver handler. + * May schedule a event or driver handler. * *---------------------------------------------------------------------- */ @@ -8426,7 +8440,7 @@ UpdateInterest( /* * If there is data in the input queue, and we aren't waiting for more - * data, then we need to schedule a timer so we don't block in the + * data, then we need to schedule an event so we don't block in the * notifier. Also, cancel the read interest so we don't get duplicate * events. */ @@ -8455,7 +8469,7 @@ UpdateInterest( * * - Tcl drops READABLE here, because it has data in its own * buffers waiting to be read by the extension. - * - A READABLE event is syntesized via timer. + * - A READABLE event is syntesized via tcl-event (on queue tail). * - The OS still reports the EXCEPTION condition on the file. * - And the extension gets the EXCPTION event first, and handles * this as EOF. @@ -8477,9 +8491,13 @@ UpdateInterest( mask &= ~TCL_EXCEPTION; - if (!statePtr->timer) { - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + if (!statePtr->schedEvent) { + Tcl_Event *evPtr = (Tcl_Event *)ckalloc( + sizeof(Tcl_Event) + sizeof(Channel*)); + *(Channel**)(evPtr+1) = chanPtr; + evPtr->proc = ChannelScheduledProc; + statePtr->schedEvent = evPtr; + Tcl_QueueEvent(evPtr, TCL_QUEUE_TAIL); } } } @@ -8489,9 +8507,9 @@ UpdateInterest( /* *---------------------------------------------------------------------- * - * ChannelTimerProc -- + * ChannelScheduledProc -- * - * Timer handler scheduled by UpdateInterest to monitor the channel + * Event handler scheduled by UpdateInterest to monitor the channel * buffers until they are empty. * * Results: @@ -8503,32 +8521,41 @@ UpdateInterest( *---------------------------------------------------------------------- */ -static void -ChannelTimerProc( - ClientData clientData) +static int +ChannelScheduledProc( + Tcl_Event *evPtr, int flags) { - Channel *chanPtr = clientData; - ChannelState *statePtr = chanPtr->state; - /* State info for channel */ + Channel *chanPtr = *(Channel**)(evPtr+1); + ChannelState *statePtr; /* State info for channel */ + + if (!chanPtr) { /* channel deleted */ + return 1; + } + + statePtr = chanPtr->state; if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) && (statePtr->interestMask & TCL_READABLE) && (statePtr->inQueueHead != NULL) && IsBufferReady(statePtr->inQueueHead)) { + /* - * Restart the timer in case a channel handler reenters the event loop + * Prolong the event in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + statePtr->schedEvent->proc = ChannelScheduledProc; /* reattach to tail */ + Tcl_Preserve(statePtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); Tcl_Release(statePtr); - } else { - statePtr->timer = NULL; - UpdateInterest(chanPtr); + + return 1; } + + statePtr->schedEvent = NULL; /* event done. */ + UpdateInterest(chanPtr); + return 1; } /* @@ -8983,9 +9010,9 @@ Tcl_FileEventObjCmd( /* *---------------------------------------------------------------------- * - * ZeroTransferTimerProc -- + * ZeroTransferEventProc -- * - * Timer handler scheduled by TclCopyChannel so that -command is + * Event handler scheduled by TclCopyChannel so that -command is * called asynchronously even when -size is 0. * * Results: @@ -8997,14 +9024,17 @@ Tcl_FileEventObjCmd( *---------------------------------------------------------------------- */ -static void -ZeroTransferTimerProc( - ClientData clientData) +static int +ZeroTransferEventProc( + Tcl_Event *evPtr, int flags) { /* calling CopyData with mask==0 still implies immediate invocation of the * -command callback, and completion of the fcopy. */ + ClientData clientData = *(ClientData*)(evPtr+1); CopyData(clientData, 0); + + return 1; } /* @@ -9149,7 +9179,11 @@ TclCopyChannel( */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { - Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); + Tcl_Event *evPtr = (Tcl_Event *)ckalloc( + sizeof(Tcl_Event) + sizeof(ClientData*)); + *(ClientData*)(evPtr+1) = csPtr; + evPtr->proc = ZeroTransferEventProc; + Tcl_QueueEvent(evPtr, TCL_QUEUE_TAIL); return 0; } diff --git a/generic/tclIO.h b/generic/tclIO.h index ffbfa31..a317061 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -187,7 +187,7 @@ typedef struct ChannelState { /* Chain of all scripts registered for event * handlers ("fileevent") on this channel. */ int bufSize; /* What size buffers to allocate? */ - Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ + Tcl_Event *schedEvent; /* Scheduler event to wakeup this channel. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 0e0ddc9..6a66c55 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -43,7 +43,7 @@ static void PrintUsage(Tcl_Interp *interp, * that can be invoked by generic object code. */ -static const Tcl_ObjType indexType = { +const Tcl_ObjType tclIndexType = { "index", /* name */ FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ @@ -79,6 +79,43 @@ typedef struct { /* *---------------------------------------------------------------------- * + * TclObjIsIndexOfStruct -- + * + * This function looks up an object's is a index of given table. + * + * Used for fast lookup by dynamic options count to check for other + * object types. + * + * Results: + * 1 if object is an option of table, otherwise 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclObjIsIndexOfStruct( + Tcl_Obj *objPtr, /* Object containing the string to lookup. */ + const void *tablePtr) /* Array of strings to compare against the + * value of objPtr; last entry must be NULL + * and there must not be duplicate entries. */ +{ + IndexRep *indexRep; + if (objPtr->typePtr != &tclIndexType) { + return 0; + } + indexRep = objPtr->internalRep.twoPtrValue.ptr1; + + if (indexRep->tablePtr != (void *) tablePtr) { + return 0; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetIndexFromObj -- * * This function looks up an object's value in a table of strings and @@ -121,7 +158,7 @@ Tcl_GetIndexFromObj( * the common case where the result is cached). */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; /* @@ -279,7 +316,7 @@ Tcl_GetIndexFromObjStruct( * See if there is a valid cached result from a previous lookup. */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; @@ -340,13 +377,13 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; } else { TclFreeIntRep(objPtr); indexRep = ckalloc(sizeof(IndexRep)); objPtr->internalRep.twoPtrValue.ptr1 = indexRep; - objPtr->typePtr = &indexType; + objPtr->typePtr = &tclIndexType; } indexRep->tablePtr = (void *) tablePtr; indexRep->offset = offset; @@ -488,7 +525,7 @@ DupIndex( memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; - dupPtr->typePtr = &indexType; + dupPtr->typePtr = &tclIndexType; } /* @@ -959,7 +996,7 @@ Tcl_WrongNumArgs( * Add the element, quoting it if necessary. */ - if (origObjv[i]->typePtr == &indexType) { + if (origObjv[i]->typePtr == &tclIndexType) { register IndexRep *indexRep = origObjv[i]->internalRep.twoPtrValue.ptr1; @@ -1009,7 +1046,7 @@ Tcl_WrongNumArgs( * Otherwise, just use the string rep. */ - if (objv[i]->typePtr == &indexType) { + if (objv[i]->typePtr == &tclIndexType) { register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); @@ -1457,7 +1494,7 @@ TclGetCompletionCodeFromObj( "ok", "error", "return", "break", "continue", NULL }; - if ((value->typePtr != &indexType) + if ((value->typePtr != &tclIndexType) && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } diff --git a/generic/tclInt.h b/generic/tclInt.h index b369f58..412a60d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -55,6 +55,16 @@ typedef int ptrdiff_t; #endif +/* + * [MSVC] fallback to replace C++ keyword "inline" with C keyword "__inline" + * Otherwise depending on the VC-version, context, include-order it can cause: + * error C2054: expected '(' to follow 'inline' + */ +#if defined(_MSC_VER) && !defined(inline) +# define inline __inline +#endif + + /* * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on @@ -124,6 +134,58 @@ typedef int ptrdiff_t; #endif /* + *---------------------------------------------------------------- + * Data structures related to timer / idle events. + *---------------------------------------------------------------- + */ + +#define TCL_TMREV_PROMPT (1 << 0) /* Mark immediate event (0 microseconds) */ +#define TCL_TMREV_AT (1 << 1) /* Mark timer event to execute verbatim + * at the due-time (regardless any + * time-jumps). */ +#define TCL_TMREV_IDLE (1 << 3) /* Mark idle event */ +#define TCL_TMREV_LISTED (1 << 5) /* Event listed (attached to queue). */ +#define TCL_TMREV_DELETE (1 << 7) /* Event will be deleted. */ + +/* + * This structure used for handling of timer events (with or without time to + * invoke, e. g. created with "after 0") or declared in a call to Tcl_DoWhenIdle + * (created with "after idle"). All of the currently-active handlers are linked + * together into corresponding list. + * + * 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 via TclTimerEvent sorted by time (earliest event first). + */ + +typedef struct TclTimerEvent { + Tcl_TimerProc *proc; /* Function to call timer/idle event */ + Tcl_TimerDeleteProc *deleteProc; /* Function to cleanup idle event */ + ClientData clientData; /* Argument to pass to proc and deleteProc */ + int flags; /* Flags, OR-ed combination of flags/states + * TCL_TMREV_PROMPT ... TCL_TMREV_DELETE */ + + Tcl_WideInt time; /* When timer is to fire (absolute/relative). */ + Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ + + size_t generation; /* Used to distinguish older handlers from + * recently-created ones. */ + size_t refCount; /* Used to preserve for deletion (nested exec + * resp. prolongation). */ + struct TclTimerEvent *nextPtr;/* Next and prev event in idle queue, */ + struct TclTimerEvent *prevPtr;/* or NULL for end/start of the queue. */ + /* variable ExtraData */ /* If extraDataSize supplied to create event. */ +} TclTimerEvent; + +/* + * Macros to wrap ExtraData and TclTimerEvent (and vice versa) + */ +#define TclpTimerEvent2ExtraData(ptr) \ + ( (ClientData)(((TclTimerEvent *)(ptr))+1) ) +#define TclpExtraData2TimerEvent(ptr) \ + ( ((TclTimerEvent *)(ptr))-1 ) + +/* * The following procedures allow namespaces to be customized to support * special name resolution rules for commands/variables. */ @@ -1976,8 +2038,7 @@ typedef struct Interp { * reached. */ int timeGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ - Tcl_TimerToken timeEvent; - /* Handle for a timer callback that will occur + TclTimerEvent *timeEvent;/* Handle for a timer callback that will occur * when the time-limit is exceeded. */ Tcl_HashTable callbacks;/* Mapping from (interp,type) pair to data @@ -2173,18 +2234,37 @@ typedef struct Interp { * existence of struct items 'prevPtr' and 'nextPtr'. * * a = element to add or remove. - * b = list head. + * b = list head (points to the first element). + * e = list tail (points to the last element). * * TclSpliceIn adds to the head of the list. + * TclSpliceTail adds to the tail of the list. */ #define TclSpliceIn(a,b) \ - (a)->nextPtr = (b); \ - if ((b) != NULL) { \ + if (((a)->nextPtr = (b)) != NULL) { \ (b)->prevPtr = (a); \ } \ (a)->prevPtr = NULL, (b) = (a); +#define TclSpliceInEx(a,b,e) \ + TclSpliceIn(a,b); \ + if ((e) == NULL) { \ + (e) = (a); \ + } + +#define TclSpliceTail(a,e) \ + if (((a)->prevPtr = (e)) != NULL) { \ + (e)->nextPtr = (a); \ + } \ + (a)->nextPtr = NULL, (e) = (a); + +#define TclSpliceTailEx(a,b,e) \ + TclSpliceTail(a,e); \ + if ((b) == NULL) { \ + (b) = (a); \ + } + #define TclSpliceOut(a,b) \ if ((a)->prevPtr != NULL) { \ (a)->prevPtr->nextPtr = (a)->nextPtr; \ @@ -2195,6 +2275,11 @@ typedef struct Interp { (a)->nextPtr->prevPtr = (a)->prevPtr; \ } +#define TclSpliceOutEx(a,b,e) \ + TclSpliceOut(a,b) else { \ + (e) = (e)->prevPtr; \ + } + /* * EvalFlag bits for Interp structures: * @@ -2682,6 +2767,7 @@ MODULE_SCOPE const Tcl_ObjType tclByteArrayType; MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; +MODULE_SCOPE const Tcl_ObjType tclIndexType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; @@ -2836,6 +2922,12 @@ struct Tcl_LoadHandle_ { *---------------------------------------------------------------- */ +MODULE_SCOPE int TclObjIsIndexOfStruct(Tcl_Obj *objPtr, + const void *tablePtr); +#define TclObjIsIndexOfTable(objPtr, tablePtr) \ + ((objPtr->typePtr == &tclIndexType) \ + && TclObjIsIndexOfStruct(objPtr, tablePtr)) + MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -3163,9 +3255,70 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ ((double)(clicks) * TclpWideClickInMicrosec() * 1000) + /* Tolerance (in percent), prevents entering busy wait, but has fewer accuracy + * because can wait a bit shorter as wanted. Currently experimental value + * (4.5% equivalent to 15600 / 15000 with small overhead) */ +# ifndef TMR_RES_TOLERANCE +# define TMR_RES_TOLERANCE 4.5 +# endif # endif #endif MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); +MODULE_SCOPE Tcl_WideInt TclpGetUTimeMonotonic(void); + +MODULE_SCOPE int TclpGetUTimeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + Tcl_WideInt *timePtr, int factor); +MODULE_SCOPE void TclpScaleUTime(Tcl_WideInt *usec); + +MODULE_SCOPE void TclpUSleep(Tcl_WideInt usec); +/* + * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write + * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS resp. + * TCL_TIME_DIFF_US compute the number of milliseconds or microseconds difference + * between two times. Both macros use both of their arguments multiple times, + * so make sure they are cheap and side-effect free. + * Macro TCL_TIME_TO_USEC converts Tcl_Time to microseconds. + * The "prototypes" for these macros are: + * + * static int TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2); + * static Tcl_WideInt TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2); + * static Tcl_WideInt TCL_TIME_DIFF_US(Tcl_Time t1, Tcl_Time t2); + * static Tcl_WideInt TCL_TIME_TO_USEC(Tcl_Time t) + */ + +#define TCL_TIME_BEFORE(t1, t2) \ + (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec)) + +#define TCL_TIME_DIFF_MS(t1, t2) \ + (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ + ((long)(t1).usec - (long)(t2).usec)/1000) +#define TCL_TIME_DIFF_US(t1, t2) \ + (1000000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ + ((long)(t1).usec - (long)(t2).usec)) +#define TCL_TIME_TO_USEC(t) \ + (((Tcl_WideInt)(t).sec)*1000000 + (t).usec) + +static inline void +TclTimeSetMilliseconds( + register Tcl_Time *timePtr, + register double ms +) { + timePtr->sec = (long)(ms / 1000); + timePtr->usec = (((long)ms) % 1000) * 1000 + (((long)(ms*1000)) % 1000); +} + +static inline void +TclTimeAddMilliseconds( + register Tcl_Time *timePtr, + register double ms +) { + timePtr->sec += (long)(ms / 1000); + timePtr->usec += (((long)ms) % 1000) * 1000 + (((long)(ms*1000)) % 1000); + if (timePtr->usec > 1000000) { + timePtr->usec -= 1000000; + timePtr->sec++; + } +} MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); @@ -3228,9 +3381,26 @@ MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE void TclSetTimerEventMarker(int flags); +MODULE_SCOPE int TclServiceTimerEvents(void); +MODULE_SCOPE int TclServiceIdleEx(int flags, int count); +MODULE_SCOPE void TclpCancelEvent(Tcl_Event *evPtr); +MODULE_SCOPE TclTimerEvent* TclpCreateTimerEvent(Tcl_WideInt usec, + Tcl_TimerProc *proc, Tcl_TimerDeleteProc *delProc, + size_t extraDataSize, int flags); +MODULE_SCOPE TclTimerEvent* TclpCreatePromptTimerEvent( + Tcl_TimerProc *proc, Tcl_TimerDeleteProc *delProc, + size_t extraDataSize, int flags); +MODULE_SCOPE Tcl_TimerToken TclCreateTimerHandler( + Tcl_Time *timePtr, Tcl_TimerProc *proc, + ClientData clientData, int flags); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData); +MODULE_SCOPE void TclpDeleteTimerEvent(TclTimerEvent *tmrEvent); +MODULE_SCOPE TclTimerEvent* TclpProlongTimerEvent(TclTimerEvent *tmrEvent, + Tcl_WideInt usec, int flags); +MODULE_SCOPE int TclPeekEventQueued(int flags); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -4710,6 +4880,17 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclLimitExceeded(limit) ((limit).exceeded != 0) +static inline int +TclInlLimitExceeded( + register Tcl_Interp *interp) +{ + return (((Interp *)interp)->limit.exceeded != 0); +} +#ifdef Tcl_LimitExceeded +# undef Tcl_LimitExceeded +#endif +#define Tcl_LimitExceeded(interp) TclInlLimitExceeded(interp) + #define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 8a0d653..6138d31 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3276,6 +3276,8 @@ Tcl_MakeSafe( *---------------------------------------------------------------------- */ +#undef Tcl_LimitExceeded + int Tcl_LimitExceeded( Tcl_Interp *interp) @@ -3747,7 +3749,7 @@ TclLimitRemoveAllHandlers( */ if (iPtr->limit.timeEvent != NULL) { - Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); + TclpDeleteTimerEvent(iPtr->limit.timeEvent); iPtr->limit.timeEvent = NULL; } } @@ -3917,15 +3919,26 @@ Tcl_LimitGetCommands( return iPtr->limit.cmdCount; } + +static void +TimeLimitDeleteCallback( + ClientData clientData) +{ + Interp *iPtr = clientData; + iPtr->limit.timeEvent = NULL; +} /* *---------------------------------------------------------------------- * - * Tcl_LimitSetTime -- + * Tcl_LimitSetTime --, TclpLimitSetTimeOffs -- * * Set the time limit for an interpreter by copying it from the value * pointed to by the timeLimitPtr argument. * + * TclpLimitSetTimeOffs opposite to Tcl_LimitSetTime set the limit as + * relative time. + * * Results: * None. * @@ -3943,22 +3956,52 @@ Tcl_LimitSetTime( Tcl_Time *timeLimitPtr) { Interp *iPtr = (Interp *) interp; - Tcl_Time nextMoment; + Tcl_WideInt nextMoment; memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time)); + nextMoment = TCL_TIME_TO_USEC(*timeLimitPtr) + 10; if (iPtr->limit.timeEvent != NULL) { - Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); + iPtr->limit.timeEvent = TclpProlongTimerEvent(iPtr->limit.timeEvent, + nextMoment, TCL_TMREV_AT); + if (iPtr->limit.timeEvent) { + return; + } } - nextMoment.sec = timeLimitPtr->sec; - nextMoment.usec = timeLimitPtr->usec+10; - if (nextMoment.usec >= 1000000) { - nextMoment.sec++; - nextMoment.usec -= 1000000; + iPtr->limit.timeEvent = TclpCreateTimerEvent(nextMoment, + TimeLimitCallback, TimeLimitDeleteCallback, 0, TCL_TMREV_AT); + iPtr->limit.timeEvent->clientData = interp; + iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; +} +#if 0 +void +TclpLimitSetTimeOffs( + Tcl_Interp *interp, + Tcl_WideInt timeOffs) +{ + Interp *iPtr = (Interp *) interp; + + Tcl_GetTime(&iPtr->limit.time); + iPtr->limit.time.sec += timeOffs / 1000000; + iPtr->limit.time.usec += timeOffs % 1000000; + if (iPtr->limit.time.usec > 1000000) { + iPtr->limit.time.usec -= 1000000; + iPtr->limit.time.sec++; + } + timeOffs += 10; + /* we should use relative time (because of the timeout meaning) */ + if (iPtr->limit.timeEvent != NULL) { + iPtr->limit.timeEvent = TclpProlongTimerEvent(iPtr->limit.timeEvent, + timeOffs, 0); + if (iPtr->limit.timeEvent) { + return; + } } - iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment, - TimeLimitCallback, interp); + iPtr->limit.timeEvent = TclpCreateTimerEvent(timeOffs, + TimeLimitCallback, TimeLimitDeleteCallback, 0, 0); + iPtr->limit.timeEvent->clientData = interp; iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } +#endif /* *---------------------------------------------------------------------- diff --git a/generic/tclNotify.c b/generic/tclNotify.c index e76bca8..3df10ae 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -39,6 +39,15 @@ typedef struct EventSource { } EventSource; /* + * Used for performance purposes, threshold to bypass check source (if don't wait) + * Value should be approximately correspond 100-ns ranges, if the wide-clicks + * supported, it is more precise so e. g. 5 is ca. 0.5 microseconds (500-ns). + */ +#ifndef TCL_CHECK_EVENT_SOURCE_THRESHOLD + #define TCL_CHECK_EVENT_SOURCE_THRESHOLD 5 +#endif + +/* * The following structure keeps track of the state of the notifier on a * per-thread basis. The first three elements keep track of the event queue. * In addition to the first (next to be serviced) and last events in the @@ -56,6 +65,8 @@ typedef struct ThreadSpecificData { Tcl_Event *lastEventPtr; /* Last pending event, or NULL if none. */ Tcl_Event *markerEventPtr; /* Last high-priority event in queue, or NULL * if none. */ + Tcl_Event *timerMarkerPtr; /* Weak pointer to last event in the queue, + * before timer event generation */ Tcl_Mutex queueMutex; /* Mutex to protect access to the previous * three fields. */ int serviceMode; /* One of TCL_SERVICE_NONE or @@ -77,6 +88,15 @@ typedef struct ThreadSpecificData { /* Next notifier in global list of notifiers. * Access is controlled by the listLock global * mutex. */ +#if TCL_CHECK_EVENT_SOURCE_THRESHOLD + /* Last "time" source checked, used as threshold + * to avoid checking for events too often */ + #ifndef TCL_WIDE_CLICKS + unsigned long lastCheckClicks; + #else + Tcl_WideInt lastCheckClicks; + #endif +#endif } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -473,6 +493,12 @@ QueueEvent( tsdPtr->lastEventPtr = evPtr; } tsdPtr->firstEventPtr = evPtr; + + /* move timer event hereafter */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-1)) { + tsdPtr->timerMarkerPtr = evPtr; + } + } else if (position == TCL_QUEUE_MARK) { /* * Insert the event after the current marker event and advance the @@ -490,10 +516,45 @@ QueueEvent( if (evPtr->nextPtr == NULL) { tsdPtr->lastEventPtr = evPtr; } + + /* move timer event hereafter */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-1)) { + tsdPtr->timerMarkerPtr = evPtr; + } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); } +static void +UnlinkEvent( + ThreadSpecificData *tsdPtr, + Tcl_Event *evPtr, + Tcl_Event *prevPtr) { + /* + * Unlink it. + */ + + if (prevPtr == NULL) { + tsdPtr->firstEventPtr = evPtr->nextPtr; + } else { + prevPtr->nextPtr = evPtr->nextPtr; + } + + /* + * Update 'last' and 'marker' events if either has been deleted. + */ + + if (evPtr->nextPtr == NULL) { + tsdPtr->lastEventPtr = prevPtr; + } + if (tsdPtr->markerEventPtr == evPtr) { + tsdPtr->markerEventPtr = prevPtr; + } + if (tsdPtr->timerMarkerPtr == evPtr) { + tsdPtr->timerMarkerPtr = prevPtr ? prevPtr : INT2PTR(-1); + } +} + /* *---------------------------------------------------------------------- * @@ -522,7 +583,6 @@ Tcl_DeleteEvents( Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if * evPtr designates the first event in the * queue for the thread. */ - Tcl_Event *hold; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_MutexLock(&(tsdPtr->queueMutex)); @@ -535,44 +595,69 @@ Tcl_DeleteEvents( prevPtr = NULL; evPtr = tsdPtr->firstEventPtr; while (evPtr != NULL) { + Tcl_Event *nextPtr = evPtr->nextPtr; if (proc(evPtr, clientData) == 1) { /* * This event should be deleted. Unlink it. */ - if (prevPtr == NULL) { - tsdPtr->firstEventPtr = evPtr->nextPtr; - } else { - prevPtr->nextPtr = evPtr->nextPtr; - } - - /* - * Update 'last' and 'marker' events if either has been deleted. - */ - - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = prevPtr; - } - if (tsdPtr->markerEventPtr == evPtr) { - tsdPtr->markerEventPtr = prevPtr; - } + UnlinkEvent(tsdPtr, evPtr, prevPtr); /* * Delete the event data structure. */ - hold = evPtr; - evPtr = evPtr->nextPtr; - ckfree(hold); + ckfree(evPtr); } else { /* * Event is to be retained. */ prevPtr = evPtr; - evPtr = evPtr->nextPtr; } + evPtr = nextPtr; + } + Tcl_MutexUnlock(&(tsdPtr->queueMutex)); +} + +void +TclpCancelEvent( + Tcl_Event *evPtr) /* Event to remove from queue. */ +{ + Tcl_Event *prevPtr = NULL; + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_MutexLock(&(tsdPtr->queueMutex)); + + /* + * Search event to unlink from queue. + */ + + if (evPtr != tsdPtr->firstEventPtr) { + for (prevPtr = tsdPtr->firstEventPtr; + prevPtr && prevPtr->nextPtr != evPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + if (!prevPtr) { + evPtr = NULL; /* not in queue (already removed) */ + } + } + + if (evPtr) { + /* + * Unlink it. + */ + + UnlinkEvent(tsdPtr, evPtr, prevPtr); + + /* + * Delete the event data structure. + */ + ckfree((char *) evPtr); } + Tcl_MutexUnlock(&(tsdPtr->queueMutex)); } @@ -605,28 +690,48 @@ Tcl_ServiceEvent( * matching this will be skipped for * processing later. */ { - Tcl_Event *evPtr, *prevPtr; + Tcl_Event *evPtr, *prevPtr = NULL; Tcl_EventProc *proc; int result; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* + * No event flags is equivalent to TCL_ALL_EVENTS. + */ + + if ((flags & TCL_ALL_EVENTS) == 0) { + flags |= TCL_ALL_EVENTS; + } + + /* * Asynchronous event handlers are considered to be the highest priority * events, and so must be invoked before we process events on the event * queue. */ - if (Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; + if ((flags & TCL_ASYNC_EVENTS)) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(NULL, 0); + return 1; + } + /* Async only */ + if ((flags & TCL_ALL_EVENTS) == TCL_ASYNC_EVENTS) { + return 0; + } + } + + /* Fast bypass case */ + if ( !tsdPtr->firstEventPtr /* no other events */ + || ((flags & TCL_ALL_EVENTS) == TCL_TIMER_EVENTS) /* timers only */ + ) { + goto timer; } /* - * No event flags is equivalent to TCL_ALL_EVENTS. + * If timer marker reached, process timer events now. */ - - if ((flags & TCL_ALL_EVENTS) == 0) { - flags |= TCL_ALL_EVENTS; + if ((flags & TCL_TIMER_EVENTS) && (tsdPtr->timerMarkerPtr == INT2PTR(-1))) { + goto processTimer; } /* @@ -635,8 +740,15 @@ Tcl_ServiceEvent( */ Tcl_MutexLock(&(tsdPtr->queueMutex)); - for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; - evPtr = evPtr->nextPtr) { + for (evPtr = tsdPtr->firstEventPtr; + evPtr != NULL && tsdPtr->timerMarkerPtr != INT2PTR(-1); + evPtr = evPtr->nextPtr + ) { + + if (tsdPtr->timerMarkerPtr == evPtr) { + tsdPtr->timerMarkerPtr = INT2PTR(-1); /* timer marker reached */ + } + /* * Call the handler for the event. If it actually handles the event * then free the storage for the event. There are two tricky things @@ -655,6 +767,7 @@ Tcl_ServiceEvent( proc = evPtr->proc; if (proc == NULL) { + prevPtr = evPtr; continue; } evPtr->proc = NULL; @@ -671,38 +784,48 @@ Tcl_ServiceEvent( Tcl_MutexLock(&(tsdPtr->queueMutex)); if (result) { + /* * The event was processed, so remove it from the queue. */ - if (tsdPtr->firstEventPtr == evPtr) { - tsdPtr->firstEventPtr = evPtr->nextPtr; - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = NULL; - } - if (tsdPtr->markerEventPtr == evPtr) { - tsdPtr->markerEventPtr = NULL; - } - } else { + prevPtr = NULL; + if (evPtr != tsdPtr->firstEventPtr) { for (prevPtr = tsdPtr->firstEventPtr; prevPtr && prevPtr->nextPtr != evPtr; prevPtr = prevPtr->nextPtr) { /* Empty loop body. */ } - if (prevPtr) { - prevPtr->nextPtr = evPtr->nextPtr; - if (evPtr->nextPtr == NULL) { - tsdPtr->lastEventPtr = prevPtr; - } - if (tsdPtr->markerEventPtr == evPtr) { - tsdPtr->markerEventPtr = prevPtr; - } - } else { + if (!prevPtr) { evPtr = NULL; } } if (evPtr) { - ckfree(evPtr); + /* Detach event from queue */ + UnlinkEvent(tsdPtr, evPtr, prevPtr); + + /* If wanted to prolong (repeat) */ + if (evPtr->proc) { + /* + * Event was restored (prolonged) - sign to reattach to tail + */ + if (evPtr != tsdPtr->lastEventPtr) { + /* detach event from queue */ + UnlinkEvent(tsdPtr, evPtr, prevPtr); + /* attach to tail */ + evPtr->nextPtr = NULL; + if (tsdPtr->firstEventPtr == NULL) { + tsdPtr->firstEventPtr = evPtr; + } else { + tsdPtr->lastEventPtr->nextPtr = evPtr; + } + tsdPtr->lastEventPtr = evPtr; + } + } else { + /* Free event */ + UnlinkEvent(tsdPtr, evPtr, prevPtr); + ckfree(evPtr); + } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; @@ -716,12 +839,200 @@ Tcl_ServiceEvent( } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); + + timer: + /* + * Process timer queue, if alloved and timers are enabled. + */ + + if (flags & TCL_TIMER_EVENTS) { + + /* If available pending timer-events of new generation */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-2)) { /* pending */ + /* no other events - process timer-events (next cycle) */ + if (!(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) { /* no other events */ + tsdPtr->timerMarkerPtr = INT2PTR(-1); + } + return 0; + } + + if (tsdPtr->timerMarkerPtr == INT2PTR(-1)) { + + processTimer: + /* reset marker */ + tsdPtr->timerMarkerPtr = NULL; + + result = TclServiceTimerEvents(); + if (result < 0) { + /* + * Events processed, but still pending timers (of new generation) + * set marker to process timer, if setup- resp. check-proc will + * not generate new events. + */ + if (tsdPtr->timerMarkerPtr == NULL) { + /* marker to last event in the queue */ + if (!(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) { + /* + * Marker as "pending" - queue is empty, so timers events are first, + * if setup-proc resp. check-proc will not generate new events. + */ + tsdPtr->timerMarkerPtr = INT2PTR(-2); + }; + } + result = 1; + } + return result; + } + } + + return 0; +} + +#if TCL_CHECK_EVENT_SOURCE_THRESHOLD +/* + *---------------------------------------------------------------------- + * + * CheckSourceThreshold -- + * + * Check whether we should iterate over event sources for availability. + * + * This is used to avoid too unneeded overhead (too often call checkProc). + * + * Results: + * Returns 1 if threshold reached (check event sources), 0 otherwise. + * + *---------------------------------------------------------------------- + */ + +static inline int +CheckSourceThreshold( + ThreadSpecificData *tsdPtr) +{ + /* don't need to wait/check for events too often */ +#ifndef TCL_WIDE_CLICKS + unsigned long clickdiff, clicks = TclpGetClicks(); +#else + Tcl_WideInt clickdiff, clicks; + /* in 100-ns */ + clicks = TclpGetWideClicks() * (TclpWideClickInMicrosec() * 10); +#endif + /* considering possible clicks-jump */ + if ( (clickdiff = (clicks - tsdPtr->lastCheckClicks)) >= 0 + && clickdiff <= TCL_CHECK_EVENT_SOURCE_THRESHOLD) { + return 0; + } + tsdPtr->lastCheckClicks = clicks; + return 1; +} +#endif + +/* + *---------------------------------------------------------------------- + * + * TclPeekEventQueued -- + * + * Check whether some event (except idle) available (async, queued, timer). + * + * This will be used e. g. in TclServiceIdle to stop the processing of the + * the idle events if some "normal" event occurred. + * + * Results: + * Returns 1 if some event queued, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclPeekEventQueued( + int flags) +{ + EventSource *sourcePtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int repeat = 1; + + do { + /* + * Events already pending ? + */ + if ( Tcl_AsyncReady() + || (tsdPtr->firstEventPtr) + || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerMarkerPtr) + ) { + return 1; + } + + /* once from here */ + if (!repeat) { + break; + } + + if (flags & TCL_DONT_WAIT) { + /* don't need to wait/check for events too often */ + #if TCL_CHECK_EVENT_SOURCE_THRESHOLD + if (!CheckSourceThreshold(tsdPtr)) { + return 0; + } + #endif + } + + /* + * Check all the event sources for new events. + */ + for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL; + sourcePtr = sourcePtr->nextPtr) { + if (sourcePtr->checkProc) { + (sourcePtr->checkProc)(sourcePtr->clientData, flags); + } + } + + } while (repeat--); + return 0; } /* *---------------------------------------------------------------------- * + * TclSetTimerEventMarker -- + * + * Set timer event marker to the last pending event in the queue. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclSetTimerEventMarker( + int flags) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->timerMarkerPtr == NULL || tsdPtr->timerMarkerPtr == INT2PTR(-2)) { + /* marker to last event in the queue */ + if ( !(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr) /* no other events */ + || ((flags & TCL_ALL_EVENTS) == TCL_TIMER_EVENTS) /* timers only */ + ) { + /* + * Marker as "pending" - queue is empty, so timers events are first, + * if setup-proc resp. check-proc will not generate new events. + * Force timer execution if flags specified (from checkProc). + */ + tsdPtr->timerMarkerPtr = flags ? INT2PTR(-1) : INT2PTR(-2); + }; + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetServiceMode -- * * This routine returns the current service mode of the notifier. @@ -828,14 +1139,18 @@ Tcl_SetMaxBlockTime( * Results: * The return value is 1 if the function actually found an event to * process. If no processing occurred, then 0 is returned (this can - * happen if the TCL_DONT_WAIT flag is set or if there are no event - * handlers to wait for in the set specified by flags). + * happen if the TCL_DONT_WAIT flag is set or block time was set using + * Tcl_SetMaxBlockTime before or if there are no event handlers to wait + * for in the set specified by flags). * * Side effects: * May delay execution of process while waiting for an event, unless * TCL_DONT_WAIT is set in the flags argument. Event sources are invoked * to check for and queue events. Event handlers may produce arbitrary * side effects. + * If block time was set (Tcl_SetMaxBlockTime) but another event occurs + * and interrupt wait, the function can return early, thereby it resets + * the block time (caller should use Tcl_SetMaxBlockTime again). * *---------------------------------------------------------------------- */ @@ -852,22 +1167,36 @@ Tcl_DoOneEvent( EventSource *sourcePtr; Tcl_Time *timePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int blockTimeWasSet; /* - * The first thing we do is to service any asynchronous event handlers. + * No event flags is equivalent to TCL_ALL_EVENTS. */ - if (Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; + if ((flags & TCL_ALL_EVENTS) == 0) { + flags |= TCL_ALL_EVENTS; } + /* Block time was set outside an event source traversal, caller has specified a waittime */ + blockTimeWasSet = tsdPtr->blockTimeSet; + /* - * No event flags is equivalent to TCL_ALL_EVENTS. + * Asynchronous event handlers are considered to be the highest priority + * events, and so must be invoked before we process events on the event + * queue. */ - if ((flags & TCL_ALL_EVENTS) == 0) { - flags |= TCL_ALL_EVENTS; + if (flags & TCL_ASYNC_EVENTS) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(NULL, 0); + return 1; + } + + /* Async only and don't wait - return */ + if ( (flags & (TCL_ALL_EVENTS|TCL_DONT_WAIT)) + == (TCL_ASYNC_EVENTS|TCL_DONT_WAIT) ) { + return 0; + } } /* @@ -879,12 +1208,10 @@ Tcl_DoOneEvent( tsdPtr->serviceMode = TCL_SERVICE_NONE; /* - * The core of this function is an infinite loop, even though we only - * service one event. The reason for this is that we may be processing - * events that don't do anything inside of Tcl. + * Main loop until servicing exact one event or block time resp. + * TCL_DONT_WAIT specified (infinite loop otherwise). */ - - while (1) { + do { /* * If idle events are the only things to service, skip the main part * of the loop and go directly to handle idle events (i.e. don't wait @@ -892,12 +1219,12 @@ Tcl_DoOneEvent( */ if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) { - flags = TCL_IDLE_EVENTS | TCL_DONT_WAIT; goto idleEvents; } /* - * Ask Tcl to service a queued event, if there are any. + * Ask Tcl to service any asynchronous event handlers or + * queued event, if there are any. */ if (Tcl_ServiceEvent(flags)) { @@ -911,11 +1238,18 @@ Tcl_DoOneEvent( */ if (flags & TCL_DONT_WAIT) { + + /* don't need to wait/check for events too often */ + #if TCL_CHECK_EVENT_SOURCE_THRESHOLD + if (!CheckSourceThreshold(tsdPtr)) { + goto idleEvents; + } + #endif tsdPtr->blockTime.sec = 0; tsdPtr->blockTime.usec = 0; tsdPtr->blockTimeSet = 1; - } else { - tsdPtr->blockTimeSet = 0; + timePtr = &tsdPtr->blockTime; + goto wait; /* for notifier resp. system events */ } /* @@ -932,7 +1266,7 @@ Tcl_DoOneEvent( } tsdPtr->inTraversal = 0; - if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) { + if (tsdPtr->blockTimeSet) { timePtr = &tsdPtr->blockTime; } else { timePtr = NULL; @@ -942,10 +1276,12 @@ Tcl_DoOneEvent( * Wait for a new event or a timeout. If Tcl_WaitForEvent returns -1, * we should abort Tcl_DoOneEvent. */ - + wait: result = Tcl_WaitForEvent(timePtr); if (result < 0) { - result = 0; + if (blockTimeWasSet) { + result = 0; + } break; } @@ -977,14 +1313,11 @@ Tcl_DoOneEvent( idleEvents: if (flags & TCL_IDLE_EVENTS) { - if (TclServiceIdle()) { + if (TclServiceIdleEx(flags, INT_MAX)) { result = 1; break; } } - if (flags & TCL_DONT_WAIT) { - break; - } /* * If Tcl_WaitForEvent has returned 1, indicating that one system @@ -994,15 +1327,19 @@ Tcl_DoOneEvent( * had the side effect of changing the variable (so the vwait can * return and unwind properly). * - * NB: We will process idle events if any first, because otherwise we - * might never do the idle events if the notifier always gets - * system events. + * We can stop also if works in block to event mode (e. g. block time was + * set outside an event source, that means timeout was set so exit loop + * also without event/result). */ - if (result) { + result = 0; + if (blockTimeWasSet) { break; } - } + } while ( !(flags & TCL_DONT_WAIT) ); + + /* Reset block time earliest at the end of event cycle */ + tsdPtr->blockTimeSet = 0; tsdPtr->serviceMode = oldMode; return result; @@ -1133,6 +1470,29 @@ Tcl_ThreadAlert( } /* + *---------------------------------------------------------------------- + * + * Tcl_Sleep -- + * + * Delay execution for the specified number of milliseconds. + * + * Results: + * None. + * + * Side effects: + * Time passes. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_Sleep( + int ms) /* Number of milliseconds to sleep. */ +{ + TclpUSleep((Tcl_WideInt)ms * 1000); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 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); } /* |