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).

3 files changed, 64 insertions, 16 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;
 }