code review + better usage of the waiting tolerance (fewer CPU-greedy now, avoid busy-wait if the rest of wait-time too small and can be neglected);

TMR_RES_TOLERANCE can be defined to use wait-tolerance on *nix platforms (currently windows only as relation resp. deviation between default timer resolution 15.600 in exact milliseconds, means 15600/15000 + small overhead);
Decreasing of TMR_RES_TOLERANCE (up to 0) makes tcl more "RTS" resp. NRT-capable (very precise wait-intervals, but more CPU-hungry).

4 files changed, 95 insertions, 34 deletions

diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 299f1f8..1a5b9d5 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1380,13 +1380,13 @@ Tcl_VwaitObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    int done = 0, foundEvent = 1, limit = 0;
+    int done = 0, foundEvent = 1, limit = 0, checktime = 0;
     int flags = TCL_ALL_EVENTS; /* default flags */
     char *nameString;
-    int opti = 1,	 /* start option index (and index of varname later) */
-    	optc = objc - 2; /* options count without cmd and varname */
+    int optc = objc - 2; /* options count without cmd and varname */
     double ms = -1;
     Tcl_Time wakeup;
+    long tolerance = 0;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?options? ?timeout? name");
@@ -1418,6 +1418,10 @@ Tcl_VwaitObjCmd(
 	if (ms > 0) {
 	    Tcl_GetTime(&wakeup);
 	    TclTimeAddMilliseconds(&wakeup, ms);
+	#ifdef TMR_RES_TOLERANCE
+	    tolerance = (ms < 1000 ? ms : 1000) *
+				(1000 * TMR_RES_TOLERANCE / 100);
+	#endif
 	} else if (ms == 0) {
 	    flags |= TCL_DONT_WAIT;
 	}
@@ -1441,16 +1445,20 @@ Tcl_VwaitObjCmd(
 		blockTime.sec--;
 		blockTime.usec += 1000000;
 	    }
-	    if (  blockTime.sec < 0 
-	      || (blockTime.sec == 0 && blockTime.usec <= 0)
-	    ) {
-		/* timeout occurs */
-		done = -1;
-		break;
+	    /* be sure process at least one event */
+	    if (checktime) {
+		if (  blockTime.sec < 0 
+		  || (blockTime.sec == 0 && blockTime.usec <= tolerance)
+		) {
+		    /* timeout occurs */
+		    done = -1;
+		    break;
+		}
 	    }
+	    checktime = 1;
 	    Tcl_SetMaxBlockTime(&blockTime);
 	}
-	if ((foundEvent = Tcl_DoOneEvent(flags)) == 0) {
+	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;
@@ -1459,12 +1467,14 @@ Tcl_VwaitObjCmd(
 	    if (flags & TCL_DONT_WAIT) {
 		foundEvent = 1;
 		done = -2;
-	    }
-	    if (ms > 0) {
+	    } else if (ms > 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)) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 991ffc3..f13af82 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2876,6 +2876,12 @@ 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);
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index f1235be..c135ffb 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -588,6 +588,7 @@ TimerSetupProc(
 {
     Tcl_Time blockTime, *firstTime;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
+    long tolerance = 0;
 
     if (tsdPtr == NULL) { tsdPtr = InitTimer(); };
 
@@ -619,10 +620,15 @@ TimerSetupProc(
 	    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 == 0) {
+	if (!tsdPtr->timerPending && blockTime.sec == 0 && blockTime.usec <= tolerance) {
 	    TclSetTimerEventMarker(0);
 	    tsdPtr->timerPending = 1;
 	}
@@ -717,7 +723,7 @@ int
 TclServiceTimerEvents(void)
 {
     TimerEntry *entryPtr, *nextPtr;
-    Tcl_Time time;
+    Tcl_Time time, entrytm;
     size_t currentGeneration, currentEpoch;
     int prevTmrPending;
     ThreadSpecificData *tsdPtr = InitTimer();
@@ -791,7 +797,16 @@ TclServiceTimerEvents(void)
     ) {
     	nextPtr = entryPtr->nextPtr;
 
-	if (TCL_TIME_BEFORE(time, TimerEntry2TimerHandler(entryPtr)->time)) {
+	entrytm = TimerEntry2TimerHandler(entryPtr)->time;
+    #ifdef TMR_RES_TOLERANCE
+	entrytm.usec -= ((entrytm.sec <= 0) ? entrytm.usec : 1000000) *
+				(TMR_RES_TOLERANCE / 100);
+	if (entrytm.usec < 0) {
+	    entrytm.usec += 1000000;
+	    entrytm.sec--;
+	}
+    #endif
+	if (TCL_TIME_BEFORE(time, entrytm)) {
 	    break;
 	}
 
@@ -1369,6 +1384,9 @@ AfterDelay(
 
     Tcl_Time endTime, now;
     Tcl_WideInt diff;
+#ifdef TMR_RES_TOLERANCE
+    long tolerance;
+#endif
 
     if (ms <= 0) {
 	/* to cause a context switch only */
@@ -1376,6 +1394,10 @@ AfterDelay(
 	return TCL_OK;
     }
 
+    /* calculate possible maximal tolerance (in usec) of original wait-time */
+#ifdef TMR_RES_TOLERANCE
+    tolerance = ((ms < 1000) ? ms : 1000) * (1000 * TMR_RES_TOLERANCE / 100);
+#endif
 
     Tcl_GetTime(&endTime);
     TclTimeAddMilliseconds(&endTime, ms);
@@ -1399,6 +1421,7 @@ AfterDelay(
 #endif
 	    if (diff > 0) {
 		Tcl_Sleep((long)diff);
+		Tcl_GetTime(&now);
 	    }
 	} else {
 	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
@@ -1409,11 +1432,20 @@ AfterDelay(
 #endif
 	    if (diff > 0) {
 		Tcl_Sleep((long)diff);
+		Tcl_GetTime(&now);
 	    }
 	    if (Tcl_LimitCheck(interp) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	}
+	/* consider timer resolution tolerance (avoid busy wait) */
+    #ifdef TMR_RES_TOLERANCE
+	now.usec += tolerance;
+	if (now.usec > 1000000) {
+	    now.usec -= 1000000;
+	    now.sec++;
+	}
+    #endif
     } while (TCL_TIME_BEFORE(now, endTime));
     return TCL_OK;
 }
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 9c13ff2..f92fe2f 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -22,7 +22,6 @@
 #define WM_WAKEUP	WM_USER	/* Message that is send by
 				 * Tcl_AlertNotifier. */
 
-//#define WIN_TIMER_PRECISION	15000	/* Handle of interval timer. */
 /*
  * The following static structure contains the state information for the
  * Windows implementation of the Tcl notifier. One of these structures is
@@ -408,9 +407,6 @@ static LPFN_NtQueryTimerResolution NtQueryTimerResolution = NULL;
 static LPFN_NtSetTimerResolution NtSetTimerResolution = NULL;
 
 #define TMR_RES_MICROSEC (1000 / 100)
-#define TMR_RES_TOLERANCE 2.5	/* Tolerance (in percent), prevents entering
-				 * busy wait, but has fewer accuracy because
-				 * can wait a bit longer as wanted */
 
 static struct {
     int   available;		/* Availability of timer resolution functions */
@@ -636,6 +632,7 @@ Tcl_WaitForEvent(
     int status = 0;
     Tcl_Time waitTime = {0, 0};
     Tcl_Time endTime;
+    long tolerance = 0;
     unsigned long actualResolution = 0;
 
     /*
@@ -657,11 +654,17 @@ Tcl_WaitForEvent(
 	waitTime.usec = timePtr->usec;
 
 	/* if no wait */
-	if (waitTime.sec == 0 && waitTime.usec == 0) {
+	if (waitTime.sec <= 0 && waitTime.usec <= 0) {
 	    result = 0;
 	    goto peek;
 	}
 
+    #ifdef TMR_RES_TOLERANCE
+	/* calculate possible maximal tolerance (in usec) of original wait-time */
+	tolerance = ((waitTime.sec <= 0) ? waitTime.usec : 1000000) *
+			(TMR_RES_TOLERANCE / 100);
+    #endif
+
 	/* calculate end of wait */
 	Tcl_GetTime(&endTime);
 	endTime.sec += waitTime.sec;
@@ -682,8 +685,6 @@ Tcl_WaitForEvent(
 	*/
 	(*tclScaleTimeProcPtr) (&waitTime, tclTimeClientData);
 
-	/* add possible tolerance in percent, so "round" to full ms (-overhead) */
-	waitTime.usec += waitTime.usec * (TMR_RES_TOLERANCE / 100);
 	/* No wait if timeout too small (because windows may wait too long) */
 	if (!waitTime.sec && waitTime.usec < (long)timerResolution.minDelay) {
 	    /* prevent busy wait */
@@ -695,14 +696,18 @@ Tcl_WaitForEvent(
 	}
 	
 	if (timerResolution.available) {
-	    if (waitTime.sec || waitTime.usec > timerResolution.maxDelay) {
-	    	long usec;
-	    	timeout = waitTime.sec * 1000;
-		usec = ((timeout * 1000) + waitTime.usec) % 1000000;
+	    if (waitTime.sec || waitTime.usec + tolerance > timerResolution.maxDelay) {
+		long usec;
+		timeout = waitTime.sec * 1000;
+		usec = (timeout * 1000) + waitTime.usec + tolerance;
+		if (usec > 1000000) {
+		    usec -= 1000000;
+		    timeout += 1000;
+		}
 		timeout += (usec - (usec % timerResolution.maxDelay)) / 1000;
 	    } else {
-	    	/* calculate resolution up to 1000 microseconds
-	    	 * (don't use highest, because of too large CPU load) */
+		/* calculate resolution up to 1000 microseconds
+		 * (don't use highest, because of too large CPU load) */
 		ULONG res;
 		if (waitTime.usec >= 10000) {
 		    res = 10000 * TMR_RES_MICROSEC;
@@ -794,7 +799,7 @@ Tcl_WaitForEvent(
 	    waitTime.usec += 1000000;
 	    waitTime.sec--;
 	}
-	if (waitTime.sec < 0 || !waitTime.sec && waitTime.usec <= 0) {
+	if (waitTime.sec < 0 || !waitTime.sec && waitTime.usec <= tolerance) {
 	    goto end;
 	}
 	/* Repeat wait with more precise timer resolution (or using sleep) */
@@ -845,7 +850,6 @@ Tcl_Sleep(
     Tcl_Time vdelay;		/* Time to sleep, for scaling virtual ->
 				 * real. */
     DWORD sleepTime;		/* Time to sleep, real-time */
-
     unsigned long actualResolution = 0;
 
     if (ms <= 0) {
@@ -865,9 +869,20 @@ Tcl_Sleep(
     desired.sec  = now.sec  + vdelay.sec;
     desired.usec = now.usec + vdelay.usec;
     if (desired.usec > 1000000) {
-	++desired.sec;
 	desired.usec -= 1000000;
+	desired.sec++;
+    }
+
+#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
 
     /*
      * TIP #233: Scale delay from virtual to real-time.
@@ -877,8 +892,6 @@ Tcl_Sleep(
 	
 	(*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
 
-	/* add possible tolerance in percent, so "round" to full ms (-overhead) */
-	vdelay.usec += vdelay.usec * (TMR_RES_TOLERANCE / 100);
 	/* No wait if sleep time too small (because windows may wait too long) */
 	if (!vdelay.sec && vdelay.usec < (long)timerResolution.minDelay) {
 	    sleepTime = 0;