summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2017-07-03 13:29:42 (GMT)
committersebres <sebres@users.sourceforge.net>2017-07-03 13:29:42 (GMT)
commit62e00681cf398709d6a32eaa1ae0ccae3a5da9ef (patch)
tree4f7ad28b70f39e5c0b7d69c038442b825999ef55
parent913dc38311eb8c0ecbf81444db4d7d0a9276c4e5 (diff)
downloadtcl-62e00681cf398709d6a32eaa1ae0ccae3a5da9ef.zip
tcl-62e00681cf398709d6a32eaa1ae0ccae3a5da9ef.tar.gz
tcl-62e00681cf398709d6a32eaa1ae0ccae3a5da9ef.tar.bz2
interim commit: trying to resolve time-freezes with new facilities timeJump/timeJumpEpoch
-rw-r--r--generic/tclEvent.c22
-rw-r--r--generic/tclInt.h49
-rw-r--r--generic/tclInterp.c4
-rw-r--r--generic/tclTimer.c512
-rw-r--r--win/tclWinNotify.c61
5 files changed, 454 insertions, 194 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 05e3109..53668d0 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1385,7 +1385,7 @@ Tcl_VwaitObjCmd(
char *nameString;
int optc = objc - 2; /* options count without cmd and varname */
double ms = -1;
- Tcl_Time wakeup;
+ Tcl_Time lastNow, wakeup;
long tolerance = 0;
if (objc < 2) {
@@ -1416,7 +1416,8 @@ Tcl_VwaitObjCmd(
/* if timeout specified - create timer event or no-wait by 0ms */
if (ms != -1) {
if (ms > 0) {
- Tcl_GetTime(&wakeup);
+ Tcl_GetTime(&lastNow);
+ wakeup = lastNow;
TclTimeAddMilliseconds(&wakeup, ms);
#ifdef TMR_RES_TOLERANCE
tolerance = (ms < 1000 ? ms : 1000) *
@@ -1439,11 +1440,26 @@ Tcl_VwaitObjCmd(
if (ms > 0) {
Tcl_Time blockTime;
Tcl_GetTime(&blockTime);
+ /*
+ * Note time can be switched backwards, certainly adjust end-time
+ * by possible time-jumps back.
+ */
+ if (TCL_TIME_BEFORE(blockTime, lastNow)) {
+ /* backwards time-jump - simply shift wakeup-time */
+ wakeup.sec -= (lastNow.sec - blockTime.sec);
+ wakeup.usec -= (lastNow.usec - blockTime.usec);
+ if (wakeup.usec < 0) {
+ wakeup.usec += 1000000;
+ wakeup.sec--;
+ }
+ }
+ /* calculate blocking time */
+ lastNow = blockTime;
blockTime.sec = wakeup.sec - blockTime.sec;
blockTime.usec = wakeup.usec - blockTime.usec;
if (blockTime.usec < 0) {
- blockTime.sec--;
blockTime.usec += 1000000;
+ blockTime.sec--;
}
/* be sure process at least one event */
if ( blockTime.sec < 0
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7576a97..d270042 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -144,10 +144,12 @@ typedef int ptrdiff_t;
*/
#define TCL_PROMPT_EVENT (1 << 0) /* Mark immediate event */
+#define TCL_ABSTMR_EVENT (1 << 1) /* Mark absolute timer event (the time
+ * of TimerHandler is absolute). */
#define TCL_IDLE_EVENT (1 << 5) /* Mark idle event */
/*
- * This structure used for handling of prompt timer events (without time to
+ * 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.
@@ -173,7 +175,7 @@ typedef struct TimerEntry {
typedef struct TimerHandler {
- Tcl_Time time; /* When timer is to fire (if timer event). */
+ Tcl_WideInt time; /* When timer is to fire (absolute/relative). */
Tcl_TimerToken token; /* Identifies handler so it can be deleted. */
struct TimerEntry entry;
/* ExtraData */
@@ -2886,6 +2888,38 @@ MODULE_SCOPE double TclpWideClickInMicrosec(void);
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
+/*
+ * 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.
+ * 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);
+ */
+
+#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))
+
+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,
@@ -2958,13 +2992,16 @@ MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData,
MODULE_SCOPE void TclSetTimerEventMarker(int head);
MODULE_SCOPE int TclServiceTimerEvents(void);
MODULE_SCOPE int TclServiceIdleEx(int flags, int count);
+MODULE_SCOPE TimerEntry* TclpCreateTimerHandlerEx(
+ Tcl_WideInt usec,
+ Tcl_TimerProc *proc, Tcl_TimerDeleteProc *deleteProc,
+ size_t extraDataSize, int flags);
+MODULE_SCOPE Tcl_TimerToken TclCreateRelativeTimerHandler(
+ Tcl_Time *timeOffsPtr, Tcl_TimerProc *proc,
+ ClientData clientData);
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
Tcl_Time *timePtr, Tcl_TimerProc *proc,
ClientData clientData);
-MODULE_SCOPE TimerEntry* TclCreateAbsoluteTimerHandlerEx(
- Tcl_Time *timePtr,
- Tcl_TimerProc *proc, Tcl_TimerDeleteProc *deleteProc,
- size_t extraDataSize);
MODULE_SCOPE TimerEntry* TclCreateTimerEntryEx(
Tcl_TimerProc *proc, Tcl_TimerDeleteProc *deleteProc,
size_t extraDataSize, int flags);
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 5f1b958..b461f40 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -3730,8 +3730,8 @@ Tcl_LimitSetTime(
nextMoment.sec++;
nextMoment.usec -= 1000000;
}
- iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandlerEx(&nextMoment,
- TimeLimitCallback, TimeLimitDeleteCallback, 0);
+ iPtr->limit.timeEvent = TclCreateTimerHandlerEx(&nextMoment,
+ TimeLimitCallback, TimeLimitDeleteCallback, 0, TCL_ABSTMR_EVENT);
iPtr->limit.timeEvent->clientData = interp;
iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
}
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index a7fd50b..9eaf944 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -60,17 +60,22 @@ typedef struct AfterAssocData {
*/
typedef struct {
- TimerEntry *timerList; /* First event in queue. */
- TimerEntry *lastTimerPtr; /* Last event in queue. */
+ Tcl_WideInt relTimerBase; /* Time base (offset) of the last known relative,
+ * timer, used to revert all events to the new
+ * base after possible time-jump (adjustment).*/
+ TimerEntry *relTimerList; /* First event in queue of relative timers. */
+ TimerEntry *relTimerTail; /* Last event in queue of relative timers. */
TimerEntry *promptList; /* First immediate event in queue. */
- TimerEntry *lastPromptPtr; /* Last immediate event in queue. */
+ TimerEntry *promptTail; /* Last immediate event in queue. */
+ TimerEntry *absTimerList; /* First event in queue of absolute timers. */
+ TimerEntry *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. */
TimerEntry *idleList; /* First in list of all idle handlers. */
- TimerEntry *lastIdlePtr; /* Last in list (or NULL for empty list). */
+ TimerEntry *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,
@@ -92,27 +97,6 @@ static Tcl_ThreadDataKey dataKey;
ClientData2TimerEntry(ptr)
/*
- * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write
- * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes
- * the number of milliseconds difference between two times. Both macros use
- * both of their arguments multiple times, so make sure they are cheap and
- * side-effect free. The "prototypes" for these macros are:
- *
- * static int TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2);
- * static long TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2);
- */
-
-#define TCL_TIME_BEFORE(t1, t2) \
- (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))
-
-#define TCL_TIME_DIFF_MS(t1, t2) \
- (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
- ((long)(t1).usec - (long)(t2).usec)/1000)
-#define TCL_TIME_DIFF_US(t1, t2) \
- (1000000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
- ((long)(t1).usec - (long)(t2).usec))
-
-/*
* Prototypes for functions referenced only in this file:
*/
@@ -295,14 +279,14 @@ TimerExitProc(
if (tsdPtr != NULL) {
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, tsdPtr);
- while ((tsdPtr->lastPromptPtr) != NULL) {
- TclDeleteTimerEntry(tsdPtr->lastPromptPtr);
+ while ((tsdPtr->promptTail) != NULL) {
+ TclDeleteTimerEntry(tsdPtr->promptTail);
}
- while ((tsdPtr->lastTimerPtr) != NULL) {
- TclDeleteTimerEntry(tsdPtr->lastTimerPtr);
+ while ((tsdPtr->absTimerTail) != NULL) {
+ TclDeleteTimerEntry(tsdPtr->absTimerTail);
}
- while ((tsdPtr->lastIdlePtr) != NULL) {
- TclDeleteTimerEntry(tsdPtr->lastIdlePtr);
+ while ((tsdPtr->idleTail) != NULL) {
+ TclDeleteTimerEntry(tsdPtr->idleTail);
}
}
}
@@ -333,21 +317,19 @@ Tcl_CreateTimerHandler(
ClientData clientData) /* Arbitrary data to pass to proc. */
{
register TimerEntry *entryPtr;
- Tcl_Time time;
+ 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;
}
- entryPtr = TclCreateAbsoluteTimerHandlerEx(&time, proc, NULL, 0);
+ entryPtr = TclpCreateTimerHandlerEx(usec, proc, NULL, 0, 0);
if (entryPtr == NULL) {
return NULL;
}
@@ -359,31 +341,32 @@ Tcl_CreateTimerHandler(
/*
*--------------------------------------------------------------
*
- * TclCreateAbsoluteTimerHandlerEx -- , TclCreateAbsoluteTimerHandler --
+ * TclpCreateTimerHandlerEx --
*
- * Arrange for a given function to be invoked at a particular time in the
- * future.
+ * 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 or token of the timer event, which
- * may be used to delete the event before it fires.
+ * 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 in timePtr has been reached, proc will be invoked
+ * When the time or offset in timePtr has been reached, proc will be invoked
* exactly once.
*
*--------------------------------------------------------------
*/
TimerEntry*
-TclCreateAbsoluteTimerHandlerEx(
- Tcl_Time *timePtr, /* Time to be invoked */
- Tcl_TimerProc *proc, /* Function to invoke */
- Tcl_TimerDeleteProc *deleteProc, /* Function to cleanup */
- size_t extraDataSize)
+TclpCreateTimerHandlerEx(
+ 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) /* If TCL_ABSTMR_EVENT, time is absolute */
{
register TimerEntry *entryPtr, *entryPtrPos;
- register TimerHandler *timerPtr;
+ register TimerHandler *timerPtr, **tmrList, **tmrTail;
ThreadSpecificData *tsdPtr;
tsdPtr = InitTimer();
@@ -397,35 +380,49 @@ TclCreateAbsoluteTimerHandlerEx(
* Fill in fields for the event.
*/
- memcpy((void *)&(timerPtr->time), (void *)timePtr, sizeof(*timePtr));
entryPtr->proc = proc;
entryPtr->deleteProc = deleteProc;
entryPtr->clientData = TimerEntry2ClientData(entryPtr);
- entryPtr->flags = 0;
+ entryPtr->flags = flags & TCL_ABSTMR_EVENT;
entryPtr->generation = tsdPtr->timerGeneration;
tsdPtr->timerListEpoch++; /* signal-timer list was changed */
tsdPtr->lastTimerId++;
timerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
+ if (flags & TCL_ABSTMR_EVENT) {
+ tmrList = &tsdPtr->absTimerList;
+ tmrTail = &tsdPte->absTimerTail;
+ } else {
+ Tcl_WideInt now = TclpGetMicroseconds();
+
+ tmrList = &tsdPtr->relTimerList;
+ tmrTail = &tsdPtr->relTimerTail;
+ if (tsdPtr->relTimerList) {
+ /* usec is relative current base (to now) */
+ usec -= now - tsdPtr->relTimerBase;
+ } else {
+ tsdPtr->relTimerBase = now;
+ }
+ }
+
+ timerPtr->time = usec;
+
/*
* Add the event to the queue in the correct position
* (ordered by event firing time).
*/
/* if before current first (e. g. "after 0" before first "after 1000") */
- if ( !(entryPtrPos = tsdPtr->timerList)
- || TCL_TIME_BEFORE(timerPtr->time,
- TimerEntry2TimerHandler(entryPtrPos)->time)
+ if ( !(entryPtrPos = *tmrList)
+ || usec < TimerEntry2TimerHandler(entryPtrPos)->time
) {
/* splice to the head */
- TclSpliceInEx(entryPtr,
- tsdPtr->timerList, tsdPtr->lastTimerPtr);
+ TclSpliceInEx(entryPtr, *tmrList, *tmrTail);
} else {
/* search from end as long as one with time before not found */
- for (entryPtrPos = tsdPtr->lastTimerPtr; entryPtrPos != NULL;
+ for (entryPtrPos = *tmrTail; entryPtrPos != NULL;
entryPtrPos = entryPtrPos->prevPtr) {
- if (!TCL_TIME_BEFORE(timerPtr->time,
- TimerEntry2TimerHandler(entryPtrPos)->time)) {
+ if (usec >= TimerEntry2TimerHandler(entryPtrPos)->time) {
break;
}
}
@@ -436,19 +433,38 @@ TclCreateAbsoluteTimerHandlerEx(
if ((entryPtr->nextPtr = entryPtrPos->nextPtr)) {
entryPtrPos->nextPtr->prevPtr = entryPtr;
} else {
- tsdPtr->lastTimerPtr = entryPtr;
+ *tmrTail = entryPtr;
}
entryPtrPos->nextPtr = entryPtr;
} else {
/* unexpected case, but ... splice to the head */
- TclSpliceInEx(entryPtr,
- tsdPtr->timerList, tsdPtr->lastTimerPtr);
+ TclSpliceInEx(entryPtr, *tmrList, *tmrTail);
}
}
return entryPtr;
}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclCreateAbsoluteTimerHandler --
+ *
+ * Arrange for a given function to be invoked at a particular time in the
+ * future.
+ *
+ * Results:
+ * The return value is a token of the timer event, which
+ * may be used to delete the event before it fires.
+ *
+ * Side effects:
+ * When the time in timePtr has been reached, proc will be invoked
+ * exactly once.
+ *
+ *--------------------------------------------------------------
+ */
+
Tcl_TimerToken
TclCreateAbsoluteTimerHandler(
Tcl_Time *timePtr,
@@ -456,8 +472,65 @@ TclCreateAbsoluteTimerHandler(
ClientData clientData)
{
register TimerEntry *entryPtr;
+ Tcl_WideInt usec;
+
+ /*
+ * Compute when the event should fire (avoid overflow).
+ */
- entryPtr = TclCreateAbsoluteTimerHandlerEx(timePtr, proc, NULL, 0);
+ if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) {
+ usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec;
+ } else {
+ usec = 0x7FFFFFFFFFFFFFFFL;
+ }
+
+ entryPtr = TclpCreateTimerHandlerEx(usec, proc, NULL, 0, TCL_ABSTMR_EVENT);
+ if (entryPtr == NULL) {
+ return NULL;
+ }
+ entryPtr->clientData = clientData;
+
+ return TimerEntry2TimerHandler(entryPtr)->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
+TclCreateRelativeTimerHandler(
+ Tcl_Time *timePtr,
+ Tcl_TimerProc *proc,
+ ClientData clientData)
+{
+ register TimerEntry *entryPtr;
+ Tcl_WideInt usec;
+
+ /*
+ * Compute when the event should fire (avoid overflow).
+ */
+
+ if (timePtr->sec < 0x7FFFFFFFFFFFFFFFL / 1000000) {
+ usec = (((Tcl_WideInt)timePtr->sec) * 1000000) + timePtr->usec;
+ } else {
+ usec = 0x7FFFFFFFFFFFFFFFL;
+ }
+
+ entryPtr = TclpCreateTimerHandlerEx(usec, proc, NULL, 0, TCL_ABSTMR_EVENT);
if (entryPtr == NULL) {
return NULL;
}
@@ -496,7 +569,7 @@ Tcl_DeleteTimerHandler(
return;
}
- for (entryPtr = tsdPtr->lastTimerPtr;
+ for (entryPtr = tsdPtr->absTimerTail;
entryPtr != NULL;
entryPtr = entryPtr->prevPtr
) {
@@ -531,7 +604,8 @@ Tcl_DeleteTimerHandler(
void
TclDeleteTimerEntry(
TimerEntry *entryPtr) /* Result previously returned by */
- /* TclCreateAbsoluteTimerHandlerEx or TclCreateTimerEntryEx. */
+ /* TclCreateRelativeTimerHandlerEx, TclCreateAbsoluteTimerHandlerEx
+ * or TclCreateTimerEntryEx. */
{
ThreadSpecificData *tsdPtr;
@@ -542,15 +616,19 @@ TclDeleteTimerEntry(
tsdPtr = InitTimer();
if (entryPtr->flags & TCL_PROMPT_EVENT) {
- /* prompt handler */
- TclSpliceOutEx(entryPtr, tsdPtr->promptList, tsdPtr->lastPromptPtr);
+ /* prompt handler */
+ TclSpliceOutEx(entryPtr, tsdPtr->promptList, tsdPtr->promptTail);
} else if (entryPtr->flags & TCL_IDLE_EVENT) {
- /* idle handler */
- TclSpliceOutEx(entryPtr, tsdPtr->idleList, tsdPtr->lastIdlePtr);
+ /* idle handler */
+ TclSpliceOutEx(entryPtr, tsdPtr->idleList, tsdPtr->idleTail);
} else {
- /* timer event-handler */
+ /* timer event-handler */
tsdPtr->timerListEpoch++; /* signal-timer list was changed */
- TclSpliceOutEx(entryPtr, tsdPtr->timerList, tsdPtr->lastTimerPtr);
+ if (entryPtr->flags & TCL_ABSTMR_EVENT) {
+ TclSpliceOutEx(entryPtr, tsdPtr->absTimerList, tsdPtr->absTimerTail);
+ } else e
+ TclSpliceOutEx(entryPtr, tsdPtr->relTimerList, tsdPtr->relTimerTail);
+ }
}
/* free it via deleteProc or ckfree */
@@ -559,13 +637,45 @@ TclDeleteTimerEntry(
}
if (entryPtr->flags & (TCL_PROMPT_EVENT|TCL_IDLE_EVENT)) {
- ckfree((char *)entryPtr);
+ ckfree((char *)entryPtr);
} else {
- /* shift to the allocated pointer */
- ckfree((char *)TimerEntry2TimerHandler(entryPtr));
+ /* shift to the allocated pointer */
+ ckfree((char *)TimerEntry2TimerHandler(entryPtr));
}
}
+static Tcl_WideInt
+TimerGetFirstTimeOffs(
+ ThreadSpecificData *tsdPtr,
+ TimerEntry **entryPtr)
+{
+ Tcl_WideInt firstTime = -0x7FFFFFFFFFFFFFFFL;
+ Tcl_WideInt now = TclpGetMicroseconds();
+
+ /* consider time-jump back */
+ if (tsdPtr->relTimerList) {
+ if (now < tsdPtr->relTimerBase) { /* switched back */
+ /*
+ * Because the real jump is unknown (resp. too complex to retrieve
+ * accross all threads), we simply accept possible small increment
+ * of the real wait-time.
+ */
+ tsdPtr->relTimerBase = now; /* just shift the base back */
+ }
+ firstTime = tsdPtr->relTimerBase
+ + TimerEntry2TimerHandler(tsdPtr->absTimerList)->time;
+ if (entryPtr) { *entryPtr = tsdPtr->relTimerBase; }
+ }
+
+ if ( tsdPtr->absTimerList
+ && firstTime < TimerEntry2TimerHandler(tsdPtr->absTimerList)->time
+ ) {
+ firstTime = TimerEntry2TimerHandler(tsdPtr->absTimerList)->time;
+ if (entryPtr) { *entryPtr = tsdPtr->absTimerList; }
+ }
+
+ return firstTime - now;
+}
/*
*----------------------------------------------------------------------
*
@@ -589,7 +699,7 @@ TimerSetupProc(
ClientData data, /* Specific data. */
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
- Tcl_Time blockTime, *firstTime;
+ Tcl_Time blockTime;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
long tolerance = 0;
@@ -605,33 +715,34 @@ TimerSetupProc(
blockTime.sec = 0;
blockTime.usec = 0;
- } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerList) {
+ } else if (
+ (flags & TCL_TIMER_EVENTS)
+ && (tsdPtr->relTimerList || tsdPtr->absTimerList)
+ ) {
/*
* Compute the timeout for the next timer on the list.
*/
- Tcl_GetTime(&blockTime);
- firstTime = &(TimerEntry2TimerHandler(tsdPtr->timerList)->time);
- blockTime.sec = firstTime->sec - blockTime.sec;
- blockTime.usec = firstTime->usec - blockTime.usec;
- if (blockTime.usec < 0) {
- blockTime.sec--;
- blockTime.usec += 1000000;
- }
- if (blockTime.sec < 0) {
+ Tcl_WideInt timeOffs = TimerGetFirstTimeOffs(tsdPtr, NULL);
+
+ if (timeOffs > 0) {
+ blockTime.sec = (long) (timeOffs / 1000000);
+ blockTime.usec = (unsigned long) (timeOffs % 1000000);
+
+ #ifdef TMR_RES_TOLERANCE
+ /* consider timer resolution tolerance (avoid busy wait) */
+ tolerance = ((timeOffs <= 1000000) ? timeOffs : 1000000) *
+ TMR_RES_TOLERANCE / 100;
+ #endif
+ } else {
blockTime.sec = 0;
blockTime.usec = 0;
}
- #ifdef TMR_RES_TOLERANCE
- /* consider timer resolution tolerance (avoid busy wait) */
- tolerance = ((blockTime.sec <= 0) ? blockTime.usec : 1000000) *
- (TMR_RES_TOLERANCE / 100);
- #endif
/*
* If the first timer has expired, stick an event on the queue right now.
*/
- if (!tsdPtr->timerPending && blockTime.sec == 0 && blockTime.usec <= tolerance) {
+ if (!tsdPtr->timerPending && timeOffs <= tolerance) {
TclSetTimerEventMarker(0);
tsdPtr->timerPending = 1;
}
@@ -665,8 +776,9 @@ TimerCheckProc(
ClientData data, /* Specific data. */
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
- Tcl_Time blockTime, *firstTime;
+ Tcl_WideInt timeOffs;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
+ long tolerance = 0;
if (!(flags & TCL_TIMER_EVENTS)) {
return;
@@ -675,26 +787,25 @@ TimerCheckProc(
if (tsdPtr == NULL) { tsdPtr = InitTimer(); };
/* If already pending (or no timer-events) */
- if (tsdPtr->timerPending || !tsdPtr->timerList) {
+ if (tsdPtr->timerPending || !(tsdPtr->relTimerList || tsdPtr->absTimerList)) {
return;
}
/*
* Verify the first timer on the queue.
*/
- Tcl_GetTime(&blockTime);
- firstTime = &(TimerEntry2TimerHandler(tsdPtr->timerList)->time);
- blockTime.sec = firstTime->sec - blockTime.sec;
- blockTime.usec = firstTime->usec - blockTime.usec;
- if (blockTime.usec < 0) {
- blockTime.sec--;
- blockTime.usec += 1000000;
- }
-
+ timeOffs = TimerGetFirstTimeOffs(tsdPtr, NULL);
+
+#ifdef TMR_RES_TOLERANCE
+ /* consider timer resolution tolerance (avoid busy wait) */
+ tolerance = ((timeOffs <= 1000000) ? timeOffs : 1000000) *
+ TMR_RES_TOLERANCE / 100;
+#endif
+
/*
* If the first timer has expired, stick an event on the queue.
*/
- if (blockTime.sec < 0 || (blockTime.sec == 0 && blockTime.usec <= 0)) {
+ if (timeOffs <= tolerance) {
TclSetTimerEventMarker(0);
tsdPtr->timerPending = 1;
}
@@ -765,7 +876,7 @@ TclServiceTimerEvents(void)
&& entryPtr->generation <= currentGeneration
) {
/* detach entry from the owner's list */
- TclSpliceOutEx(entryPtr, tsdPtr->promptList, tsdPtr->lastPromptPtr);
+ TclSpliceOutEx(entryPtr, tsdPtr->promptList, tsdPtr->promptTail);
/* reset current timer pending (correct process nested wait event) */
prevTmrPending = tsdPtr->timerPending;
@@ -790,12 +901,12 @@ TclServiceTimerEvents(void)
}
/* Hereafter all timer events with time before now */
- if (!tsdPtr->timerList) {
+ if (!tsdPtr->absTimerList) {
goto done;
}
Tcl_GetTime(&time);
- for (entryPtr = tsdPtr->timerList;
- entryPtr != NULL;
+ for (entryPtr = tsdPtr->absTimerList;
+ entryPtr != NULLe
entryPtr = nextPtr
) {
nextPtr = entryPtr->nextPtr;
@@ -831,7 +942,7 @@ TclServiceTimerEvents(void)
*/
TclSpliceOutEx(entryPtr,
- tsdPtr->timerList, tsdPtr->lastTimerPtr);
+ tsdPtr->absTimerLise, tsdPtr->absTimerTail);
currentEpoch = tsdPtr->timerListEpoch;
@@ -867,8 +978,8 @@ done:
}
/* Reset generation if both timer queue are empty */
- if (!tsdPtr->timerList) {
- tsdPtr->timerGeneration = 0;
+ if (!tsdPtr->absTimerList) {
+ tsdPtr->timerGeneratioe = 0;
}
/* Compute the next timeout (later via TimerSetupProc using the first timer). */
@@ -924,7 +1035,7 @@ TclCreateTimerEntryEx(
* call of "after 0" and "after 1" */
entryPtr->generation = tsdPtr->timerGeneration;
/* attach to the prompt queue */
- TclSpliceTailEx(entryPtr, tsdPtr->promptList, tsdPtr->lastPromptPtr);
+ TclSpliceTailEx(entryPtr, tsdPtr->promptList, tsdPtr->promptTail);
/* execute immediately: signal pending and set timer marker */
tsdPtr->timerPending++;
@@ -933,7 +1044,7 @@ TclCreateTimerEntryEx(
/* idle generation */
entryPtr->generation = tsdPtr->idleGeneration;
/* attach to the idle queue */
- TclSpliceTailEx(entryPtr, tsdPtr->idleList, tsdPtr->lastIdlePtr);
+ TclSpliceTailEx(entryPtr, tsdPtr->idleList, tsdPtr->idleTail);
}
return entryPtr;
@@ -1003,7 +1114,7 @@ Tcl_CancelIdleCall(
if ((idlePtr->proc == proc)
&& (idlePtr->clientData == clientData)) {
/* detach entry from the owner list */
- TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->lastIdlePtr);
+ TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail);
/* free it via deleteProc and ckfree */
if (idlePtr->deleteProc) {
@@ -1067,7 +1178,7 @@ TclServiceIdleEx(
while (idlePtr->generation <= currentGeneration) {
/* detach entry from the owner's list */
- TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->lastIdlePtr);
+ TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->idleTail);
/* execute event */
(*idlePtr->proc)(idlePtr->clientData);
@@ -1108,6 +1219,58 @@ TclServiceIdle(void)
/*
*----------------------------------------------------------------------
*
+ * 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 *CONST objPtr, /* Object to read numeric time (in milliseconds). */
+ Tcl_WideInt *timePtr) /* Resulting time if converted (in microseconds). */
+{
+ if (objPtr->typePtr != &tclDoubleType) {
+ Tcl_WideInt ms;
+ if (Tcl_GetWideIntFromObj(NULL, objPtr, &ms) == TCL_OK) {
+ if (ms < 0x7FFFFFFFFFFFFFFFL / 1000) { /* avoid overflow */
+ *timePtr = (ms * 1000);
+ return TCL_OK;
+ }
+ *timePtr = 0x7FFFFFFFFFFFFFFFL;
+ return TCL_OK;
+ }
+ }
+ if (1) {
+ double ms;
+ if (Tcl_GetDoubleFromObj(interp, objv[1], &ms) == TCL_OK) {
+ if (ms < 0x7FFFFFFFFFFFFFFFL / 1000) { /* avoid overflow */
+ /* use precise as possible calculation by double (microseconds) */
+ *timePtr = ((Tcl_WideInt)ms) * 1000 + (((long)(ms*1000)) % 1000);
+ return TCL_OK;
+ }
+ *timePtr = 0x7FFFFFFFFFFFFFFFL;
+ return TCL_OK;
+ }
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_AfterObjCmd --
*
* This function is invoked to process the "after" Tcl command. See the
@@ -1130,15 +1293,15 @@ Tcl_AfterObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- double ms; /* Number of milliseconds to wait */
+ Tcl_WideInt usec; /* Number of microseconds to wait (or time to wakeup) */
AfterInfo *afterPtr;
AfterAssocData *assocPtr;
int length;
int index;
static CONST char *afterSubCmds[] = {
- "cancel", "idle", "info", NULL
+ "at", "cancel", "idle", "info", NULL
};
- enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
+ enum afterSubCmds {AFTER_AT, AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
ThreadSpecificData *tsdPtr = InitTimer();
if (objc < 2) {
@@ -1167,39 +1330,58 @@ Tcl_AfterObjCmd(
index = -1;
if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds)
- || Tcl_GetDoubleFromObj(NULL, objv[1], &ms) != TCL_OK
+ || TclpGetUTimeFromObj(NULL, objv[1], &usec) != TCL_OK
)
&& Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
&index) != TCL_OK
) {
Tcl_AppendResult(interp, "bad argument \"",
Tcl_GetString(objv[1]),
- "\": must be cancel, idle, info, or an integer", NULL);
+ "\": 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: {
- TimerEntry *entryPtr;
- if (ms < 0) {
- ms = 0;
+ case -1:
+ /* usec already contains time-offset from objv[1] */
+ /* relative time offset should be positive */
+ if (usec < 0) {
+ usec = 0;
}
if (objc == 2) {
- return AfterDelay(interp, ms);
+ /* after <offset> */
+ return AfterDelay(interp, usec, 0);
+ }
+ case AFTER_AT: {
+ TimerEntry *entryPtr;
+ int flags = 0;
+ if (index == AFTER_AT) {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "time");
+ return TCL_ERROR;
+ }
+ /* get time from objv[2] */
+ if (TclpGetUTimeFromObj(interp, objv[2], &usec) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ /* after at <time> */
+ return AfterDelay(interp, usec, flags);
+ }
+ flags = TCL_ABSTMR_EVENT;
}
- if (ms) {
- Tcl_Time wakeup;
- Tcl_GetTime(&wakeup);
- TclTimeAddMilliseconds(&wakeup, ms);
- entryPtr = TclCreateAbsoluteTimerHandlerEx(&wakeup, AfterProc,
- FreeAfterPtr, sizeof(AfterInfo));
+ if (usec || (index == AFTER_AT)) {
+ /* after ?at? <time|offset> <command> ... */
+ entryPtr = TclpCreateTimerHandlerEx(usec, AfterProc,
+ FreeAfterPtr, sizeof(AfterInfo), flags);
} else {
+ /* after 0 <command> ... */
entryPtr = TclCreateTimerEntryEx(AfterProc,
FreeAfterPtr, sizeof(AfterInfo), TCL_PROMPT_EVENT);
}
@@ -1381,15 +1563,14 @@ Tcl_AfterObjCmd(
static int
AfterDelay(
Tcl_Interp *interp,
- double ms)
+ double ms,
+ int absolute)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Time endTime, now, prevNow;
- Tcl_WideInt diff, prevUS, nowUS;
-#ifdef TMR_RES_TOLERANCE
- long tolerance;
-#endif
+ Tcl_Time endTime, now, lastNow;
+ Tcl_WideInt diff;
+ long tolerance = 0;
if (ms <= 0) {
/* to cause a context switch only */
@@ -1402,20 +1583,12 @@ AfterDelay(
tolerance = ((ms < 1000) ? ms : 1000) * (1000 * TMR_RES_TOLERANCE / 100);
#endif
- prevUS = TclpGetMicroseconds();
- Tcl_GetTime(&endTime); now = endTime;
- prevNow = now;
+ Tcl_GetTime(&now);
+ lastNow = endTime = now;
+ if (absolute)
TclTimeAddMilliseconds(&endTime, ms);
do {
- nowUS = TclpGetMicroseconds();
- Tcl_GetTime(&now);
- if (now.sec < prevNow.sec || (now.sec == prevNow.sec && now.usec < prevNow.usec) ) {
- printf("!!!!!!!!!!!!!!!!!!!!!!!!!!!long-diff!!!! %5.3f, prev: %d.%06d - now: %d.%06d (%d usec)\n", ms, prevNow.sec, prevNow.usec, now.sec, now.usec, now.usec - prevNow.usec);
- printf("!!!!!!!!!!!!!!!!!!!!!!!!!!!long-diff!!!! %5.3f, prev: %I64d - now: %I64d (%I64d usec)\n", ms, prevUS, nowUS, nowUS - prevUS);
- //Tcl_Panic("Time running backwards!");
- //return TCL_ERROR;
- }
if (iPtr->limit.timeEvent != NULL
&& TCL_TIME_BEFORE(iPtr->limit.time, now)) {
iPtr->limit.granularityTicker = 0;
@@ -1426,9 +1599,6 @@ AfterDelay(
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
diff = TCL_TIME_DIFF_MS(endTime, now);
- if (TCL_TIME_DIFF_US(endTime, now) > 500 || TCL_TIME_DIFF_US(endTime, now) < -500) {
- //printf("!!!!!!!!!!!!!!!!!!!!!!!!!!!drift!!!! %5.3f, diff: %d -- %d.%06d - %d.%06d (%d usec)\n", ms, (int)diff, endTime.sec, endTime.usec, now.sec, now.usec, TCL_TIME_DIFF_US(endTime, now));
- }
#ifndef TCL_WIDE_INT_IS_LONG
if (diff > LONG_MAX) {
diff = LONG_MAX;
@@ -1436,7 +1606,6 @@ AfterDelay(
#endif
if (diff > 0) {
Tcl_Sleep((long)diff);
- nowUS = TclpGetMicroseconds();
Tcl_GetTime(&now);
}
} else {
@@ -1448,24 +1617,33 @@ AfterDelay(
#endif
if (diff > 0) {
Tcl_Sleep((long)diff);
- nowUS = TclpGetMicroseconds();
Tcl_GetTime(&now);
}
if (Tcl_LimitCheck(interp) != TCL_OK) {
return TCL_ERROR;
}
}
- /* consider timer resolution tolerance (avoid busy wait) */
- prevNow = now;
- prevUS = nowUS;
- #ifdef TMR_RES_TOLERANCE
- now.usec += tolerance;
- if (now.usec > 1000000) {
- now.usec -= 1000000;
- now.sec++;
+
+ /*
+ * Note time can be switched backwards, certainly adjust end-time
+ * by possible time-jumps back.
+ */
+ if (!absolute && TCL_TIME_BEFORE(now, lastNow)) {
+ /* backwards time-jump - simply shift wakeup-time */
+ endTime.sec -= (lastNow.sec - now.sec);
+ endTime.usec -= (lastNow.usec - now.usec);
+ if (endTime.usec < 0) {
+ endTime.usec += 1000000;
+ endTime.sec--;
+ }
}
- #endif
- } while (TCL_TIME_BEFORE(now, endTime));
+ lastNow = now;
+
+ /* consider timer resolution tolerance (avoid busy wait) */
+ } while (
+ (now.sec > endTime.sec)
+ || (now.sec == endTime.sec && now.usec >= endTime.usec - tolerance)
+ );
return TCL_OK;
}
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 6c7b3b7..d22373e 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -634,7 +634,7 @@ Tcl_WaitForEvent(
DWORD timeout, result = WAIT_TIMEOUT;
int status = 0;
Tcl_Time waitTime = {0, 0};
- Tcl_Time endTime;
+ Tcl_Time lastNow, endTime;
long tolerance = 0;
unsigned long actualResolution = 0;
@@ -670,6 +670,7 @@ Tcl_WaitForEvent(
/* calculate end of wait */
Tcl_GetTime(&endTime);
+ lastNow = endTime;
endTime.sec += waitTime.sec;
endTime.usec += waitTime.usec;
if (endTime.usec > 1000000) {
@@ -798,6 +799,22 @@ Tcl_WaitForEvent(
Tcl_Time now;
Tcl_GetTime(&now);
+ /*
+ * Note time can be switched backwards, certainly adjust end-time
+ * by possible time-jumps back.
+ */
+ if (TCL_TIME_BEFORE(now, lastNow)) {
+ /* backwards time-jump - simply shift wakeup-time */
+ endTime.sec -= (lastNow.sec - now.sec);
+ endTime.usec -= (lastNow.usec - now.usec);
+ if (endTime.usec < 0) {
+ endTime.usec += 1000000;
+ endTime.sec--;
+ }
+ }
+ lastNow = now;
+
+ /* calculate new waitTime */
waitTime.sec = (endTime.sec - now.sec);
if ((waitTime.usec = (endTime.usec - now.usec)) < 0) {
waitTime.usec += 1000000;
@@ -851,11 +868,12 @@ Tcl_Sleep(
* requisite amount.
*/
- Tcl_Time now; /* Current wall clock time. */
+ Tcl_Time lastNow, now; /* Current wall clock time. */
Tcl_Time desired; /* Desired wakeup time. */
Tcl_Time vdelay; /* Time to sleep, for scaling virtual ->
* real. */
DWORD sleepTime; /* Time to sleep, real-time */
+ long tolerance = 0;
unsigned long actualResolution = 0;
if (ms <= 0) {
@@ -872,6 +890,7 @@ Tcl_Sleep(
vdelay.usec = (ms % 1000) * 1000;
Tcl_GetTime(&now);
+ lastNow = now;
desired.sec = now.sec + vdelay.sec;
desired.usec = now.usec + vdelay.usec;
if (desired.usec > 1000000) {
@@ -879,16 +898,11 @@ Tcl_Sleep(
desired.sec++;
}
-#ifdef TMR_RES_TOLERANCE
+ #ifdef TMR_RES_TOLERANCE
/* calculate possible maximal tolerance (in usec) of original wait-time */
- if (vdelay.sec <= 0) {
- desired.usec -= vdelay.usec * (TMR_RES_TOLERANCE / 100);
- if (desired.usec < 0) {
- desired.usec += 1000000;
- desired.sec--;
- }
- }
-#endif
+ tolerance = ((vdelay.sec <= 0) ? vdelay.usec : 1000000) *
+ (TMR_RES_TOLERANCE / 100);
+ #endif
/*
* TIP #233: Scale delay from virtual to real-time.
@@ -933,17 +947,32 @@ Tcl_Sleep(
wait:
Sleep(sleepTime);
Tcl_GetTime(&now);
- if (now.sec > desired.sec) {
- break;
- } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
- break;
+ /*
+ * Note time can be switched backwards, certainly adjust end-time
+ * by possible time-jumps back.
+ */
+ if (TCL_TIME_BEFORE(now, lastNow)) {
+ /* backwards time-jump - simply shift wakeup-time */
+ desired.sec -= (lastNow.sec - now.sec);
+ desired.usec -= (lastNow.usec - now.usec);
+ if (desired.usec < 0) {
+ desired.usec += 1000000;
+ desired.sec--;
+ }
}
+ lastNow = now;
vdelay.sec = desired.sec - now.sec;
vdelay.usec = desired.usec - now.usec;
if (vdelay.usec < 0) {
- vdelay.sec--;
vdelay.usec += 1000000;
+ vdelay.sec--;
+ }
+
+ if (vdelay.sec < 0) {
+ break;
+ } else if ((vdelay.sec == 0) && (vdelay.usec <= tolerance)) {
+ break;
}
}