diff --git a/generic/tcl.h b/generic/tcl.h index 64c4683d1d53..b65a5cb029c6 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -710,6 +710,7 @@ typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...)); typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData, Tcl_Channel chan, char *address, int port)); typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData)); +typedef void (Tcl_TimerDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp, struct Tcl_Obj *objPtr)); typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr)); @@ -1296,6 +1297,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 b019ef9c8dd9..090eac000e6f 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[]); @@ -212,6 +215,7 @@ static const struct ClockCommand clockCommands[] = { { "getenv", ClockGetenvObjCmd }, { "microseconds", ClockMicrosecondsObjCmd }, { "milliseconds", ClockMillisecondsObjCmd }, + { "monotonic", ClockMonotonicObjCmd }, { "seconds", ClockSecondsObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, @@ -1816,6 +1820,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 4db524c198c5..4bc9219deb28 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1298,6 +1298,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; +} /* *---------------------------------------------------------------------- @@ -1324,44 +1380,138 @@ Tcl_VwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int done, foundEvent; + int done = 0, foundEvent = 1, limit = 0, checktime = 0; + int flags = TCL_ALL_EVENTS; /* default flags */ 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; + } + } + + done = 0; + + /* + * 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_TraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &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 (flags & TCL_DONT_WAIT) { + foundEvent = 1; + done = -2; + } else if (usec > 0 && foundEvent == 0) { + foundEvent = 1; + } + /* don't stop wait - no event expected here + * (stop only on error case foundEvent < 0). */ + if (foundEvent < 0) { + done = -2; + } + } + /* check interpreter limit exceeded */ if (Tcl_LimitExceeded(interp)) { + limit = 1; + foundEvent = 0; break; } - } + } while (!done); + Tcl_UntraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done); + /* if timeout specified (and no errors) */ + if (usec != -1 && foundEvent > 0) { + 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. */ Tcl_ResetResult(interp); - if (!foundEvent) { - Tcl_AppendResult(interp, "can't wait for variable \"", nameString, - "\": would wait forever", NULL); + if (limit) { + Tcl_AppendResult(interp, "limit exceeded", NULL); return TCL_ERROR; } - if (!done) { - Tcl_AppendResult(interp, "limit exceeded", NULL); + if (foundEvent <= 0) { + Tcl_AppendResult(interp, "can't wait for variable \"", nameString, + "\": would wait forever", NULL); return TCL_ERROR; } return TCL_OK; @@ -1409,28 +1559,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 *updateOptions[] = {"idletasks", NULL}; - enum updateOptions {REGEXP_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 REGEXP_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) { @@ -1439,6 +1574,9 @@ Tcl_UpdateObjCmd( Tcl_AppendResult(interp, "limit exceeded", NULL); 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 2e1569fa5a6c..9f2a35e586d0 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -167,7 +167,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); @@ -1586,7 +1586,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; @@ -2965,10 +2965,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. @@ -3447,10 +3454,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 @@ -4384,7 +4398,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. @@ -4665,7 +4679,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. @@ -7982,7 +7996,7 @@ Tcl_NotifyChannel( * None. * * Side effects: - * May schedule a timer or driver handler. + * May schedule a event or driver handler. * *---------------------------------------------------------------------- */ @@ -8011,7 +8025,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. */ @@ -8040,7 +8054,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. @@ -8062,9 +8076,13 @@ UpdateInterest( mask &= ~TCL_EXCEPTION; - if (!statePtr->timer) { - statePtr->timer = Tcl_CreateTimerHandler(0, 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); } } } @@ -8074,9 +8092,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: @@ -8088,31 +8106,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(0, 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; } /* @@ -8565,9 +8593,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: @@ -8579,14 +8607,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; } /* @@ -8703,7 +8734,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 d0967981b1a8..e779ffc6e4aa 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 73ba515670e9..4caba7a6069a 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -27,7 +27,7 @@ static void FreeIndex(Tcl_Obj *objPtr); * that can be invoked by generic object code. */ -static Tcl_ObjType indexType = { +Tcl_ObjType tclIndexType = { "index", /* name */ FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ @@ -60,6 +60,43 @@ typedef struct { #define EXPAND_OF(indexRep) \ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) +/* + *---------------------------------------------------------------------- + * + * 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; +} + /* *---------------------------------------------------------------------- * @@ -105,7 +142,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; /* @@ -179,7 +216,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; @@ -240,13 +277,13 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr->typePtr == &indexType) { + if (objPtr->typePtr == &tclIndexType) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; } else { TclFreeIntRep(objPtr); indexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); objPtr->internalRep.twoPtrValue.ptr1 = indexRep; - objPtr->typePtr = &indexType; + objPtr->typePtr = &tclIndexType; } indexRep->tablePtr = (void *) tablePtr; indexRep->offset = offset; @@ -382,7 +419,7 @@ DupIndex( memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; - dupPtr->typePtr = &indexType; + dupPtr->typePtr = &tclIndexType; } /* @@ -532,7 +569,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; @@ -588,7 +625,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); diff --git a/generic/tclInt.h b/generic/tclInt.h index a184950247d5..ecfa96a60f59 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 @@ -127,6 +137,58 @@ typedef int ptrdiff_t; # endif #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. @@ -1797,8 +1859,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 @@ -1946,18 +2007,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; \ @@ -1968,6 +2048,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: * @@ -2406,6 +2491,7 @@ MODULE_SCOPE Tcl_ObjType tclByteCodeType; MODULE_SCOPE Tcl_ObjType tclDoubleType; MODULE_SCOPE Tcl_ObjType tclEndOffsetType; MODULE_SCOPE Tcl_ObjType tclIntType; +MODULE_SCOPE Tcl_ObjType tclIndexType; MODULE_SCOPE Tcl_ObjType tclListType; MODULE_SCOPE Tcl_ObjType tclDictType; MODULE_SCOPE Tcl_ObjType tclProcBodyType; @@ -2475,12 +2561,19 @@ MODULE_SCOPE char tclEmptyString; #define TCL_DD_SHORTEST0 0x0 /* 'Shortest possible' after masking */ + /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ +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 void TclAdvanceContinuations(int* line, int** next, int loc); @@ -2780,9 +2873,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 Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct); @@ -2840,9 +2994,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[]); @@ -3959,6 +4130,17 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, #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 dbbf10ab174c..0c98844a1913 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3042,6 +3042,8 @@ Tcl_MakeSafe( *---------------------------------------------------------------------- */ +#undef Tcl_LimitExceeded + int Tcl_LimitExceeded( Tcl_Interp *interp) @@ -3511,7 +3513,7 @@ TclLimitRemoveAllHandlers( */ if (iPtr->limit.timeEvent != NULL) { - Tcl_DeleteTimerHandler(iPtr->limit.timeEvent); + TclpDeleteTimerEvent(iPtr->limit.timeEvent); iPtr->limit.timeEvent = NULL; } } @@ -3681,15 +3683,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. * @@ -3707,22 +3720,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 b45539aff383..0dd55c4c3fc5 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -31,6 +31,15 @@ typedef struct EventSource { struct EventSource *nextPtr; } 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. @@ -49,6 +58,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 @@ -70,6 +81,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; @@ -477,6 +497,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 @@ -494,10 +520,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); + } +} + /* *---------------------------------------------------------------------- * @@ -526,7 +587,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); @@ -540,47 +600,73 @@ 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. + * This event should be deleted. Unlink it. */ - 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((char *) hold); + ckfree((char *) 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)); +} + /* *---------------------------------------------------------------------- * @@ -610,28 +696,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; } /* @@ -640,8 +746,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 @@ -660,6 +773,7 @@ Tcl_ServiceEvent( proc = evPtr->proc; if (proc == NULL) { + prevPtr = evPtr; continue; } evPtr->proc = NULL; @@ -676,38 +790,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((char *) 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((char *) evPtr); + } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; @@ -721,9 +845,197 @@ 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); + }; + } +} + /* *---------------------------------------------------------------------- * @@ -835,14 +1147,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). * *---------------------------------------------------------------------- */ @@ -859,22 +1175,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; + } } /* @@ -886,12 +1216,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 @@ -899,12 +1227,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)) { @@ -918,11 +1246,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 */ } /* @@ -939,7 +1274,7 @@ Tcl_DoOneEvent( } tsdPtr->inTraversal = 0; - if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) { + if (tsdPtr->blockTimeSet) { timePtr = &tsdPtr->blockTime; } else { timePtr = NULL; @@ -949,10 +1284,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; } @@ -984,14 +1321,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 @@ -1001,15 +1335,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; @@ -1141,6 +1479,29 @@ Tcl_ThreadAlert( Tcl_MutexUnlock(&listLock); } +/* + *---------------------------------------------------------------------- + * + * 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 diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 33838ec42384..d22d32672424 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -12,22 +12,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 @@ -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,22 +44,9 @@ 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,41 +59,42 @@ 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) /* * Prototypes for functions referenced only in this file: @@ -133,16 +102,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; +}; /* *---------------------------------------------------------------------- @@ -168,12 +247,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; +} + /* *---------------------------------------------------------------------- * @@ -198,15 +405,20 @@ TimerExitProc( ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 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((char *) 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); } } } @@ -236,20 +448,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; } /* @@ -258,11 +601,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 @@ -277,43 +620,73 @@ TclCreateAbsoluteTimerHandler( Tcl_TimerProc *proc, ClientData clientData) { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; - ThreadSpecificData *tsdPtr; - - tsdPtr = InitTimer(); - timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); + register TclTimerEvent *tmrEvent; + Tcl_WideInt usec; /* - * Fill in fields for the event. + * Compute when the event should fire (avoid overflow). */ - memcpy((void *)&timerHandlerPtr->time, (void *)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; } /* @@ -337,31 +710,182 @@ 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((char *) 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((char *)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; +} + + /* *---------------------------------------------------------------------- * @@ -382,38 +906,66 @@ 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 (tsdPtr == NULL) { tsdPtr = InitTimer(); }; - if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) - || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { + 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; } @@ -427,8 +979,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. @@ -441,59 +992,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 = (Tcl_Event *) 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. @@ -501,25 +1058,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 */ } /* @@ -528,9 +1077,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. @@ -547,39 +1094,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((char *) 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); + } - (*nextPtrPtr) = timerHandlerPtr->nextPtr; - (*timerHandlerPtr->proc)(timerHandlerPtr->clientData); - ckfree((char *) timerHandlerPtr); + /* 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((char *) 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; + } } - TimerSetupProc(NULL, TCL_TIMER_EVENTS); - return 1; + + /* pending timer events, so mark (queue) timer events */ + if (tsdPtr->timerPending >= 1) { + tsdPtr->timerPending = 1; + return -1; + } + + /* Reset generation if both timer queue are empty */ + if (!tsdPtr->promptList && !tsdPtr->relTimerList && !tsdPtr->absTimerList) { + tsdPtr->timerGeneration = 0; + } + + /* Compute the next timeout (later via TimerSetupProc using the first timer). */ + tsdPtr->timerPending = 0; + + return result; /* processing done, again later via TimerCheckProc */ } /* @@ -600,31 +1248,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 = (IdleHandler *) ckalloc(sizeof(IdleHandler)); - idlePtr->proc = proc; - idlePtr->clientData = clientData; - idlePtr->generation = tsdPtr->idleGeneration; - idlePtr->nextPtr = NULL; - if (tsdPtr->lastIdlePtr == NULL) { - tsdPtr->idleList = idlePtr; - } else { - tsdPtr->lastIdlePtr->nextPtr = idlePtr; + if (idlePtr) { + idlePtr->clientData = clientData; } - tsdPtr->lastIdlePtr = idlePtr; - - blockTime.sec = 0; - blockTime.usec = 0; - Tcl_SetMaxBlockTime(&blockTime); } /* @@ -650,26 +1283,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((char *) 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((char *) idlePtr); } } } @@ -677,7 +1310,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 @@ -694,19 +1327,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: @@ -725,24 +1358,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); + } ckfree((char *) 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); +} + +/* + *---------------------------------------------------------------------- + * + * TclGetTimeFromObj -- + * + * 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; +} /* *---------------------------------------------------------------------- @@ -769,17 +1491,17 @@ Tcl_AfterObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - Tcl_WideInt ms; /* 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; - char buf[16 + TCL_INTEGER_SPACE]; static CONST char *afterSubCmds[] = { - "cancel", "idle", "info", NULL + "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) { @@ -797,6 +1519,7 @@ Tcl_AfterObjCmd( assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; + assocPtr->lastAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, (ClientData) assocPtr); } @@ -805,38 +1528,77 @@ Tcl_AfterObjCmd( * First lets see if the command was passed a number as the first argument. */ - if (objv[1]->typePtr == &tclIntType -#ifndef NO_WIDE_TYPE - || objv[1]->typePtr == &tclWideIntType -#endif - || objv[1]->typePtr == &tclBignumType - || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK )) { - index = -1; - if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { - Tcl_AppendResult(interp, "bad argument \"", - Tcl_GetString(objv[1]), - "\": must be cancel, idle, info, or an integer", - NULL); - return TCL_ERROR; - } + 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 + ) { + Tcl_AppendResult(interp, "bad argument \"", + Tcl_GetString(objv[1]), + "\": must be at, cancel, idle, info or a time", 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 */ + return AfterDelay(interp, usec, 0); + } + case AFTER_AT: { + TclTimerEvent *tmrEvent; + int flags = 0; + if (index == AFTER_AT) { + flags = TCL_TMREV_AT; + objc--; + objv++; + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?option? time"); + return TCL_ERROR; + } + /* get time from object, default factor for "at" - 1000000 (s) */ + if (TclpGetUTimeFromObj(interp, objv[1], &usec, 1000000) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + /* after at