diff options
author | sebres <sebres@users.sourceforge.net> | 2017-07-03 13:23:45 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-07-03 13:23:45 (GMT) |
commit | df949554f991f8fb4a399bdd248437012deebe40 (patch) | |
tree | 81ee1cffcddb95744155eaf3ba12e8e4941e3588 | |
parent | f629f9d07d2b465bba72bc71df2d2c9d3856bca8 (diff) | |
download | tcl-df949554f991f8fb4a399bdd248437012deebe40.zip tcl-df949554f991f8fb4a399bdd248437012deebe40.tar.gz tcl-df949554f991f8fb4a399bdd248437012deebe40.tar.bz2 |
[performance] large performance increase by event servicing cycles (3x - 5x faster now);
[win] prevent listen using PeekMessage twice, and no wait anymore for too short timeouts (because windows can wait too long), compare 0µs with up-to 100µs overhead within MsgWaitForMultipleObjectsEx;
[bad behavior] process idle events only as long as no other events available (now TclPeekEventQueued will be used to check new events are available in service idle cycle);
[enhancement] new option "noidletasks" for command "update", so "update noidle" means "process all events but not idle";
-rw-r--r-- | generic/tclEvent.c | 14 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rw-r--r-- | generic/tclNotify.c | 119 | ||||
-rw-r--r-- | generic/tclTimer.c | 214 | ||||
-rw-r--r-- | tests/event.test | 4 | ||||
-rw-r--r-- | win/tclWinNotify.c | 47 |
6 files changed, 238 insertions, 164 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 4db524c..85c564a 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1410,26 +1410,28 @@ Tcl_UpdateObjCmd( Tcl_Obj *CONST objv[]) /* Argument objects. */ { int optionIndex; - int flags = 0; /* Initialized to avoid compiler warning. */ - static CONST char *updateOptions[] = {"idletasks", NULL}; - enum updateOptions {REGEXP_IDLETASKS}; + int flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; + static CONST char *updateOptions[] = {"idletasks", "noidletasks", NULL}; + enum updateOptions {UPDATE_IDLETASKS, UPDATE_NOIDLETASKS}; if (objc == 1) { - flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; } else if (objc == 2) { if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum updateOptions) optionIndex) { - case REGEXP_IDLETASKS: + case UPDATE_IDLETASKS: flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; break; + case UPDATE_NOIDLETASKS: + flags &= ~TCL_IDLE_EVENTS; + break; default: Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); } } else { - Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); + Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; } diff --git a/generic/tclInt.h b/generic/tclInt.h index a0bab62..4151f83 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2484,6 +2484,7 @@ MODULE_SCOPE Tcl_ObjType tclByteCodeType; MODULE_SCOPE Tcl_ObjType tclDoubleType; MODULE_SCOPE Tcl_ObjType tclEndOffsetType; MODULE_SCOPE Tcl_ObjType tclIntType; +MODULE_SCOPE Tcl_ObjType tclIndexType; MODULE_SCOPE Tcl_ObjType tclListType; MODULE_SCOPE Tcl_ObjType tclDictType; MODULE_SCOPE Tcl_ObjType tclProcBodyType; @@ -2919,6 +2920,8 @@ 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 int TclServiceTimerEvents(void); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData); @@ -2930,6 +2933,7 @@ MODULE_SCOPE TimerEntry* TclCreateTimerEntryEx( Tcl_TimerProc *proc, Tcl_TimerDeleteProc *deleteProc, size_t extraDataSize, int flags); MODULE_SCOPE void TclDeleteTimerEntry(TimerEntry *entryPtr); +MODULE_SCOPE int TclPeekEventQueued(int flags); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclNotify.c b/generic/tclNotify.c index b45539a..e883071 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -49,6 +49,8 @@ typedef struct ThreadSpecificData { Tcl_Event *lastEventPtr; /* Last pending event, or NULL if none. */ Tcl_Event *markerEventPtr; /* Last high-priority event in queue, or NULL * if none. */ + Tcl_Event *timerMarkerPtr; /* Weak pointer to last event in the queue, + * before timer event generation */ Tcl_Mutex queueMutex; /* Mutex to protect access to the previous * three fields. */ int serviceMode; /* One of TCL_SERVICE_NONE or @@ -612,7 +614,7 @@ Tcl_ServiceEvent( { Tcl_Event *evPtr, *prevPtr; Tcl_EventProc *proc; - int result; + int result = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* @@ -635,6 +637,13 @@ Tcl_ServiceEvent( } /* + * If timer marker reached, process timer events now. + */ + if (tsdPtr->timerMarkerPtr == INT2PTR(-1) || !tsdPtr->firstEventPtr) { + goto timer; + } + + /* * Loop through all the events in the queue until we find one that can * actually be handled. */ @@ -642,6 +651,14 @@ Tcl_ServiceEvent( Tcl_MutexLock(&(tsdPtr->queueMutex)); for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; evPtr = evPtr->nextPtr) { + + /* + * If timer marker reached, next cycle will process timer events. + */ + if (evPtr == tsdPtr->timerMarkerPtr) { + tsdPtr->timerMarkerPtr = INT2PTR(-1); + } + /* * Call the handler for the event. If it actually handles the event * then free the storage for the event. There are two tricky things @@ -721,7 +738,85 @@ Tcl_ServiceEvent( } } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); - return 0; + +timer: + /* + * Process timer queue, if alloved and timers are enabled. + */ + if ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerMarkerPtr) { + /* reset marker */ + tsdPtr->timerMarkerPtr = NULL; + + result = TclServiceTimerEvents(); + if (result <= 0) { + /* events processed, but marker to process still pending timers */ + tsdPtr->timerMarkerPtr = INT2PTR(-1); + result = 1; + } + } + + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclPeekEventQueued -- + * + * Check whether some event (except idle) available (async, queued, timer). + * + * This will be used e. g. in TclServiceIdle to stop the processing of the + * the idle events if some "normal" event occurred. + * + * Results: + * Returns 1 if some event queued, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclPeekEventQueued( + int flags) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return Tcl_AsyncReady() + || (tsdPtr->firstEventPtr) + || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerMarkerPtr); +} + +/* + *---------------------------------------------------------------------- + * + * TclSetTimerEventMarker -- + * + * Set timer event marker to the last pending event in the queue. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclSetTimerEventMarker(void) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->timerMarkerPtr == NULL) { + /* marker to last event in the queue */ + if (!(tsdPtr->timerMarkerPtr = tsdPtr->lastEventPtr)) { + /* marker as "now" - queue is empty, so timers events are first */ + tsdPtr->timerMarkerPtr = INT2PTR(-1); + }; + } } /* @@ -855,21 +950,12 @@ Tcl_DoOneEvent( * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or * others defined by event sources. */ { - int result = 0, oldMode; + int result = 0, oldMode, i = 0; EventSource *sourcePtr; Tcl_Time *timePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * The first thing we do is to service any asynchronous event handlers. - */ - - if (Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; - } - - /* * No event flags is equivalent to TCL_ALL_EVENTS. */ @@ -904,7 +990,8 @@ Tcl_DoOneEvent( } /* - * Ask Tcl to service a queued event, if there are any. + * Ask Tcl to service any asynchronous event handlers or + * queued event, if there are any. */ if (Tcl_ServiceEvent(flags)) { @@ -921,6 +1008,8 @@ Tcl_DoOneEvent( tsdPtr->blockTime.sec = 0; tsdPtr->blockTime.usec = 0; tsdPtr->blockTimeSet = 1; + timePtr = &tsdPtr->blockTime; + goto wait; /* for notifier resp. system events */ } else { tsdPtr->blockTimeSet = 0; } @@ -939,7 +1028,7 @@ Tcl_DoOneEvent( } tsdPtr->inTraversal = 0; - if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) { + if (tsdPtr->blockTimeSet) { timePtr = &tsdPtr->blockTime; } else { timePtr = NULL; @@ -949,7 +1038,7 @@ Tcl_DoOneEvent( * Wait for a new event or a timeout. If Tcl_WaitForEvent returns -1, * we should abort Tcl_DoOneEvent. */ - + wait: result = Tcl_WaitForEvent(timePtr); if (result < 0) { result = 0; diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 7eee89e..d3aa5aa 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -121,26 +121,13 @@ static void FreeAfterPtr(ClientData clientData); static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, Tcl_Obj *objPtr); static ThreadSpecificData *InitTimer(void); static void TimerExitProc(ClientData clientData); -static int TimerHandlerEventProc(Tcl_Event *evPtr, int flags); -#if 0 static void TimerCheckProc(ClientData clientData, int flags); -#endif static void TimerSetupProc(ClientData clientData, int flags); static void AfterObj_DupInternalRep(Tcl_Obj *, Tcl_Obj *); static void AfterObj_FreeInternalRep(Tcl_Obj *); static void AfterObj_UpdateString(Tcl_Obj *); -static inline void -QueueTimerHandlerEvent() -{ - Tcl_Event *timerEvPtr; - - timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event)); - timerEvPtr->proc = TimerHandlerEventProc; - Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); -} - /* * Type definition. */ @@ -272,7 +259,7 @@ InitTimer(void) if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_CreateEventSource(TimerSetupProc, NULL, tsdPtr); + Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); Tcl_CreateThreadExitHandler(TimerExitProc, NULL); } return tsdPtr; @@ -303,7 +290,7 @@ TimerExitProc( TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { - Tcl_DeleteEventSource(TimerSetupProc, NULL, tsdPtr); + Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, tsdPtr); while ((tsdPtr->lastPromptPtr) != NULL) { TclDeleteTimerEntry(tsdPtr->lastPromptPtr); @@ -596,7 +583,7 @@ TclDeleteTimerEntry( static void TimerSetupProc( - ClientData data, /* Not used. */ + ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime, *firstTime; @@ -604,10 +591,11 @@ TimerSetupProc( if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; - if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList ) - || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { + if ( ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending) + || ((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList ) + ) { /* - * There is an idle handler or a pending timer event, so just poll. + * There is a pending timer event or an idle handler, so just poll. */ blockTime.sec = 0; @@ -630,15 +618,6 @@ TimerSetupProc( blockTime.sec = 0; blockTime.usec = 0; } - - /* - * If the first timer has expired, stick an event on the queue. - */ - - if (blockTime.sec == 0 && blockTime.usec == 0) { - tsdPtr->timerPending = 1; - QueueTimerHandlerEvent(); - } } else { return; @@ -647,15 +626,13 @@ TimerSetupProc( Tcl_SetMaxBlockTime(&blockTime); } -#if 0 /* *---------------------------------------------------------------------- * * TimerCheckProc -- * * This function is called by Tcl_DoOneEvent to check the timer event - * source for events. This routine checks both the idle and after timer - * lists. + * source for events. This routine checks the first timer in the list. * * Results: * None. @@ -668,66 +645,63 @@ TimerSetupProc( static void TimerCheckProc( - ClientData data, /* Not used. */ + ClientData data, /* Specific data. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime, *firstTime; - ThreadSpecificData *tsdPtr = InitTimer(); - - if ((flags & TCL_TIMER_EVENTS) - && !tsdPtr->timerPending - ) { - /* - * Compute the timeout for the next timer on the list. - */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; - if (tsdPtr->promptList) { - goto queuetmr; - } + if (!(flags & TCL_TIMER_EVENTS)) { + return; + } - if (!tsdPtr->timerList) { - return; - } - Tcl_GetTime(&blockTime); - firstTime = &(TimerEntry2TimerHandler(tsdPtr->timerList)->time); - blockTime.sec = firstTime->sec - blockTime.sec; - blockTime.usec = firstTime->usec - blockTime.usec; - if (blockTime.usec < 0) { - blockTime.sec -= 1; - blockTime.usec += 1000000; - } - if (blockTime.sec < 0) { - blockTime.sec = 0; - blockTime.usec = 0; - } + if (tsdPtr == NULL) { tsdPtr = InitTimer(); }; - /* - * If the first timer has expired, stick an event on the queue. - */ + /* If already pending */ + if (!tsdPtr->timerList || tsdPtr->timerPending) { + return; + } - if (blockTime.sec == 0 && blockTime.usec == 0) { - queuetmr: - tsdPtr->timerPending = 1; - QueueTimerHandlerEvent(); - } + /* + * Verify the first timer on the queue. + */ + Tcl_GetTime(&blockTime); + firstTime = &(TimerEntry2TimerHandler(tsdPtr->timerList)->time); + blockTime.sec = firstTime->sec - blockTime.sec; + blockTime.usec = firstTime->usec - blockTime.usec; + if (blockTime.usec < 0) { + blockTime.sec -= 1; + blockTime.usec += 1000000; + } + if (blockTime.sec < 0) { + blockTime.sec = 0; + blockTime.usec = 0; + } + + /* + * If the first timer has expired, stick an event on the queue. + */ + if (blockTime.sec == 0 && blockTime.usec == 0) { + TclSetTimerEventMarker(); + tsdPtr->timerPending = 1; } } -#endif /* *---------------------------------------------------------------------- * - * TimerHandlerEventProc -- + * TclServiceTimerEvents -- * - * This function is called by Tcl_ServiceEvent when a timer event reaches - * the front of the event queue. This function handles the event by + * This function is called by Tcl_ServiceEvent when a timer events should + * be processed. This function handles the event by * invoking the callbacks for all timers that are ready. * * Results: * Returns 1 if the event was handled, meaning it should be removed from - * the queue. Returns 0 if the event was not handled, meaning it should - * stay on the queue. The only time the event isn't handled is if the - * TCL_TIMER_EVENTS flag bit isn't set. + * 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. * * Side effects: * Whatever the timer handler callback functions do. @@ -735,25 +709,17 @@ TimerCheckProc( *---------------------------------------------------------------------- */ -static int -TimerHandlerEventProc( - Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to handle, - * such as TCL_FILE_EVENTS. */ +int +TclServiceTimerEvents(void) { TimerEntry *entryPtr, *nextPtr; Tcl_Time time; size_t currentGeneration, currentEpoch; ThreadSpecificData *tsdPtr = InitTimer(); - /* - * Do nothing if timers aren't enabled. This leaves the event on the - * queue, so we will get to it as soon as ServiceEvents() is called with - * timers enabled. - */ - if (!(flags & TCL_TIMER_EVENTS)) { - return 0; + if (!tsdPtr->timerPending) { + return 0; /* no timer events */ } /* @@ -798,10 +764,10 @@ TimerHandlerEventProc( ckfree((char *) entryPtr); } - /* if pending prompt events (new generation) - repeat event cycle right now */ + /* if stil pending prompt events (new generation) - repeat event cycle as + * soon as possible */ if (tsdPtr->promptList) { - tsdPtr->timerPending = 1; - return 0; /* leave handler event in the queue */ + return -1; } /* Hereafter all timer events with time before now */ @@ -859,10 +825,10 @@ TimerHandlerEventProc( } done: - /* don't need to queue event again by pending timer events */ + /* pending timer events, so mark (queue) timer events */ if (tsdPtr->timerPending > 1) { tsdPtr->timerPending = 1; - return 0; /* leave handler event in the queue */ + return -1; } /* Reset generation if both timer queue are empty */ @@ -873,7 +839,7 @@ done: /* Compute the next timeout (later via TimerSetupProc using the first timer). */ tsdPtr->timerPending = 0; - return 1; /* processing done, again later via TimerSetupProc */ + return 1; /* processing done, again later via TimerCheckProc */ } /* @@ -925,11 +891,9 @@ TclCreateTimerEntryEx( /* attach to the prompt queue */ TclSpliceTailEx(entryPtr, tsdPtr->promptList, tsdPtr->lastPromptPtr); - /* execute immediately: queue handler event right now */ - if (!tsdPtr->timerPending) { - QueueTimerHandlerEvent(); - } - tsdPtr->timerPending++; /* queued and TimerSetupProc knows about */ + /* execute immediately: signal pending and set timer marker */ + tsdPtr->timerPending++; + TclSetTimerEventMarker(); } else { /* idle generation */ entryPtr->generation = tsdPtr->idleGeneration; @@ -1018,7 +982,7 @@ Tcl_CancelIdleCall( /* *---------------------------------------------------------------------- * - * TclServiceIdle -- + * TclServiceIdle -- , TclServiceIdleEx -- * * This function is invoked by the notifier when it becomes idle. It will * invoke all idle handlers that are present at the time the call is @@ -1035,14 +999,14 @@ Tcl_CancelIdleCall( */ int -TclServiceIdle(void) +TclServiceIdleEx( + int count) { TimerEntry *idlePtr; size_t currentGeneration; - Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); - if (tsdPtr->idleList == NULL) { + if ((idlePtr = tsdPtr->idleList) == NULL) { return 0; } @@ -1065,9 +1029,7 @@ TclServiceIdle(void) * during the call. */ - while ((idlePtr = tsdPtr->idleList) != NULL - && idlePtr->generation <= currentGeneration - ) { + while (idlePtr->generation <= currentGeneration) { /* detach entry from the owner's list */ TclSpliceOutEx(idlePtr, tsdPtr->idleList, tsdPtr->lastIdlePtr); @@ -1079,18 +1041,28 @@ TclServiceIdle(void) (*idlePtr->deleteProc)(idlePtr->clientData); } ckfree((char *) idlePtr); + + /* stop processing idle if no more idle, count reached or other queued */ + if ( (idlePtr = tsdPtr->idleList) == NULL + || !--count + || TclPeekEventQueued(TCL_ALL_EVENTS) + ) { + break; + } } - if (tsdPtr->idleList) { - blockTime.sec = 0; - blockTime.usec = 0; - Tcl_SetMaxBlockTime(&blockTime); - } + /* Reset generation */ if (!tsdPtr->idleList) { tsdPtr->idleGeneration = 0; } return 1; } + +int +TclServiceIdle(void) +{ + return TclServiceIdleEx(INT_MAX); +} /* *---------------------------------------------------------------------- @@ -1152,21 +1124,17 @@ Tcl_AfterObjCmd( * First lets see if the command was passed a number as the first argument. */ - if (objv[1]->typePtr == &tclIntType -#ifndef NO_WIDE_TYPE - || objv[1]->typePtr == &tclWideIntType -#endif - || objv[1]->typePtr == &tclBignumType - || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK )) { - index = -1; - if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { - Tcl_AppendResult(interp, "bad argument \"", - Tcl_GetString(objv[1]), - "\": must be cancel, idle, info, or an integer", - NULL); - return TCL_ERROR; - } + index = -1; + if ( ( objv[1]->typePtr == &tclIndexType + || Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK + ) + && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, + &index) != TCL_OK + ) { + Tcl_AppendResult(interp, "bad argument \"", + Tcl_GetString(objv[1]), + "\": must be cancel, idle, info, or an integer", NULL); + return TCL_ERROR; } /* diff --git a/tests/event.test b/tests/event.test index b6d4144..526faf2 100644 --- a/tests/event.test +++ b/tests/event.test @@ -625,10 +625,10 @@ test event-11.7 {Bug 16828b3744} { test event-12.1 {Tcl_UpdateCmd procedure} { list [catch {update a b} msg] $msg -} {1 {wrong # args: should be "update ?idletasks?"}} +} {1 {wrong # args: should be "update ?option?"}} test event-12.2 {Tcl_UpdateCmd procedure} { list [catch {update bogus} msg] $msg -} {1 {bad option "bogus": must be idletasks}} +} {1 {bad option "bogus": must be idletasks or noidletasks}} test event-12.3 {Tcl_UpdateCmd procedure} { foreach i [after info] { after cancel $i diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 1cd5823..26aa296 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -437,13 +437,19 @@ Tcl_WaitForEvent( */ if (timePtr) { + + Tcl_Time myTime; + + /* No wait if timeout too small (because windows may wait too long) */ + if (!timePtr->sec && timePtr->usec <= 10) { + goto peek; + } + /* * TIP #233 (Virtualized Time). Convert virtual domain delay to * real-time. */ - Tcl_Time myTime; - myTime.sec = timePtr->sec; myTime.usec = timePtr->usec; @@ -452,6 +458,7 @@ Tcl_WaitForEvent( } timeout = myTime.sec * 1000 + myTime.usec / 1000; + } else { timeout = INFINITE; } @@ -462,33 +469,38 @@ Tcl_WaitForEvent( * currently sitting in the queue. */ - if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { - /* - * Wait for something to happen (a signal from another thread, a - * message, or timeout) or loop servicing asynchronous procedure calls - * queued to this thread. - */ + if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + goto get; + } - again: - result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, + /* + * Wait for something to happen (a signal from another thread, a + * message, or timeout) or loop servicing asynchronous procedure calls + * queued to this thread. + */ + + again: + result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, QS_ALLINPUT, MWMO_ALERTABLE); - if (result == WAIT_IO_COMPLETION) { - goto again; - } else if (result == WAIT_FAILED) { - status = -1; - goto end; - } + if (result == WAIT_IO_COMPLETION) { + goto again; + } + ResetEvent(tsdPtr->event); + if (result == WAIT_FAILED) { + status = -1; + goto end; } /* * Check to see if there are any messages to process. */ - + peek: if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Retrieve and dispatch the first message. */ + get: result = GetMessage(&msg, NULL, 0, 0); if (result == 0) { /* @@ -515,7 +527,6 @@ Tcl_WaitForEvent( } end: - ResetEvent(tsdPtr->event); return status; } |