dynamic increase of timer resolution corresponding wait-time;

non-blocking wait for event - if block-time set outside an event source traversal, use it as timeout, so can return with result 0 (no events);

6 files changed, 386 insertions, 74 deletions

diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 84e4637..299f1f8 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1330,8 +1330,7 @@ GetEventFlagsFromOpts(
 	{0, TCL_WINDOW_EVENTS},	{TCL_WINDOW_EVENTS, 0},	/* -window, -nowindow */
 	{0, TCL_ASYNC_EVENTS},	{TCL_ASYNC_EVENTS, 0},	/* -async, -noasync */
 	{0, TCL_DONT_WAIT},	{TCL_DONT_WAIT, 0},	/* -nowait, -wait */
-	{TCL_ALL_EVENTS, 
-	    TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS}, /* idletasks */
+	{TCL_ALL_EVENTS, TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS}, /* idletasks */
 	{0, 0} /* dummy / place holder */
     };
 
@@ -1381,12 +1380,12 @@ Tcl_VwaitObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    int done = 0, foundEvent = 1;
+    int done = 0, foundEvent = 1, limit = 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 */
-    Tcl_WideInt ms = -1;
+    double ms = -1;
     Tcl_Time wakeup;
 
     if (objc < 2) {
@@ -1400,7 +1399,7 @@ Tcl_VwaitObjCmd(
 	 * we assume that option is not an integer, try to get numeric timeout
 	 */
 	if (!TclObjIsIndexOfTable(objv[optc], updateEventOptions)
-	  && Tcl_GetWideIntFromObj(NULL, objv[optc], &ms) == TCL_OK) {
+	  && Tcl_GetDoubleFromObj(NULL, objv[optc], &ms) == TCL_OK) {
 	    optc--;
 	}
 
@@ -1418,12 +1417,7 @@ Tcl_VwaitObjCmd(
     if (ms != -1) {
 	if (ms > 0) {
 	    Tcl_GetTime(&wakeup);
-	    wakeup.sec += (long)(ms / 1000);
-	    wakeup.usec += ((long)(ms % 1000)) * 1000;
-	    if (wakeup.usec > 1000000) {
-		wakeup.sec++;
-		wakeup.usec -= 1000000;
-	    }
+	    TclTimeAddMilliseconds(&wakeup, ms);
 	} else if (ms == 0) {
 	    flags |= TCL_DONT_WAIT;
 	}
@@ -1444,7 +1438,7 @@ Tcl_VwaitObjCmd(
 	    blockTime.sec = wakeup.sec - blockTime.sec;
 	    blockTime.usec = wakeup.usec - blockTime.usec;
 	    if (blockTime.usec < 0) {
-		blockTime.sec -= 1;
+		blockTime.sec--;
 		blockTime.usec += 1000000;
 	    }
 	    if (  blockTime.sec < 0 
@@ -1459,7 +1453,7 @@ Tcl_VwaitObjCmd(
 	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
+	     * option -nowait for vwait means - we don't wait for events;
 	     * if no timeout (0) - just stop waiting (no more events)
 	     */
 	    if (flags & TCL_DONT_WAIT) {
@@ -1468,14 +1462,14 @@ Tcl_VwaitObjCmd(
 	    }
 	    if (ms > 0) {
 		foundEvent = 1;
-		goto checkWait; /* continue waiting */
 	    }
-	    break;
+	    /* don't stop wait - no event expected here 
+	     * (stop only on error case foundEvent < 0). */
 	}
-      checkWait:
 	/* check interpreter limit exceeded */
 	if (Tcl_LimitExceeded(interp)) {
-	    foundEvent = -1;
+	    limit = 1;
+	    foundEvent = 0;
 	    break;
 	}
     } while (!done);
@@ -1500,13 +1494,13 @@ Tcl_VwaitObjCmd(
      */
 
     Tcl_ResetResult(interp);
-    if (!foundEvent) {
-	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
-		"\": would wait forever", NULL);
+    if (limit) {
+	Tcl_AppendResult(interp, "limit exceeded", NULL);
 	return TCL_ERROR;
     }
-    if (foundEvent == -1) {
-	Tcl_AppendResult(interp, "limit exceeded", NULL);
+    if (foundEvent <= 0) {
+	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
+		"\": would wait forever", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 42223e4..e7fbb01 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2870,6 +2870,19 @@ MODULE_SCOPE double	TclpWideClickInMicrosec(void);
 #endif
 MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
 
+static inline void
+TclTimeAddMilliseconds(
+    register Tcl_Time *timePtr,
+    register double ms
+) {
+    timePtr->sec += (long)(ms / 1000);
+    timePtr->usec += (((long)ms) % 1000) * 1000 + (((long)(ms*1000)) % 1000);
+    if (timePtr->usec > 1000000) {
+	timePtr->sec++;
+	timePtr->usec -= 1000000;
+    }
+}
+
 MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
 MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);
 
@@ -2926,7 +2939,7 @@ MODULE_SCOPE int	Tcl_ConcatObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_ContinueObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE void	TclSetTimerEventMarker(void);
+MODULE_SCOPE void	TclSetTimerEventMarker(int head);
 MODULE_SCOPE int	TclServiceTimerEvents(void);
 MODULE_SCOPE int	TclServiceIdleEx(int flags, int count);
 MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index fb251b7..3c4e4de 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -770,7 +770,7 @@ timer:
 	tsdPtr->timerMarkerPtr = NULL;
 
 	result = TclServiceTimerEvents();
-	if (result <= 0) {
+	if (result < 0) {
 	    /* events processed, but marker to process still pending timers */
 	    tsdPtr->timerMarkerPtr = INT2PTR(-1);
 	    result = 1;
@@ -865,13 +865,14 @@ TclPeekEventQueued(
  */
 
 void
-TclSetTimerEventMarker(void)
+TclSetTimerEventMarker(
+    int head)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (tsdPtr->timerMarkerPtr == NULL) {
 	/* marker to last event in the queue */
-	if (!(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) {
+	if (head || !(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) {
 	    /* marker as "now" - queue is empty, so timers events are first */
 	    tsdPtr->timerMarkerPtr = INT2PTR(-1);
 	};
@@ -1017,7 +1018,7 @@ Tcl_DoOneEvent(
     EventSource *sourcePtr;
     Tcl_Time *timePtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    int stopWait;
+    int blockTimeWasSet;
 
     /*
      * No event flags is equivalent to TCL_ALL_EVENTS.
@@ -1027,9 +1028,9 @@ Tcl_DoOneEvent(
 	flags |= TCL_ALL_EVENTS;
     }
 
-    /* Block time was set outside an event source traversal or no wait */
-    stopWait = tsdPtr->blockTimeSet || (flags & TCL_DONT_WAIT);
-
+    /* Block time was set outside an event source traversal, caller has specified a waittime */
+    blockTimeWasSet = tsdPtr->blockTimeSet;
+    
     /*
      * Asynchronous event handlers are considered to be the highest priority
      * events, and so must be invoked before we process events on the event
@@ -1059,7 +1060,7 @@ Tcl_DoOneEvent(
 
     /*
      * Main loop until servicing exact one event or block time resp. 
-     * TCL_DONT_WAIT specified (infinite loop if stopWait = 0).
+     * TCL_DONT_WAIT specified (infinite loop otherwise).
      */
     do {
 	/*
@@ -1133,7 +1134,9 @@ Tcl_DoOneEvent(
     wait:
 	result = Tcl_WaitForEvent(timePtr);
 	if (result < 0) {
-	    result = 0;
+	    if (blockTimeWasSet) {
+		result = 0;
+	    }
 	    break;
 	}
 
@@ -1179,13 +1182,20 @@ Tcl_DoOneEvent(
 	 * had the side effect of changing the variable (so the vwait can
 	 * return and unwind properly).
 	 *
-	 * We can stop also if block time was set outside an event source,
-	 * that means timeout was set (so exit loop also without event/result).
+	 * We can stop also if works in block to event mode (e. g. block time was
+	 * set outside an event source, that means timeout was set so exit loop
+	 * also without event/result).
 	 */
 
-    } while (!stopWait);
-
+	result = 0;
+	if (blockTimeWasSet) {
+	    break;
+	}
+    } while ( !(flags & TCL_DONT_WAIT) );
+    
+    /* Reset block time earliest at the end of event cycle */
     tsdPtr->blockTimeSet = 0;
+
     tsdPtr->serviceMode = oldMode;
     return result;
 }
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 63346a1..aa78b22 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -115,7 +115,7 @@ static Tcl_ThreadDataKey dataKey;
 
 static void		AfterCleanupProc(ClientData clientData,
 			    Tcl_Interp *interp);
-static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
+static int		AfterDelay(Tcl_Interp *interp, double ms);
 static void		AfterProc(ClientData clientData);
 static void		FreeAfterPtr(ClientData clientData);
 static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *objPtr);
@@ -623,7 +623,7 @@ TimerSetupProc(
 	* If the first timer has expired, stick an event on the queue right now.
 	*/
 	if (!tsdPtr->timerPending && blockTime.sec == 0 && blockTime.usec == 0) {
-	    TclSetTimerEventMarker();
+	    TclSetTimerEventMarker(0);
 	    tsdPtr->timerPending = 1;
 	}
     
@@ -690,7 +690,7 @@ TimerCheckProc(
     * If the first timer has expired, stick an event on the queue.
     */
     if (blockTime.sec == 0 && blockTime.usec == 0) {
-	TclSetTimerEventMarker();
+	TclSetTimerEventMarker(0);
 	tsdPtr->timerPending = 1;
     }
 }
@@ -709,7 +709,7 @@ TimerCheckProc(
  *	the queue. 
  *	Returns 0 if the event was not handled (no timer events).
  *	Returns -1 if pending timer events available, meaning the marker should
- *	stay on the queue.
+ *	stay on the head of queue.
  *
  * Side effects:
  *	Whatever the timer handler callback functions do.
@@ -723,6 +723,7 @@ TclServiceTimerEvents(void)
     TimerEntry *entryPtr, *nextPtr;
     Tcl_Time time;
     size_t currentGeneration, currentEpoch;
+    int prevTmrPending;
     ThreadSpecificData *tsdPtr = InitTimer();
 
 
@@ -762,8 +763,13 @@ TclServiceTimerEvents(void)
 	/* detach entry from the owner's list */
 	TclSpliceOutEx(entryPtr, tsdPtr->promptList, tsdPtr->lastPromptPtr);
 
+	/* reset current timer pending (correct process nested wait event) */
+	prevTmrPending = tsdPtr->timerPending;
+	tsdPtr->timerPending = 0;
 	/* execute event */
 	(*entryPtr->proc)(entryPtr->clientData);
+	/* restore current timer pending */
+	tsdPtr->timerPending += prevTmrPending;
 
 	/* free it via deleteProc and ckfree */
 	if (entryPtr->deleteProc) {
@@ -775,6 +781,7 @@ TclServiceTimerEvents(void)
     /* if stil pending prompt events (new generation) - repeat event cycle as 
      * soon as possible */
     if (tsdPtr->promptList) {
+        tsdPtr->timerPending = 1;
     	return -1;
     }
 
@@ -815,8 +822,14 @@ TclServiceTimerEvents(void)
 
 	currentEpoch = tsdPtr->timerListEpoch;
 
+	/* reset current timer pending (correct process nested wait event) */
+	prevTmrPending = tsdPtr->timerPending;
+	tsdPtr->timerPending = 0;
 	/* invoke timer proc */
 	(*entryPtr->proc)(entryPtr->clientData);
+	/* restore current timer pending */
+	tsdPtr->timerPending += prevTmrPending;
+
 	/* free it via deleteProc or ckfree */
 	if (entryPtr->deleteProc) {
 	    (*entryPtr->deleteProc)(entryPtr->clientData);
@@ -836,6 +849,7 @@ done:
     /* pending timer events, so mark (queue) timer events  */
     if (tsdPtr->timerPending > 1) {
     	tsdPtr->timerPending = 1;
+
     	return -1;
     }
 
@@ -901,7 +915,7 @@ TclCreateTimerEntryEx(
 	
 	/* execute immediately: signal pending and set timer marker */
 	tsdPtr->timerPending++;
-	TclSetTimerEventMarker();
+	TclSetTimerEventMarker(0);
     } else {
     	/* idle generation */
 	entryPtr->generation = tsdPtr->idleGeneration;
@@ -1103,7 +1117,7 @@ Tcl_AfterObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    Tcl_WideInt ms;		/* Number of milliseconds to wait */
+    double ms;		/* Number of milliseconds to wait */
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
@@ -1140,7 +1154,7 @@ Tcl_AfterObjCmd(
 
     index = -1;
     if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds)
-	|| Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK
+	|| Tcl_GetDoubleFromObj(NULL, objv[1], &ms) != TCL_OK
       )
       && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
 				 &index) != TCL_OK
@@ -1169,12 +1183,7 @@ Tcl_AfterObjCmd(
 	if (ms) {
 	    Tcl_Time wakeup;
 	    Tcl_GetTime(&wakeup);
-	    wakeup.sec += (long)(ms / 1000);
-	    wakeup.usec += ((long)(ms % 1000)) * 1000;
-	    if (wakeup.usec > 1000000) {
-		wakeup.sec++;
-		wakeup.usec -= 1000000;
-	    }
+	    TclTimeAddMilliseconds(&wakeup, ms);
 	    entryPtr = TclCreateAbsoluteTimerHandlerEx(&wakeup, AfterProc,
 			    FreeAfterPtr, sizeof(AfterInfo));
 	} else {
@@ -1359,7 +1368,7 @@ Tcl_AfterObjCmd(
 static int
 AfterDelay(
     Tcl_Interp *interp,
-    Tcl_WideInt ms)
+    double ms)
 {
     Interp *iPtr = (Interp *) interp;
 
@@ -1367,12 +1376,7 @@ AfterDelay(
     Tcl_WideInt diff;
 
     Tcl_GetTime(&endTime);
-    endTime.sec += (long)(ms/1000);
-    endTime.usec += ((int)(ms%1000))*1000;
-    if (endTime.usec >= 1000000) {
-	endTime.sec++;
-	endTime.usec -= 1000000;
-    }
+    TclTimeAddMilliseconds(&endTime, ms);
 
     do {
 	Tcl_GetTime(&now);
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 26aa296..f9ff5b4 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -21,6 +21,8 @@
 
 #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
@@ -396,6 +398,216 @@ NotifierProc(
 }
 
 /*
+ * Timer resolution primitives
+ */
+
+typedef int (CALLBACK* LPFN_NtQueryTimerResolution)(PULONG,PULONG,PULONG);
+typedef int (CALLBACK* LPFN_NtSetTimerResolution)(ULONG,BOOLEAN,PULONG);
+
+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 */
+    ULONG minRes;		/* Lowest possible resolution (in 100-ns) */
+    ULONG maxRes;		/* Highest possible resolution (in 100-ns) */
+    ULONG curRes;		/* Current resolution (in 100-ns units). */
+    ULONG resRes;		/* Resolution to be restored (delayed restore) */
+    LONG  minDelay;		/* Lowest delay by max resolution (in microsecs) */
+    LONG  maxDelay;		/* Highest delay by min resolution (in microsecs) */
+    size_t count;		/* Waiter count (used to restore the resolution) */
+    CRITICAL_SECTION cs;	/* Mutex guarding this structure. */
+} timerResolution = {
+    -1,
+    15600 * TMR_RES_MICROSEC, 500 * TMR_RES_MICROSEC, 
+    15600 * TMR_RES_MICROSEC, 0,
+    500, 15600,
+    0
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitTimerResolution --
+ *
+ *	This function initializes the timer resolution functionality.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitTimerResolution(void)
+{
+    if (timerResolution.available == -1) {
+    	TclpInitLock();
+    	if (timerResolution.available == -1) {
+    	    HMODULE hLib = GetModuleHandle("Ntdll");
+	    if (hLib) {
+		NtQueryTimerResolution = 
+		    (LPFN_NtQueryTimerResolution)GetProcAddress(hLib, 
+		    	"NtQueryTimerResolution");
+		NtSetTimerResolution = 
+		    (LPFN_NtSetTimerResolution)GetProcAddress(hLib, 
+		    	"NtSetTimerResolution");
+
+		if ( NtSetTimerResolution && NtQueryTimerResolution
+		  && NtQueryTimerResolution(&timerResolution.minRes,
+				&timerResolution.maxRes, &timerResolution.curRes) == 0
+		) {
+		    InitializeCriticalSection(&timerResolution.cs);
+		    timerResolution.resRes = timerResolution.curRes;
+		    timerResolution.minRes -= (timerResolution.minRes % TMR_RES_MICROSEC);
+		    timerResolution.minDelay = timerResolution.maxRes / TMR_RES_MICROSEC;
+		    timerResolution.maxDelay = timerResolution.minRes / TMR_RES_MICROSEC;
+		    if (timerResolution.maxRes <= 1000 * TMR_RES_MICROSEC) {
+		    	timerResolution.available = 1;
+		    }
+		}
+	    }
+	    if (timerResolution.available <= 0) {
+	    	/* not available, set min/max to typical values on windows */ 
+		timerResolution.minRes = 15600 * TMR_RES_MICROSEC;
+		timerResolution.maxRes = 500 * TMR_RES_MICROSEC;
+		timerResolution.minDelay = timerResolution.maxRes / TMR_RES_MICROSEC;
+		timerResolution.maxDelay = timerResolution.minRes / TMR_RES_MICROSEC;
+		timerResolution.available = 0;
+	    }
+	}
+	TclpInitUnlock();
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetTimerResolution --
+ *
+ *	This is called by Tcl_WaitForEvent to increase timer resolution if wait
+ *	for events with time smaller as the typical windows value (ca. 15ms).
+ *
+ * Results:
+ *	Returns previous value of timer resolution, used for restoring with
+ *	RestoreTimerResolution.
+ *
+ * Side effects:
+ *	Note that timer resolution takes affect for the whole process (accross
+ *	all threads).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned long
+SetTimerResolution(
+    unsigned long newResolution,
+    unsigned long actualResolution
+) {
+    /* if available */
+    if (timerResolution.available > 0)
+    {
+	if (newResolution < timerResolution.maxRes) {
+	    newResolution = timerResolution.maxRes;
+	}
+	EnterCriticalSection(&timerResolution.cs);
+	if (!actualResolution) {
+	    timerResolution.count++;
+	    actualResolution = timerResolution.curRes;
+	}
+	if (newResolution < timerResolution.curRes) {
+	    ULONG curRes;
+	    if (NtSetTimerResolution(newResolution, TRUE, &curRes) == 0) {
+		timerResolution.curRes = curRes;
+	    }
+	}
+	LeaveCriticalSection(&timerResolution.cs);
+	return actualResolution;
+    }
+
+    /* resolution unchanged (and counter not increased) */
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RestoreTimerResolution --
+ *
+ *	This is called by Tcl_WaitForEvent to restore timer resolution to
+ *	previous value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Because timer resolution takes affect for the whole process, it can
+ *	remain max resolution after execution of this function (if some thread
+ *	still waits with the highest timer resolution).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RestoreTimerResolution(
+    unsigned long newResolution
+) {
+    /* if available */
+    if (timerResolution.available > 0 && newResolution) {
+	EnterCriticalSection(&timerResolution.cs);
+	if (timerResolution.count-- <= 1) {
+	    if (newResolution > timerResolution.resRes) {
+	    	timerResolution.resRes = newResolution;
+	    };
+	}
+	LeaveCriticalSection(&timerResolution.cs);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinResetTimerResolution --
+ *
+ *	This is called by CalibrationThread to delayed reset of the timer
+ *	resolution (once per second), if no more waiting workers using 
+ *	precise timer resolution.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinResetTimerResolution(void)
+{
+    if ( timerResolution.available > 0
+      && timerResolution.count == 0 && timerResolution.resRes > timerResolution.curRes
+    ) {
+	EnterCriticalSection(&timerResolution.cs);
+	if (timerResolution.count == 0 && timerResolution.resRes > timerResolution.curRes) {
+	    ULONG curRes;
+	    if (NtSetTimerResolution(timerResolution.resRes, TRUE, &curRes) == 0) {
+		timerResolution.curRes = curRes;
+	    };
+	}
+	LeaveCriticalSection(&timerResolution.cs);
+    }
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_WaitForEvent --
@@ -420,8 +632,11 @@ Tcl_WaitForEvent(
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     MSG msg;
-    DWORD timeout, result;
-    int status;
+    DWORD timeout, result = WAIT_TIMEOUT;
+    int status = 0;
+    Tcl_Time waitTime = {0, 0};
+    Tcl_Time endTime;
+    unsigned long actualResolution = 0;
 
     /*
      * Allow the notifier to be hooked. This may not make sense on windows,
@@ -438,26 +653,72 @@ Tcl_WaitForEvent(
 
     if (timePtr) {
 
-	Tcl_Time myTime;
+	waitTime.sec  = timePtr->sec;
+	waitTime.usec = timePtr->usec;
 
-	/* No wait if timeout too small (because windows may wait too long) */
-	if (!timePtr->sec && timePtr->usec <= 10) {
+	/* if no wait */
+	if (waitTime.sec == 0 && waitTime.usec == 0) {
+	    result = 0;
 	    goto peek;
 	}
 
-	/*
-	 * TIP #233 (Virtualized Time). Convert virtual domain delay to
-	 * real-time.
-	 */
+	/* calculate end of wait */
+	Tcl_GetTime(&endTime);
+	endTime.sec += waitTime.sec;
+	endTime.usec += waitTime.usec;
+	if (endTime.usec > 1000000) {
+		endTime.usec -= 1000000;
+		endTime.sec++;
+	}
 
-	myTime.sec  = timePtr->sec;
-	myTime.usec = timePtr->usec;
+	/*
+	* TIP #233 (Virtualized Time). Convert virtual domain delay to
+	* real-time.
+	*/
+	(*tclScaleTimeProcPtr) (&waitTime, tclTimeClientData);
 
-	if (myTime.sec != 0 || myTime.usec != 0) {
-	    (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
+	if (timerResolution.available == -1) {
+	    InitTimerResolution();
+	}
+	
+    repeat:
+	/* 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 */
+	    if (waitTime.usec >= 10) {
+	    	timeout = 0;
+		goto wait;
+	    }
+	    goto peek;
+	}
+	
+	if (timerResolution.available) {
+	    if (waitTime.sec || waitTime.usec > timerResolution.maxDelay) {
+	    	long usec;
+	    	timeout = waitTime.sec * 1000;
+		usec = ((timeout * 1000) + waitTime.usec) % 1000000;
+		timeout += (usec - (usec % timerResolution.maxDelay)) / 1000;
+	    } else {
+	    	/* 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;
+		} else {
+		    res = 1000 * TMR_RES_MICROSEC;
+		}
+		timeout = waitTime.usec / 1000;
+		/* set more precise timer resolution for minimal delay */
+		if (!actualResolution || res < timerResolution.curRes) {
+		    actualResolution = SetTimerResolution(
+			res, actualResolution);
+		}
+	    }
+	} else {
+	    timeout = waitTime.sec * 1000 + waitTime.usec / 1000;
 	}
-
-	timeout = myTime.sec * 1000 + myTime.usec / 1000;
 
     } else {
 	timeout = INFINITE;
@@ -468,7 +729,7 @@ Tcl_WaitForEvent(
      * because MsgWaitForMultipleObjects will not wake up if there are events
      * currently sitting in the queue.
      */
-
+  wait:
     if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
     	goto get;
     }
@@ -522,11 +783,31 @@ Tcl_WaitForEvent(
 	    DispatchMessage(&msg);
 	    status = 1;
 	}
-    } else {
-	status = 0;
+    }
+    else
+    if (result == WAIT_TIMEOUT && timeout != INFINITE) {
+	/* Check the wait should be repeated, and correct time for wait */
+	Tcl_Time now;
+
+	Tcl_GetTime(&now);
+	waitTime.sec = (endTime.sec - now.sec);
+	if ((waitTime.usec = (endTime.usec - now.usec)) < 0) {
+	    waitTime.usec += 1000000;
+	    waitTime.sec--;
+	}
+	if (waitTime.sec < 0 || !waitTime.sec && waitTime.usec <= 0) {
+	    goto end;
+	}
+	/* Repeat wait with more precise timer resolution (or using sleep) */
+	goto repeat;
     }
 
   end:
+
+    /* restore timer resolution */
+    if (actualResolution) {
+	RestoreTimerResolution(actualResolution); 
+    }
     return status;
 }
 
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 93f62b8..def4548 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -731,6 +731,11 @@ StopCalibration(
     WaitForSingleObject(timeInfo.calibrationThread, 100);
     CloseHandle(timeInfo.exitEvent);
     CloseHandle(timeInfo.calibrationThread);
+
+    /*
+     * Reset timer resolution (shutdown case)
+     */
+    (void)TclWinResetTimerResolution();
 }
 
 /*
@@ -1111,6 +1116,11 @@ CalibrationThread(
 	    break;
 	}
 	UpdateTimeEachSecond();
+
+	/*
+	* Reset timer resolution if expected (check waiter count once per second)
+	*/
+	(void)TclWinResetTimerResolution();
     }
 
     /* lint */