summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorferrieux <ferrieux@users.sourceforge.net>2010-10-29 16:42:00 (GMT)
committerferrieux <ferrieux@users.sourceforge.net>2010-10-29 16:42:00 (GMT)
commit94714600d2d55439aa4e666dcd99085e6f3d5e67 (patch)
treebb78b28bd4acce1248673ffc9ee16fcc7b902962
parent61a419537bc1d91d73aab42340f3924a84811a36 (diff)
downloadtcl-94714600d2d55439aa4e666dcd99085e6f3d5e67.zip
tcl-94714600d2d55439aa4e666dcd99085e6f3d5e67.tar.gz
tcl-94714600d2d55439aa4e666dcd99085e6f3d5e67.tar.bz2
Stop small [afters] from wasting CPU [Bug 2905784] while keeping accuracy.
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclTimer.c26
2 files changed, 26 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index 4b2c0e1..f64347d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2010-10-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclTimer.c: Stop small [afters] from wasting CPU [Bug
+ 2905784] while keeping accuracy.
+
2010-10-28 Don Porter <dgp@users.sourceforge.net>
* tests/http.test: Make http-4.15 pass in isolation [Bug 3097490]
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index aaa3493..c5974da 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTimer.c,v 1.42 2010/02/24 10:32:17 dkf Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.43 2010/10/29 16:42:01 ferrieux Exp $
*/
#include "tclInt.h"
@@ -129,6 +129,17 @@ static Tcl_ThreadDataKey dataKey;
(1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
((long)(t1).usec - (long)(t2).usec)/1000)
+#define TCL_TIME_DIFF_MS_CEILING(t1, t2) \
+ (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
+ ((long)(t1).usec - (long)(t2).usec + 999)/1000)
+
+/*
+ * Sleeps under that number of milliseconds don't get double-checked
+ * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s.
+ */
+
+#define SLEEP_OFFLOAD_GETTIMEOFDAY 20
+
/*
* The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay.
* This is used to limit the maximum lag between interp limit and script
@@ -1002,7 +1013,8 @@ AfterDelay(
Tcl_Time endTime, now;
Tcl_WideInt diff;
- Tcl_GetTime(&endTime);
+ Tcl_GetTime(&now);
+ endTime = now;
endTime.sec += (long)(ms/1000);
endTime.usec += ((int)(ms%1000))*1000;
if (endTime.usec >= 1000000) {
@@ -1011,7 +1023,6 @@ AfterDelay(
}
do {
- Tcl_GetTime(&now);
if (Tcl_AsyncReady()) {
if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
return TCL_ERROR;
@@ -1029,7 +1040,7 @@ AfterDelay(
}
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
- diff = TCL_TIME_DIFF_MS(endTime, now);
+ diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
#ifndef TCL_WIDE_INT_IS_LONG
if (diff > LONG_MAX) {
diff = LONG_MAX;
@@ -1038,9 +1049,11 @@ AfterDelay(
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
+ if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1;
if (diff > 0) {
Tcl_Sleep((long) diff);
- }
+ if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break;
+ } else break;
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
@@ -1066,6 +1079,7 @@ AfterDelay(
return TCL_ERROR;
}
}
+ Tcl_GetTime(&now);
} while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
@@ -1269,5 +1283,7 @@ AfterCleanupProc(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/