Attachment "another-tip302.patch" to
ticket [3328635fff]
added by
chw
2018-03-08 23:36:57.
Index: doc/after.n
==================================================================
--- doc/after.n
+++ doc/after.n
@@ -14,10 +14,12 @@
.SH SYNOPSIS
\fBafter \fIms\fR
.sp
\fBafter \fIms \fR?\fIscript script script ...\fR?
.sp
+\fBafter \-at \fItime script script script ...\fR
+.sp
\fBafter cancel \fIid\fR
.sp
\fBafter cancel \fIscript script script ...\fR
.sp
\fBafter idle \fR?\fIscript script script ...\fR?
@@ -50,10 +52,25 @@
If an error occurs while executing the delayed command then
the background error will be reported by the command
registered with \fBinterp bgerror\fR.
The \fBafter\fR command returns an identifier that can be used
to cancel the delayed command using \fBafter cancel\fR.
+.TP
+\fB after \-at \fItime script script script ...\fR
+.
+This command form is similar to the milliseconds form above but
+arranges for a Tcl command to be executed not before \fItime\fR,
+which specifies an absolute point in time based on the \fBclock\fR
+command. It implies a resolution of one second. Error handling
+and return value are identical to the millisecond form of the
+\fBafter\fR command. If the platform supports some kind of monotonic
+clock, the initial computation of the duration when the script is to
+execute is based on the difference of the wall time to the monotonic
+clock source at command evaluation. Should the wall time change
+until that initial duration expires, the time to execute the script
+is recomputed based on the new wall time and the timer is restarted
+to fit the new situation.
.TP
\fBafter cancel \fIid\fR
.
Cancels the execution of a delayed command that
was previously scheduled.
Index: generic/tclClock.c
==================================================================
--- generic/tclClock.c
+++ generic/tclClock.c
@@ -1690,16 +1690,19 @@
{
/*
* Get a thread-local buffer to hold the returned time.
*/
- struct tm *tmPtr = Tcl_GetThreadData(&tmKey, sizeof(struct tm));
-#ifdef HAVE_LOCALTIME_R
- localtime_r(timePtr, tmPtr);
-#else
+ struct tm *tmPtr = Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
struct tm *sysTmPtr;
+#ifdef HAVE_LOCALTIME_R
+ sysTmPtr = localtime_r(timePtr, tmPtr);
+ if (sysTmPtr == NULL) {
+ return NULL;
+ }
+#else
Tcl_MutexLock(&clockMutex);
sysTmPtr = localtime(timePtr);
if (sysTmPtr == NULL) {
Tcl_MutexUnlock(&clockMutex);
return NULL;
Index: generic/tclCmdMZ.c
==================================================================
--- generic/tclCmdMZ.c
+++ generic/tclCmdMZ.c
@@ -4156,11 +4156,11 @@
}
objPtr = objv[1];
i = count;
#ifndef TCL_WIDE_CLICKS
- Tcl_GetTime(&start);
+ TclpGetMonotonicTime(&start);
#else
start = TclpGetWideClicks();
#endif
while (i-- > 0) {
result = Tcl_EvalObjEx(interp, objPtr, 0);
@@ -4167,11 +4167,11 @@
if (result != TCL_OK) {
return result;
}
}
#ifndef TCL_WIDE_CLICKS
- Tcl_GetTime(&stop);
+ TclpGetMonotonicTime(&stop);
totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6
+ (stop.usec - start.usec);
#else
stop = TclpGetWideClicks();
totalMicroSec = ((double) TclpWideClicksToNanoseconds(stop - start))/1.0e3;
Index: generic/tclInt.decls
==================================================================
--- generic/tclInt.decls
+++ generic/tclInt.decls
@@ -1277,11 +1277,14 @@
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}
-
+# TIP#302 ???
+declare 31 {win unix macosx} {
+ int TclpGetMonotonicTime(Tcl_Time *timePtr)
+}
# Local Variables:
# mode: tcl
# End:
Index: generic/tclIntPlatDecls.h
==================================================================
--- generic/tclIntPlatDecls.h
+++ generic/tclIntPlatDecls.h
@@ -101,10 +101,12 @@
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
+/* 31 */
+EXTERN int TclpGetMonotonicTime(Tcl_Time *timePtr);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
@@ -176,10 +178,12 @@
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
+/* 31 */
+EXTERN int TclpGetMonotonicTime(Tcl_Time *timePtr);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -250,10 +254,12 @@
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
+/* 31 */
+EXTERN int TclpGetMonotonicTime(Tcl_Time *timePtr);
#endif /* MACOSX */
typedef struct TclIntPlatStubs {
int magic;
void *hooks;
@@ -288,10 +294,11 @@
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
+ int (*tclpGetMonotonicTime) (Tcl_Time *timePtr); /* 31 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
@@ -321,10 +328,11 @@
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
+ int (*tclpGetMonotonicTime) (Tcl_Time *timePtr); /* 31 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -354,10 +362,11 @@
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
+ int (*tclpGetMonotonicTime) (Tcl_Time *timePtr); /* 31 */
#endif /* MACOSX */
} TclIntPlatStubs;
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
@@ -417,10 +426,12 @@
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
+#define TclpGetMonotonicTime \
+ (tclIntPlatStubsPtr->tclpGetMonotonicTime) /* 31 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
@@ -479,10 +490,12 @@
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
+#define TclpGetMonotonicTime \
+ (tclIntPlatStubsPtr->tclpGetMonotonicTime) /* 31 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
@@ -533,10 +546,12 @@
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
+#define TclpGetMonotonicTime \
+ (tclIntPlatStubsPtr->tclpGetMonotonicTime) /* 31 */
#endif /* MACOSX */
#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
Index: generic/tclInterp.c
==================================================================
--- generic/tclInterp.c
+++ generic/tclInterp.c
@@ -3386,11 +3386,11 @@
if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
((iPtr->limit.timeGranularity == 1) ||
(ticker % iPtr->limit.timeGranularity == 0))) {
Tcl_Time now;
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
if (iPtr->limit.time.sec < now.sec ||
(iPtr->limit.time.sec == now.sec &&
iPtr->limit.time.usec < now.usec)) {
iPtr->limit.exceeded |= TCL_LIMIT_TIME;
Tcl_Preserve(interp);
@@ -3941,11 +3941,29 @@
Tcl_LimitSetTime(
Tcl_Interp *interp,
Tcl_Time *timeLimitPtr)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Time nextMoment;
+ Tcl_Time nextMoment, mono, real, limit;
+
+ if (TclpGetMonotonicTime(&mono)) {
+ Tcl_GetTime(&real);
+ limit = *timeLimitPtr;
+ limit.sec -= real.sec;
+ limit.usec -= real.usec;
+ if (limit.usec < 0) {
+ limit.sec -= 1;
+ limit.usec += 1000000;
+ }
+ limit.sec += mono.sec;
+ limit.usec += mono.usec;
+ if (limit.usec >= 1000000) {
+ limit.sec += 1;
+ limit.usec -= 1000000;
+ }
+ timeLimitPtr = &limit;
+ }
memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time));
if (iPtr->limit.timeEvent != NULL) {
Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
}
@@ -4026,11 +4044,30 @@
Tcl_LimitGetTime(
Tcl_Interp *interp,
Tcl_Time *timeLimitPtr)
{
Interp *iPtr = (Interp *) interp;
+ Tcl_Time mono, real, limit;
+ if (TclpGetMonotonicTime(&mono)) {
+ Tcl_GetTime(&real);
+ limit = iPtr->limit.time;
+ limit.sec -= mono.sec;
+ limit.usec -= mono.usec;
+ if (limit.usec < 0) {
+ limit.sec -= 1;
+ limit.usec += 1000000;
+ }
+ limit.sec += real.sec;
+ limit.usec += real.usec;
+ if (limit.usec >= 1000000) {
+ limit.sec += 1;
+ limit.usec -= 1000000;
+ }
+ memcpy(timeLimitPtr, &limit, sizeof(Tcl_Time));
+ return;
+ }
memcpy(timeLimitPtr, &iPtr->limit.time, sizeof(Tcl_Time));
}
/*
*----------------------------------------------------------------------
Index: generic/tclStubInit.c
==================================================================
--- generic/tclStubInit.c
+++ generic/tclStubInit.c
@@ -634,10 +634,11 @@
0, /* 26 */
0, /* 27 */
0, /* 28 */
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
+ TclpGetMonotonicTime, /* 31 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
@@ -667,10 +668,11 @@
TclWinSetInterfaces, /* 26 */
TclWinFlushDirtyChannels, /* 27 */
TclWinResetInterfaces, /* 28 */
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
+ TclpGetMonotonicTime, /* 31 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
TclGetAndDetachPids, /* 0 */
TclpCloseFile, /* 1 */
TclpCreateCommandChannel, /* 2 */
@@ -700,10 +702,11 @@
0, /* 26 */
0, /* 27 */
0, /* 28 */
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
+ TclpGetMonotonicTime, /* 31 */
#endif /* MACOSX */
};
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
Index: generic/tclTimer.c
==================================================================
--- generic/tclTimer.c
+++ generic/tclTimer.c
@@ -40,15 +40,19 @@
* interp in which command will be
* executed. */
Tcl_Obj *commandPtr; /* Command to execute. */
int id; /* Integer identifier for command; used to
* cancel it. */
+ int isAbsolute; /* True for "after -at ..." command form. */
+ Tcl_Time absoluteTime; /* Used for "after -at ..." command form. */
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. */
+ struct AfterInfo *prevPtr; /* Previous in list of all "after" commands for
+ * this interpreter. */
struct AfterInfo *nextPtr; /* Next in list of all "after" commands for
* this interpreter. */
} AfterInfo;
/*
@@ -119,11 +123,12 @@
* 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))
+ ((((t1).sec - (t2).sec) < 0) || \
+ ((t1).sec == (t2).sec && ((t1).usec - (t2).usec) < 0))
#define TCL_TIME_DIFF_MS(t1, t2) \
(1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
((long)(t1).usec - (long)(t2).usec)/1000)
@@ -257,11 +262,14 @@
/*
* Compute when the event should fire.
*/
- Tcl_GetTime(&time);
+ if (milliseconds < 0) {
+ milliseconds = 0;
+ }
+ TclpGetMonotonicTime(&time);
time.sec += milliseconds/1000;
time.usec += (milliseconds%1000)*1000;
if (time.usec >= 1000000) {
time.usec -= 1000000;
time.sec += 1;
@@ -415,11 +423,11 @@
} else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
/*
* Compute the timeout for the next timer on the list.
*/
- Tcl_GetTime(&blockTime);
+ TclpGetMonotonicTime(&blockTime);
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
blockTime.usec;
if (blockTime.usec < 0) {
blockTime.sec -= 1;
@@ -466,11 +474,11 @@
if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
/*
* Compute the timeout for the next timer on the list.
*/
- Tcl_GetTime(&blockTime);
+ TclpGetMonotonicTime(&blockTime);
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
blockTime.usec;
if (blockTime.usec < 0) {
blockTime.sec -= 1;
@@ -562,11 +570,11 @@
* timers appearing before later ones.
*/
tsdPtr->timerPending = 0;
currentTimerId = tsdPtr->lastTimerId;
- Tcl_GetTime(&time);
+ TclpGetMonotonicTime(&time);
while (1) {
nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
if (timerHandlerPtr == NULL) {
break;
@@ -788,10 +796,12 @@
Tcl_Time wakeup;
AfterInfo *afterPtr;
AfterAssocData *assocPtr;
int length;
int index;
+ int isAbsolute = 0;
+ const char *arg;
static const char *const afterSubCmds[] = {
"cancel", "idle", "info", NULL
};
enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
ThreadSpecificData *tsdPtr = InitTimer();
@@ -816,29 +826,47 @@
/*
* First lets see if the command was passed a number as the first argument.
*/
- if (objv[1]->typePtr == &tclIntType
+ arg = Tcl_GetString(objv[1]);
+ if (strcmp(arg, "-at") == 0) {
+ if (objc < 3) {
+ goto badAtArg;
+ }
+ isAbsolute = 1;
+ }
+ if (objv[1 + isAbsolute]->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
- || objv[1]->typePtr == &tclWideIntType
+ || objv[1 + isAbsolute]->typePtr == &tclWideIntType
#endif
- || objv[1]->typePtr == &tclBignumType
- || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
- &index) != TCL_OK)) {
+ || objv[1 + isAbsolute]->typePtr == &tclBignumType
+ || (Tcl_GetIndexFromObj(NULL, objv[1 + isAbsolute],
+ afterSubCmds, "", 0, &index) != TCL_OK)) {
index = -1;
- if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
- const char *arg = Tcl_GetString(objv[1]);
-
+ if (Tcl_GetWideIntFromObj(NULL, objv[1 + isAbsolute], &ms) != TCL_OK) {
+badArg:
+ arg = Tcl_GetString(objv[1 + isAbsolute]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad argument \"%s\": must be"
- " cancel, idle, info, or an integer", arg));
+ " cancel, idle, info, an integer, or \"-at\" integer",
+ arg));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
arg, NULL);
return TCL_ERROR;
}
}
+
+ if ((index >= 0) && isAbsolute) {
+ isAbsolute = 0;
+ goto badArg;
+ }
+ if (isAbsolute && (objc < 4)) {
+badAtArg:
+ Tcl_WrongNumArgs(interp, 2, objv, "time script ...");
+ return TCL_ERROR;
+ }
/*
* At this point, either index = -1 and ms contains the number of ms
* to wait, or else index is the index of a subcommand.
*/
@@ -851,14 +879,15 @@
if (objc == 2) {
return AfterDelay(interp, ms);
}
afterPtr = ckalloc(sizeof(AfterInfo));
afterPtr->assocPtr = assocPtr;
- if (objc == 3) {
- afterPtr->commandPtr = objv[2];
+ if (objc == 3 + isAbsolute) {
+ afterPtr->commandPtr = objv[2 + isAbsolute];
} else {
- afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
+ afterPtr->commandPtr = Tcl_ConcatObj(objc - 2 - isAbsolute,
+ objv + 2 + isAbsolute);
}
Tcl_IncrRefCount(afterPtr->commandPtr);
/*
* The variable below is used to generate unique identifiers for after
@@ -869,21 +898,48 @@
* 1-10 years. Thus it's unlikely that any old ids will still be
* around when wrap-around occurs.
*/
afterPtr->id = tsdPtr->afterId;
+ afterPtr->isAbsolute = isAbsolute;
tsdPtr->afterId += 1;
- Tcl_GetTime(&wakeup);
- wakeup.sec += (long)(ms / 1000);
- wakeup.usec += ((long)(ms % 1000)) * 1000;
- if (wakeup.usec > 1000000) {
- wakeup.sec++;
- wakeup.usec -= 1000000;
+ if (afterPtr->isAbsolute) {
+ Tcl_GetTime(&wakeup);
+ afterPtr->absoluteTime.sec = ms;
+ afterPtr->absoluteTime.usec = 0;
+ ms = TCL_TIME_DIFF_MS_CEILING(afterPtr->absoluteTime, wakeup);
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (ms > LONG_MAX) {
+ ms = LONG_MAX;
+ }
+#endif
+ if (ms < 0) {
+ ms = 0;
+ }
+ } else {
+ afterPtr->absoluteTime.sec = 0;
+ afterPtr->absoluteTime.usec = 0;
+ }
+ TclpGetMonotonicTime(&wakeup);
+ if (((wakeup.sec + (long)(ms / 1000)) - (wakeup.sec)) < 0) {
+ wakeup.sec += LONG_MAX - 1;
+ /* Don't consider fractional part. */
+ } else {
+ wakeup.sec += (long)(ms / 1000);
+ wakeup.usec += ((long)(ms % 1000)) * 1000;
+ if (wakeup.usec > 1000000) {
+ wakeup.sec++;
+ wakeup.usec -= 1000000;
+ }
}
afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
AfterProc, afterPtr);
+ afterPtr->prevPtr = NULL;
afterPtr->nextPtr = assocPtr->firstAfterPtr;
+ if (afterPtr->nextPtr != NULL) {
+ afterPtr->nextPtr->prevPtr = afterPtr;
+ }
assocPtr->firstAfterPtr = afterPtr;
Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
return TCL_OK;
}
case AFTER_CANCEL: {
@@ -896,11 +952,11 @@
return TCL_ERROR;
}
if (objc == 3) {
commandPtr = objv[2];
} else {
- commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
+ commandPtr = Tcl_ConcatObj(objc-2, objv+2);
}
command = Tcl_GetStringFromObj(commandPtr, &length);
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
@@ -938,13 +994,20 @@
} else {
afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
}
Tcl_IncrRefCount(afterPtr->commandPtr);
afterPtr->id = tsdPtr->afterId;
+ afterPtr->isAbsolute = 0;
+ afterPtr->absoluteTime.sec = 0;
+ afterPtr->absoluteTime.usec = 0;
tsdPtr->afterId += 1;
afterPtr->token = NULL;
+ afterPtr->prevPtr = NULL;
afterPtr->nextPtr = assocPtr->firstAfterPtr;
+ if (afterPtr->nextPtr != NULL) {
+ afterPtr->nextPtr->prevPtr = afterPtr;
+ }
assocPtr->firstAfterPtr = afterPtr;
Tcl_DoWhenIdle(AfterProc, afterPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
break;
case AFTER_INFO:
@@ -1015,11 +1078,11 @@
Interp *iPtr = (Interp *) interp;
Tcl_Time endTime, now;
Tcl_WideInt diff;
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
endTime = now;
endTime.sec += (long)(ms/1000);
endTime.usec += ((int)(ms%1000))*1000;
if (endTime.usec >= 1000000) {
endTime.sec++;
@@ -1081,11 +1144,11 @@
}
if (Tcl_LimitCheck(interp) != TCL_OK) {
return TCL_ERROR;
}
}
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
} while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
/*
@@ -1160,13 +1223,45 @@
AfterProc(
ClientData clientData) /* Describes command to execute. */
{
AfterInfo *afterPtr = clientData;
AfterAssocData *assocPtr = afterPtr->assocPtr;
- AfterInfo *prevPtr;
int result;
Tcl_Interp *interp;
+
+ /*
+ * For absolute timed events see if the timer needs
+ * to be re-scheduled due to not having reached the
+ * absolute point in wall-time.
+ */
+
+ if (afterPtr->isAbsolute) {
+ Tcl_Time now, wakeup;
+ Tcl_WideInt ms;
+
+ Tcl_GetTime(&now);
+ if (TCL_TIME_BEFORE(now, afterPtr->absoluteTime)) {
+ ms = TCL_TIME_DIFF_MS_CEILING(afterPtr->absoluteTime, now);
+ if (ms > 0) {
+ TclpGetMonotonicTime(&wakeup);
+ if (((wakeup.sec + (long)(ms / 1000)) - (wakeup.sec)) < 0) {
+ wakeup.sec += LONG_MAX - 1;
+ /* Don't consider fractional part. */
+ } else {
+ wakeup.sec += (long)(ms / 1000);
+ wakeup.usec += ((long)(ms % 1000)) * 1000;
+ if (wakeup.usec > 1000000) {
+ wakeup.sec++;
+ wakeup.usec -= 1000000;
+ }
+ }
+ afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
+ AfterProc, afterPtr);
+ return;
+ }
+ }
+ }
/*
* First remove the callback from our list of callbacks; otherwise someone
* could delete the callback while it's being executed, which could cause
* a core dump.
@@ -1173,15 +1268,14 @@
*/
if (assocPtr->firstAfterPtr == afterPtr) {
assocPtr->firstAfterPtr = afterPtr->nextPtr;
} else {
- for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
- prevPtr = prevPtr->nextPtr) {
- /* Empty loop body. */
- }
- prevPtr->nextPtr = afterPtr->nextPtr;
+ afterPtr->prevPtr->nextPtr = afterPtr->nextPtr;
+ }
+ if (afterPtr->nextPtr != NULL) {
+ afterPtr->nextPtr->prevPtr = afterPtr->prevPtr;
}
/*
* Execute the callback.
*/
@@ -1223,21 +1317,19 @@
static void
FreeAfterPtr(
AfterInfo *afterPtr) /* Command to be deleted. */
{
- AfterInfo *prevPtr;
AfterAssocData *assocPtr = afterPtr->assocPtr;
if (assocPtr->firstAfterPtr == afterPtr) {
assocPtr->firstAfterPtr = afterPtr->nextPtr;
} else {
- for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
- prevPtr = prevPtr->nextPtr) {
- /* Empty loop body. */
- }
- prevPtr->nextPtr = afterPtr->nextPtr;
+ afterPtr->prevPtr->nextPtr = afterPtr->nextPtr;
+ }
+ if (afterPtr->nextPtr != NULL) {
+ afterPtr->nextPtr->prevPtr = afterPtr->prevPtr;
}
Tcl_DecrRefCount(afterPtr->commandPtr);
ckfree(afterPtr);
}
@@ -1269,10 +1361,13 @@
AfterInfo *afterPtr;
while (assocPtr->firstAfterPtr != NULL) {
afterPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr->nextPtr;
+ if (afterPtr->nextPtr != NULL) {
+ afterPtr->nextPtr->prevPtr = afterPtr->prevPtr;
+ }
if (afterPtr->token != NULL) {
Tcl_DeleteTimerHandler(afterPtr->token);
} else {
Tcl_CancelIdleCall(AfterProc, afterPtr);
}
Index: macosx/tclMacOSXNotify.c
==================================================================
--- macosx/tclMacOSXNotify.c
+++ macosx/tclMacOSXNotify.c
@@ -1629,11 +1629,11 @@
* If there is a non-zero finite timeout, compute the time when we give
* up.
*/
if (timeout > 0) {
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
abortTime.sec = now.sec + timeout/1000;
abortTime.usec = now.usec + (timeout%1000)*1000;
if (abortTime.usec >= 1000000) {
abortTime.usec -= 1000000;
abortTime.sec += 1;
@@ -1718,11 +1718,11 @@
/*
* The select returned early, so we need to recompute the timeout.
*/
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
if ((abortTime.sec < now.sec)
|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
break;
}
}
Index: tests/timer.test
==================================================================
--- tests/timer.test
+++ tests/timer.test
@@ -187,14 +187,14 @@
test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
after
} -result {wrong # args: should be "after option ?arg ...?"}
test timer-6.2 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
after 2x
-} -result {bad argument "2x": must be cancel, idle, info, or an integer}
+} -result {bad argument "2x": must be cancel, idle, info, an integer, or "-at" integer}
test timer-6.3 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
after gorp
-} -result {bad argument "gorp": must be cancel, idle, info, or an integer}
+} -result {bad argument "gorp": must be cancel, idle, info, an integer, or "-at" integer}
test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
set x before
after 400 {set x after}
after 200
update
@@ -444,10 +444,34 @@
} -cleanup {
foreach i [after info] {
after cancel $i
}
} -result 5
+test timer-6.30 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+ after -at cancel
+} -result {bad argument "-at": must be cancel, idle, info, an integer, or "-at" integer}
+test timer-6.31 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+ after -at
+} -result {wrong # args: should be "after -at time script ..."}
+test timer-6.32 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+ after -at 1000
+} -result {wrong # args: should be "after -at time script ..."}
+test timer-6.33 {Tcl_AfterCmd procedure, -at option} -body {
+ set now [clock seconds]
+ after -at $now {set then $now}
+ after 1000
+ update
+ expr {$then == $now}
+} -result {1}
+test timer-6.34 {Tcl_AfterCmd procedure, -at option} -body {
+ set now [clock seconds]
+ incr now
+ after -at $now {set then [clock seconds]}
+ after 1000
+ update
+ expr {$then >= $now}
+} -result {1}
set event [after idle foo bar]
scan $event after#%d lastId
test timer-7.1 {GetAfterEvent procedure} -returnCodes error -body {
after info xfter#$lastId
Index: unix/configure
==================================================================
--- unix/configure
+++ unix/configure
@@ -4674,11 +4674,12 @@
ac_saved_libs=$LIBS
LIBS="$LIBS $THREADS_LIBS"
-for ac_func in pthread_attr_setstacksize pthread_atfork
+
+for ac_func in pthread_attr_setstacksize pthread_atfork pthread_condattr_setclock
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
@@ -5697,10 +5698,182 @@
LIBS="$LIBS -lnsl"
fi
fi
+
+ echo "$as_me:$LINENO: checking for clock_gettime in -lrt" >&5
+echo $ECHO_N "checking for clock_gettime in -lrt... $ECHO_C" >&6
+if test "${ac_cv_lib_rt_clock_gettime+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lrt $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char clock_gettime ();
+int
+main ()
+{
+clock_gettime ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_rt_clock_gettime=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_rt_clock_gettime=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_rt_clock_gettime" >&5
+echo "${ECHO_T}$ac_cv_lib_rt_clock_gettime" >&6
+if test $ac_cv_lib_rt_clock_gettime = yes; then
+ LIBS="$LIBS -lrt"
+fi
+
+
+
+for ac_func in clock_gettime clock_nanosleep
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"
Index: unix/tcl.m4
==================================================================
--- unix/tcl.m4
+++ unix/tcl.m4
@@ -676,11 +676,11 @@
# Does the pthread-implementation provide
# 'pthread_attr_setstacksize' ?
ac_saved_libs=$LIBS
LIBS="$LIBS $THREADS_LIBS"
- AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
+ AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork pthread_condattr_setclock)
LIBS=$ac_saved_libs
else
TCL_THREADS=0
fi
# Do checking message here to not mess up interleaved configure output
@@ -2512,10 +2512,13 @@
LIBS="$LIBS -lsocket -lnsl"
AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs])
fi
AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname,
[LIBS="$LIBS -lnsl"])])
+
+ AC_CHECK_LIB(rt, clock_gettime, [LIBS="$LIBS -lrt"])
+ AC_CHECK_FUNCS(clock_gettime clock_nanosleep)
])
#--------------------------------------------------------------------
# SC_TCL_EARLY_FLAGS
#
Index: unix/tclConfig.h.in
==================================================================
--- unix/tclConfig.h.in
+++ unix/tclConfig.h.in
@@ -16,10 +16,13 @@
/* Defined when compiler supports casting to union type. */
#undef HAVE_CAST_TO_UNION
/* Define to 1 if you have the `chflags' function. */
#undef HAVE_CHFLAGS
+
+/* Define to 1 if you have the `clock_gettime' function. */
+#undef HAVE_CLOCK_GETTIME
/* Define to 1 if you have the `copyfile' function. */
#undef HAVE_COPYFILE
/* Define to 1 if you have the <copyfile.h> header file. */
@@ -166,10 +169,13 @@
/* Define to 1 if you have the `pthread_atfork' function. */
#undef HAVE_PTHREAD_ATFORK
/* Define to 1 if you have the `pthread_attr_setstacksize' function. */
#undef HAVE_PTHREAD_ATTR_SETSTACKSIZE
+
+/* Define to 1 if you have the `pthread_condattr_setclock' function. */
+#undef HAVE_PTHREAD_CONDATTR_SETCLOCK
/* Does putenv() copy strings or incorporate them by reference? */
#undef HAVE_PUTENV_THAT_COPIES
/* Are characters signed? */
Index: unix/tclUnixChan.c
==================================================================
--- unix/tclUnixChan.c
+++ unix/tclUnixChan.c
@@ -1785,11 +1785,11 @@
* If there is a non-zero finite timeout, compute the time when we give
* up.
*/
if (timeout > 0) {
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
abortTime.sec = now.sec + timeout/1000;
abortTime.usec = now.usec + (timeout%1000)*1000;
if (abortTime.usec >= 1000000) {
abortTime.usec -= 1000000;
abortTime.sec += 1;
@@ -1874,11 +1874,11 @@
/*
* The select returned early, so we need to recompute the timeout.
*/
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
if ((abortTime.sec < now.sec)
|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
break;
}
}
Index: unix/tclUnixEvent.c
==================================================================
--- unix/tclUnixEvent.c
+++ unix/tclUnixEvent.c
@@ -40,11 +40,11 @@
* The only trick here is that select appears to return early under some
* conditions, so we have to check to make sure that the right amount of
* time really has elapsed. If it's too early, go back to sleep again.
*/
- Tcl_GetTime(&before);
+ TclpGetMonotonicTime(&before);
after = before;
after.sec += ms/1000;
after.usec += (ms%1000)*1000;
if (after.usec > 1000000) {
after.usec -= 1000000;
@@ -79,11 +79,11 @@
|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
break;
}
(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
(SELECT_MASK *) 0, &delay);
- Tcl_GetTime(&before);
+ TclpGetMonotonicTime(&before);
}
}
#endif /* HAVE_COREFOUNDATION */
/*
Index: unix/tclUnixNotfy.c
==================================================================
--- unix/tclUnixNotfy.c
+++ unix/tclUnixNotfy.c
@@ -100,10 +100,13 @@
void *hwnd; /* Messaging window. */
#else /* !__CYGWIN__ */
pthread_cond_t waitCV; /* Any other thread alerts a notifier that an
* event is ready to be processed by signaling
* this condition variable. */
+#if defined(HAVE_CLOCK_GETTIME) && defined(HAVE_PTHREAD_CONDATTR_SETCLOCK)
+ int useMonoTime; /* When true use CLOCK_MONOTONIC */
+#endif
#endif /* __CYGWIN__ */
int waitCVinitialized; /* Variable to flag initialization of the structure */
int eventReady; /* True if an event is ready to be processed.
* Used as condition flag together with waitCV
* above. */
@@ -354,12 +357,29 @@
tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
TclWinGetTclInstance(), NULL);
tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
0 /* !signaled */, NULL);
+#else
+#if defined(HAVE_CLOCK_GETTIME) && defined(HAVE_PTHREAD_CONDATTR_SETCLOCK)
+ pthread_condattr_t attr;
+
+ pthread_condattr_init(&attr);
+ tsdPtr->useMonoTime =
+ pthread_condattr_setclock(&attr, CLOCK_MONOTONIC) == 0;
+ if (tsdPtr->useMonoTime) {
+ if (pthread_cond_init(&tsdPtr->waitCV, &attr)) {
+ tsdPtr->useMonoTime = 0;
+ pthread_cond_init(&tsdPtr->waitCV, NULL);
+ }
+ } else {
+ pthread_cond_init(&tsdPtr->waitCV, NULL);
+ }
+ pthread_condattr_destroy(&attr);
#else
pthread_cond_init(&tsdPtr->waitCV, NULL);
+#endif
#endif /* __CYGWIN__ */
tsdPtr->waitCVinitialized = 1;
}
pthread_mutex_lock(¬ifierInitMutex);
@@ -997,20 +1017,33 @@
MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
pthread_mutex_lock(¬ifierMutex);
}
#else
if (timePtr != NULL) {
- Tcl_Time now;
- struct timespec ptime;
+ struct timespec ptime;
- Tcl_GetTime(&now);
- ptime.tv_sec = timePtr->sec + now.sec + (timePtr->usec + now.usec) / 1000000;
- ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
+#if defined(HAVE_CLOCK_GETTIME) && defined(HAVE_PTHREAD_CONDATTR_SETCLOCK)
+ if (tsdPtr->useMonoTime) {
+ clock_gettime(CLOCK_MONOTONIC, &ptime);
+ } else {
+ clock_gettime(CLOCK_REALTIME, &ptime);
+ }
+ ptime.tv_sec += timePtr->sec +
+ (timePtr->usec * 1000 + ptime.tv_nsec) / 1000000000;
+ ptime.tv_nsec = (timePtr->usec * 1000 + ptime.tv_nsec) %
+ 1000000000;
+#else
+ Tcl_Time now;
- pthread_cond_timedwait(&tsdPtr->waitCV, ¬ifierMutex, &ptime);
+ Tcl_GetTime(&now);
+ ptime.tv_sec = timePtr->sec + now.sec +
+ (timePtr->usec + now.usec) / 1000000;
+ ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
+#endif
+ pthread_cond_timedwait(&tsdPtr->waitCV, ¬ifierMutex, &ptime);
} else {
- pthread_cond_wait(&tsdPtr->waitCV, ¬ifierMutex);
+ pthread_cond_wait(&tsdPtr->waitCV, ¬ifierMutex);
}
#endif /* __CYGWIN__ */
}
tsdPtr->eventReady = 0;
Index: unix/tclUnixPort.h
==================================================================
--- unix/tclUnixPort.h
+++ unix/tclUnixPort.h
@@ -635,10 +635,30 @@
(__GNUC__ > 4 || (__GNUC__ == 4 && (__GNUC_MINOR__ > 2 || \
(__GNUC_MINOR__ == 2 && __GNUC_PATCHLEVEL__ > 0))))
# undef USE_VFORK
# endif /* __llvm__ */
#endif /* __APPLE__ */
+
+/*
+ *---------------------------------------------------------------------------
+ * Use clock_gettime() only if _POSIX_MONOTONIC_CLOCK present.
+ *---------------------------------------------------------------------------
+ */
+
+#if defined(HAVE_CLOCK_GETTIME) && !defined(_POSIX_MONOTONIC_CLOCK)
+# undef HAVE_CLOCK_GETTIME
+#endif
+
+#ifdef TCL_THREADS
+# ifndef HAVE_CLOCK_GETTIME
+# undef HAVE_PTHREAD_CONDATTR_SETCLOCK
+# endif
+# ifndef HAVE_PTHREAD_CONDATTR_SETCLOCK
+# undef HAVE_CLOCK_GETTIME
+# endif
+#endif
+
/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
* generic and unix-specific parts of Tcl. Some of the macros may override
Index: unix/tclUnixThrd.c
==================================================================
--- unix/tclUnixThrd.c
+++ unix/tclUnixThrd.c
@@ -525,10 +525,13 @@
const Tcl_Time *timePtr) /* Timeout on waiting period */
{
pthread_cond_t *pcondPtr;
pthread_mutex_t *pmutexPtr;
struct timespec ptime;
+#if defined(HAVE_CLOCK_GETTIME) && defined(HAVE_PTHREAD_CONDATTR_SETCLOCK)
+ int *monoFlagPtr;
+#endif
if (*condPtr == NULL) {
MASTER_LOCK;
/*
@@ -535,12 +538,30 @@
* Double check inside mutex to avoid race, then initialize condition
* variable if necessary.
*/
if (*condPtr == NULL) {
+#if defined(HAVE_CLOCK_GETTIME) && defined(HAVE_PTHREAD_CONDATTR_SETCLOCK)
+ pthread_condattr_t attr;
+
+ pcondPtr = ckalloc(sizeof(pthread_cond_t) + sizeof(int));
+ monoFlagPtr = (int *) (pcondPtr + 1);
+ pthread_condattr_init(&attr);
+ *monoFlagPtr = (pthread_condattr_setclock(&attr, CLOCK_MONOTONIC) == 0);
+ if (*monoFlagPtr) {
+ if (pthread_cond_init(pcondPtr, &attr)) {
+ *monoFlagPtr = 0;
+ pthread_cond_init(pcondPtr, NULL);
+ }
+ } else {
+ pthread_cond_init(pcondPtr, NULL);
+ }
+ pthread_condattr_destroy(&attr);
+#else
pcondPtr = ckalloc(sizeof(pthread_cond_t));
pthread_cond_init(pcondPtr, NULL);
+#endif
*condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
}
MASTER_UNLOCK;
}
@@ -547,10 +568,17 @@
pmutexPtr = *((pthread_mutex_t **)mutexPtr);
pcondPtr = *((pthread_cond_t **)condPtr);
if (timePtr == NULL) {
pthread_cond_wait(pcondPtr, pmutexPtr);
} else {
+#if defined(HAVE_CLOCK_GETTIME) && defined(HAVE_PTHREAD_CONDATTR_SETCLOCK)
+ monoFlagPtr = (int *) (pcondPtr + 1);
+ clock_gettime(*monoFlagPtr ? CLOCK_MONOTONIC : CLOCK_REALTIME, &ptime);
+ ptime.tv_sec += timePtr->sec +
+ (timePtr->usec * 1000 + ptime.tv_nsec) / 1000000000;
+ ptime.tv_nsec = (timePtr->usec * 1000 + ptime.tv_nsec) % 1000000000;
+#else
Tcl_Time now;
/*
* Make sure to take into account the microsecond component of the
* current time, including possible overflow situations. [Bug #411603]
@@ -558,10 +586,11 @@
Tcl_GetTime(&now);
ptime.tv_sec = timePtr->sec + now.sec +
(timePtr->usec + now.usec) / 1000000;
ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
+#endif
pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
}
}
/*
Index: unix/tclUnixTime.c
==================================================================
--- unix/tclUnixTime.c
+++ unix/tclUnixTime.c
@@ -103,10 +103,16 @@
unsigned long
TclpGetClicks(void)
{
unsigned long now;
+#ifdef HAVE_CLOCK_GETTIME
+ Tcl_Time time;
+
+ TclpGetMonotonicTime(&time);
+ now = time.sec*1000000 + time.usec;
+#else
#ifdef NO_GETTOD
if (tclGetTimeProcPtr != NativeGetTime) {
Tcl_Time time;
tclGetTimeProcPtr(&time, tclTimeClientData);
@@ -122,10 +128,11 @@
#else
Tcl_Time time;
tclGetTimeProcPtr(&time, tclTimeClientData);
now = time.sec*1000000 + time.usec;
+#endif
#endif
return now;
}
#ifdef TCL_WIDE_CLICKS
@@ -374,13 +381,15 @@
Tcl_SetTimeProc(
Tcl_GetTimeProc *getProc,
Tcl_ScaleTimeProc *scaleProc,
ClientData clientData)
{
+#ifndef HAVE_CLOCK_GETTIME
tclGetTimeProcPtr = getProc;
tclScaleTimeProcPtr = scaleProc;
tclTimeClientData = clientData;
+#endif
}
/*
*----------------------------------------------------------------------
*
@@ -465,10 +474,63 @@
(void) gettimeofday(&tv, NULL);
timePtr->sec = tv.tv_sec;
timePtr->usec = tv.tv_usec;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetMononoticTime --
+ *
+ * Like Tcl_GetTime() but return a monotonic clock source,
+ * if possible. Otherwise fall back to real (wall clock) time.
+ *
+ * Results:
+ * 1 if monotonic, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetMonotonicTime(Tcl_Time *timePtr)
+{
+#ifdef HAVE_CLOCK_GETTIME
+ int ret;
+ struct timespec ts;
+ static int useMonoClock = -1;
+
+ if (useMonoClock) {
+ ret = (clock_gettime(CLOCK_MONOTONIC, &ts) == 0);
+ if (useMonoClock < 0) {
+ useMonoClock = ret;
+ if (!ret) {
+ (void) clock_gettime(CLOCK_REALTIME, &ts);
+ }
+ } else if (!ret) {
+ Tcl_Panic("clock_gettime(CLOCK_MONOTONIC) failed");
+ }
+ } else {
+ (void) clock_gettime(CLOCK_REALTIME, &ts);
+ ret = 0;
+ }
+ timePtr->sec = ts.tv_sec;
+ timePtr->usec = ts.tv_nsec / 1000;
+ return ret;
+#else
+ struct timeval tv;
+
+ (void) gettimeofday(&tv, NULL);
+ timePtr->sec = tv.tv_sec;
+ timePtr->usec = tv.tv_usec;
+ return 0;
+#endif
+}
+
/*
*----------------------------------------------------------------------
*
* SetTZIfNecessary --
*
Index: win/configure
==================================================================
--- win/configure
+++ win/configure
@@ -851,10 +851,11 @@
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-encoding encoding for configuration values
--with-celib=DIR use Windows/CE support library from DIR
+ --with-tickcount use GetTickCount for timers, turns off TIP #233
Some influential environment variables:
CC C compiler command
CFLAGS C compiler flags
LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
@@ -4406,10 +4407,28 @@
cat >>confdefs.h <<\_ACEOF
#define HAVE_ZLIB 1
_ACEOF
+
+# Check whether --with-tickcount or --without-tickcount was given.
+if test "${with_tickcount+set}" = set; then
+ withval="$with_tickcount"
+ tcl_ok=$withval
+else
+ tcl_ok=no
+fi;
+echo "$as_me:$LINENO: result: $tcl_ok" >&5
+echo "${ECHO_T}$tcl_ok" >&6
+if test $tcl_ok = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define WIN32_USE_TICKCOUNT 1
+_ACEOF
+
+fi
+
echo "$as_me:$LINENO: checking for intptr_t" >&5
echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
if test "${ac_cv_type_intptr_t+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
Index: win/configure.in
==================================================================
--- win/configure.in
+++ win/configure.in
@@ -139,10 +139,19 @@
])
], [
AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
])
AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])
+
+AC_ARG_WITH(tickcount,
+ AC_HELP_STRING([--with-tickcount],
+ [use GetTickCount for timers, turns off TIP #233]),
+ [tcl_ok=$withval], [tcl_ok=no])
+AC_MSG_RESULT([$tcl_ok])
+if test $tcl_ok = yes; then
+ AC_DEFINE(WIN32_USE_TICKCOUNT, 1, [Use GetTickCount for timers?])
+fi
AC_CHECK_TYPE([intptr_t], [
AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
for tcl_cv_intptr_t in "int" "long" "long long" none; do
Index: win/tclWinInit.c
==================================================================
--- win/tclWinInit.c
+++ win/tclWinInit.c
@@ -111,10 +111,19 @@
static ProcessGlobalValue sourceLibraryDir =
{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
static int ToUtf(const WCHAR *wSrc, char *dst);
+
+#ifdef WIN32_USE_TICKCOUNT
+typedef ULONGLONG WINAPI (GetTickCount64Proc)(void);
+static GetTickCount64Proc *GetTickCount64ProcPtr = NULL;
+static CRITICAL_SECTION TickMutex;
+static DWORD TickOffset, LastTick;
+static ULONGLONG TickUpper;
+#endif
+
/*
*---------------------------------------------------------------------------
*
* TclpInitPlatform --
@@ -145,10 +154,33 @@
/*
* Initialize the winsock library. On Windows XP and higher this
* can never fail.
*/
WSAStartup(wVersionRequested, &wsaData);
+
+#ifdef WIN32_USE_TICKCOUNT
+ /*
+ * Check for availability of the GetTickCount64() API.
+ */
+
+ handle = GetModuleHandle(TEXT("KERNEL32"));
+ if (handle != NULL) {
+ GetTickCount64ProcPtr = (GetTickCount64Proc *)
+ GetProcAddress(handle, "GetTickCount64");
+ }
+
+ InitializeCriticalSection(&TickMutex);
+
+ /*
+ * Force a wrap around within the first few seconds when
+ * we need to fall back to GetTickCount(), e.g. on XP.
+ */
+
+ TickOffset = 0xffffe000 - GetTickCount();
+ LastTick = TickOffset;
+ TickUpper = 0;
+#endif
#ifdef STATIC_BUILD
/*
* If we are in a statically linked executable, then we need to explicitly
* initialize the Windows function tables here since DllMain() will not be
@@ -721,13 +753,62 @@
done:
Tcl_DStringFree(&envString);
ckfree(nameUpper);
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetMononoticTime --
+ *
+ * Like Tcl_GetTime() but return a monotonic clock source,
+ * if possible. Otherwise fall back to real (wall clock) time.
+ *
+ * Results:
+ * 1 if monotonic, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetMonotonicTime(Tcl_Time *timePtr)
+{
+#ifdef WIN32_USE_TICKCOUNT
+ ULONGLONG ms;
+ DWORD tick;
+
+ if (GetTickCount64ProcPtr != NULL) {
+ ms = GetTickCount64ProcPtr();
+ } else {
+ /*
+ * Emulate 64 bit wide tick counter, e.g. on XP.
+ */
+
+ EnterCriticalSection(&TickMutex);
+ tick = GetTickCount() + TickOffset;
+ if ((LastTick & 0x80000000) && !(tick & 0x80000000)) {
+ TickUpper += 0x100000000ULL;
+ }
+ LastTick = tick;
+ ms = TickUpper | LastTick;
+ LeaveCriticalSection(&TickMutex);
+ }
+ timePtr->sec = (long)(ms/1000);
+ timePtr->usec = ((long)(ms%1000))*1000;
+ return 1;
+#else
+ Tcl_GetTime(timePtr);
+ return 0;
+#endif
+}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
Index: win/tclWinNotify.c
==================================================================
--- win/tclWinNotify.c
+++ win/tclWinNotify.c
@@ -458,10 +458,13 @@
if (myTime.sec != 0 || myTime.usec != 0) {
tclScaleTimeProcPtr(&myTime, tclTimeClientData);
}
timeout = myTime.sec * 1000 + myTime.usec / 1000;
+ if (timeout == INFINITE) {
+ timeout--;
+ }
} else {
timeout = INFINITE;
}
/*
@@ -565,11 +568,11 @@
DWORD sleepTime; /* Time to sleep, real-time */
vdelay.sec = ms / 1000;
vdelay.usec = (ms % 1000) * 1000;
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
desired.sec = now.sec + vdelay.sec;
desired.usec = now.usec + vdelay.usec;
if (desired.usec > 1000000) {
++desired.sec;
desired.usec -= 1000000;
@@ -579,14 +582,17 @@
* TIP #233: Scale delay from virtual to real-time.
*/
tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
+ if (sleepTime == INFINITE) {
+ --sleepTime;
+ }
for (;;) {
SleepEx(sleepTime, TRUE);
- Tcl_GetTime(&now);
+ TclpGetMonotonicTime(&now);
if (now.sec > desired.sec) {
break;
} else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
break;
}
@@ -594,10 +600,13 @@
vdelay.sec = desired.sec - now.sec;
vdelay.usec = desired.usec - now.usec;
tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
+ if (sleepTime == INFINITE) {
+ --sleepTime;
+ }
}
}
/*
* Local Variables:
Index: win/tclWinSerial.c
==================================================================
--- win/tclWinSerial.c
+++ win/tclWinSerial.c
@@ -367,11 +367,11 @@
static unsigned int
SerialGetMilliseconds(void)
{
Tcl_Time time;
- Tcl_GetTime(&time);
+ TclpGetMonotonicTime(&time);
return (time.sec * 1000 + time.usec / 1000);
}
/*
@@ -1429,11 +1429,11 @@
infoPtr->channel = (Tcl_Channel) NULL;
infoPtr->readable = 0;
infoPtr->writable = 1;
infoPtr->toWrite = infoPtr->writeQueue = 0;
infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
- infoPtr->lastEventTime = 0;
+ infoPtr->lastEventTime = SerialGetMilliseconds();
infoPtr->lastError = infoPtr->error = 0;
infoPtr->threadId = Tcl_GetCurrentThread();
infoPtr->sysBufRead = 4096;
infoPtr->sysBufWrite = 4096;
Index: win/tclWinTime.c
==================================================================
--- win/tclWinTime.c
+++ win/tclWinTime.c
@@ -1134,13 +1134,15 @@
Tcl_SetTimeProc(
Tcl_GetTimeProc *getProc,
Tcl_ScaleTimeProc *scaleProc,
ClientData clientData)
{
+#ifndef WIN32_USE_TICKCOUNT
tclGetTimeProcPtr = getProc;
tclScaleTimeProcPtr = scaleProc;
tclTimeClientData = clientData;
+#endif
}
/*
*----------------------------------------------------------------------
*
