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

4 files changed, 77 insertions, 56 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);