diff options
Diffstat (limited to 'win/tclWinNotify.c')
| -rw-r--r-- | win/tclWinNotify.c | 286 |
1 files changed, 163 insertions, 123 deletions
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 3ac1c6c..1cd5823 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -1,30 +1,30 @@ -/* +/* * tclWinNotify.c -- * - * This file contains Windows-specific procedures for the notifier, - * which is the lowest-level part of the Tcl event loop. This file - * works together with ../generic/tclNotify.c. + * This file contains Windows-specific procedures for the notifier, which + * is the lowest-level part of the Tcl event loop. This file works + * together with ../generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclWinInt.h" +#include "tclInt.h" /* * The follwing static indicates whether this module has been initialized. */ -#define INTERVAL_TIMER 1 /* Handle of interval timer. */ +#define INTERVAL_TIMER 1 /* Handle of interval timer. */ -#define WM_WAKEUP WM_USER /* Message that is send by +#define WM_WAKEUP WM_USER /* Message that is send by * Tcl_AlertNotifier. */ /* * The following static structure contains the state information for the - * Windows implementation of the Tcl notifier. One of these structures - * is created for each thread that is using the notifier. + * Windows implementation of the Tcl notifier. One of these structures is + * created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { @@ -33,8 +33,8 @@ typedef struct ThreadSpecificData { * notifier. */ HANDLE event; /* Event object used to wake up the notifier * thread. */ - int pending; /* Alert message pending, this field is - * locked by the notifierMutex. */ + int pending; /* Alert message pending, this field is locked + * by the notifierMutex. */ HWND hwnd; /* Messaging window. */ int timeout; /* Current timeout value. */ int timerActive; /* 1 if interval timer is running. */ @@ -46,9 +46,8 @@ extern TclStubs tclStubs; extern Tcl_NotifierProcs tclOriginalNotifier; /* - * The following static indicates the number of threads that have - * initialized notifiers. It controls the lifetime of the TclNotifier - * window class. + * The following static indicates the number of threads that have initialized + * notifiers. It controls the lifetime of the TclNotifier window class. * * You must hold the notifierMutex lock before accessing this variable. */ @@ -60,9 +59,8 @@ TCL_DECLARE_MUTEX(notifierMutex) * Static routines defined in this file. */ -static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, - WPARAM wParam, LPARAM lParam); - +static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, + WPARAM wParam, LPARAM lParam); /* *---------------------------------------------------------------------- @@ -81,14 +79,14 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, */ ClientData -Tcl_InitNotifier() +Tcl_InitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); WNDCLASS class; /* - * Register Notifier window class if this is the first thread to - * use this module. + * Register Notifier window class if this is the first thread to use this + * module. */ Tcl_MutexLock(¬ifierMutex); @@ -105,7 +103,7 @@ Tcl_InitNotifier() class.hCursor = NULL; if (!RegisterClassA(&class)) { - panic("Unable to register TclNotifier window class"); + Tcl_Panic("Unable to register TclNotifier window class"); } } notifierCount++; @@ -129,8 +127,8 @@ Tcl_InitNotifier() * * Tcl_FinalizeNotifier -- * - * This function is called to cleanup the notifier state before - * a thread is terminated. + * This function is called to cleanup the notifier state before a thread + * is terminated. * * Results: * None. @@ -142,21 +140,22 @@ Tcl_InitNotifier() */ void -Tcl_FinalizeNotifier(clientData) - ClientData clientData; /* Pointer to notifier data. */ +Tcl_FinalizeNotifier( + ClientData clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* - * Only finalize the notifier if a notifier was installed in the - * current thread; there is a route in which this is not - * guaranteed to be true (when tclWin32Dll.c:DllMain() is called - * with the flag DLL_PROCESS_DETACH by the OS, which could be - * doing so from a thread that's never previously been involved - * with Tcl, e.g. the task manager) so this check is important. + * Only finalize the notifier if a notifier was installed in the current + * thread; there is a route in which this is not guaranteed to be true + * (when tclWin32Dll.c:DllMain() is called with the flag + * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread + * that's never previously been involved with Tcl, e.g. the task manager) + * so this check is important. * * Fixes Bug #217982 reported by Hugh Vu and Gene Leache. */ + if (tsdPtr == NULL) { return; } @@ -174,8 +173,8 @@ Tcl_FinalizeNotifier(clientData) } /* - * If this is the last thread to use the notifier, unregister - * the notifier window class. + * If this is the last thread to use the notifier, unregister the notifier + * window class. */ Tcl_MutexLock(¬ifierMutex); @@ -191,34 +190,33 @@ Tcl_FinalizeNotifier(clientData) * * Tcl_AlertNotifier -- * - * Wake up the specified notifier from any thread. This routine - * is called by the platform independent notifier code whenever - * the Tcl_ThreadAlert routine is called. This routine is - * guaranteed not to be called on a given notifier after - * Tcl_FinalizeNotifier is called for that notifier. This routine - * is typically called from a thread other than the notifier's - * thread. + * Wake up the specified notifier from any thread. This routine is called + * by the platform independent notifier code whenever the Tcl_ThreadAlert + * routine is called. This routine is guaranteed not to be called on a + * given notifier after Tcl_FinalizeNotifier is called for that notifier. + * This routine is typically called from a thread other than the + * notifier's thread. * * Results: * None. * * Side effects: - * Sends a message to the messaging window for the notifier - * if there isn't already one pending. + * Sends a message to the messaging window for the notifier if there + * isn't already one pending. * *---------------------------------------------------------------------- */ void -Tcl_AlertNotifier(clientData) - ClientData clientData; /* Pointer to thread data. */ +Tcl_AlertNotifier( + ClientData clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* - * Note that we do not need to lock around access to the hwnd - * because the race condition has no effect since any race condition - * implies that the notifier thread is already awake. + * Note that we do not need to lock around access to the hwnd because the + * race condition has no effect since any race condition implies that the + * notifier thread is already awake. */ if (tsdPtr->hwnd) { @@ -242,9 +240,9 @@ Tcl_AlertNotifier(clientData) * * Tcl_SetTimer -- * - * This procedure sets the current notifier timer value. The - * notifier will ensure that Tcl_ServiceAll() is called after - * the specified interval, even if no events have occurred. + * This procedure sets the current notifier timer value. The notifier + * will ensure that Tcl_ServiceAll() is called after the specified + * interval, even if no events have occurred. * * Results: * None. @@ -263,8 +261,8 @@ Tcl_SetTimer( UINT timeout; /* - * Allow the notifier to be hooked. This may not make sense - * on Windows, but mirrors the UNIX hook. + * Allow the notifier to be hooked. This may not make sense on Windows, + * but mirrors the UNIX hook. */ if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { @@ -273,10 +271,9 @@ Tcl_SetTimer( } /* - * We only need to set up an interval timer if we're being called - * from an external event loop. If we don't have a window handle - * then we just return immediately and let Tcl_WaitForEvent handle - * timeouts. + * We only need to set up an interval timer if we're being called from an + * external event loop. If we don't have a window handle then we just + * return immediately and let Tcl_WaitForEvent handle timeouts. */ if (!tsdPtr->hwnd) { @@ -299,8 +296,8 @@ Tcl_SetTimer( tsdPtr->timeout = timeout; if (timeout != 0) { tsdPtr->timerActive = 1; - SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, - (unsigned long) tsdPtr->timeout, NULL); + SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout, + NULL); } else { tsdPtr->timerActive = 0; KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); @@ -318,37 +315,37 @@ Tcl_SetTimer( * None. * * Side effects: - * If this is the first time the notifier is set into - * TCL_SERVICE_ALL, then the communication window is created. + * If this is the first time the notifier is set into TCL_SERVICE_ALL, + * then the communication window is created. * *---------------------------------------------------------------------- */ void -Tcl_ServiceModeHook(mode) - int mode; /* Either TCL_SERVICE_ALL, or +Tcl_ServiceModeHook( + int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * If this is the first time that the notifier has been used from a - * modal loop, then create a communication window. Note that after - * this point, the application needs to service events in a timely - * fashion or Windows will hang waiting for the window to respond - * to synchronous system messages. At some point, we may want to - * consider destroying the window if we leave the modal loop, but - * for now we'll leave it around. + * If this is the first time that the notifier has been used from a modal + * loop, then create a communication window. Note that after this point, + * the application needs to service events in a timely fashion or Windows + * will hang waiting for the window to respond to synchronous system + * messages. At some point, we may want to consider destroying the window + * if we leave the modal loop, but for now we'll leave it around. */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); + /* * Send an initial message to the window to ensure that we wake up the - * notifier once we get into the modal loop. This will force the - * notifier to recompute the timeout value and schedule a timer - * if one is needed. + * notifier once we get into the modal loop. This will force the + * notifier to recompute the timeout value and schedule a timer if one + * is needed. */ Tcl_AlertNotifier((ClientData)tsdPtr); @@ -360,10 +357,9 @@ Tcl_ServiceModeHook(mode) * * NotifierProc -- * - * This procedure is invoked by Windows to process events on - * the notifier window. Messages will be sent to this window - * in response to external timer events or calls to - * TclpAlertTsdPtr-> + * This procedure is invoked by Windows to process events on the notifier + * window. Messages will be sent to this window in response to external + * timer events or calls to TclpAlertTsdPtr-> * * Results: * A standard windows result. @@ -376,10 +372,10 @@ Tcl_ServiceModeHook(mode) static LRESULT CALLBACK NotifierProc( - HWND hwnd, - UINT message, - WPARAM wParam, - LPARAM lParam) + HWND hwnd, /* Passed on... */ + UINT message, /* What messsage is this? */ + WPARAM wParam, /* Passed on... */ + LPARAM lParam) /* Passed on... */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -390,7 +386,7 @@ NotifierProc( } else if (message != WM_TIMER) { return DefWindowProc(hwnd, message, wParam, lParam); } - + /* * Process all of the runnable events. */ @@ -404,17 +400,16 @@ NotifierProc( * * Tcl_WaitForEvent -- * - * This function is called by Tcl_DoOneEvent to wait for new - * events on the message queue. If the block time is 0, then - * Tcl_WaitForEvent just polls the event queue without blocking. + * This function is called by Tcl_DoOneEvent to wait for new events on + * the message queue. If the block time is 0, then Tcl_WaitForEvent just + * polls the event queue without blocking. * * Results: - * Returns -1 if a WM_QUIT message is detected, returns 1 if - * a message was dispatched, otherwise returns 0. + * Returns -1 if a WM_QUIT message is detected, returns 1 if a message + * was dispatched, otherwise returns 0. * * Side effects: - * Dispatches a message to a window procedure, which could do - * anything. + * Dispatches a message to a window procedure, which could do anything. * *---------------------------------------------------------------------- */ @@ -429,8 +424,8 @@ Tcl_WaitForEvent( int status; /* - * Allow the notifier to be hooked. This may not make - * sense on windows, but mirrors the UNIX hook. + * Allow the notifier to be hooked. This may not make sense on windows, + * but mirrors the UNIX hook. */ if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { @@ -442,7 +437,21 @@ Tcl_WaitForEvent( */ if (timePtr) { - timeout = timePtr->sec * 1000 + timePtr->usec / 1000; + /* + * TIP #233 (Virtualized Time). Convert virtual domain delay to + * real-time. + */ + + Tcl_Time myTime; + + myTime.sec = timePtr->sec; + myTime.usec = timePtr->usec; + + if (myTime.sec != 0 || myTime.usec != 0) { + (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + } + + timeout = myTime.sec * 1000 + myTime.usec / 1000; } else { timeout = INFINITE; } @@ -456,11 +465,19 @@ Tcl_WaitForEvent( if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Wait for something to happen (a signal from another thread, a - * message, or timeout). + * message, or timeout) or loop servicing asynchronous procedure calls + * queued to this thread. */ - result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout, - QS_ALLINPUT); + 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; + } } /* @@ -483,7 +500,7 @@ Tcl_WaitForEvent( status = -1; } else if (result == (DWORD)-1) { /* - * We got an error from the system. I have no idea why this would + * We got an error from the system. I have no idea why this would * happen, so we'll just unwind. */ @@ -497,6 +514,7 @@ Tcl_WaitForEvent( status = 0; } + end: ResetEvent(tsdPtr->event); return status; } @@ -518,42 +536,64 @@ Tcl_WaitForEvent( */ void -Tcl_Sleep(ms) - int ms; /* Number of milliseconds to sleep. */ +Tcl_Sleep( + int ms) /* Number of milliseconds to sleep. */ { /* - * Simply calling 'Sleep' for the requisite number of milliseconds - * can make the process appear to wake up early because it isn't - * synchronized with the CPU performance counter that is used in - * tclWinTime.c. This behavior is probably benign, but messes - * up some of the corner cases in the test suite. We get around - * this problem by repeating the 'Sleep' call as many times - * as necessary to make the clock advance by the requisite amount. + * Simply calling 'Sleep' for the requisite number of milliseconds can + * make the process appear to wake up early because it isn't synchronized + * with the CPU performance counter that is used in tclWinTime.c. This + * behavior is probably benign, but messes up some of the corner cases in + * the test suite. We get around this problem by repeating the 'Sleep' + * call as many times as necessary to make the clock advance by the + * requisite amount. */ - Tcl_Time now; /* Current wall clock time */ - Tcl_Time desired; /* Desired wakeup time */ - DWORD sleepTime = ms; /* Time to sleep */ + Tcl_Time now; /* Current wall clock time. */ + Tcl_Time desired; /* Desired wakeup time. */ + Tcl_Time vdelay; /* Time to sleep, for scaling virtual -> + * real. */ + DWORD sleepTime; /* Time to sleep, real-time */ + + vdelay.sec = ms / 1000; + vdelay.usec = (ms % 1000) * 1000; - Tcl_GetTime( &now ); - desired.sec = now.sec + ( ms / 1000 ); - desired.usec = now.usec + 1000 * ( ms % 1000 ); - if ( desired.usec > 1000000 ) { + Tcl_GetTime(&now); + desired.sec = now.sec + vdelay.sec; + desired.usec = now.usec + vdelay.usec; + if (desired.usec > 1000000) { ++desired.sec; desired.usec -= 1000000; } - - for ( ; ; ) { - Sleep( sleepTime ); - Tcl_GetTime( &now ); - if ( now.sec > desired.sec ) { + + /* + * TIP #233: Scale delay from virtual to real-time. + */ + + (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); + sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; + + for (;;) { + Sleep(sleepTime); + Tcl_GetTime(&now); + if (now.sec > desired.sec) { break; - } else if ( ( now.sec == desired.sec ) - && ( now.usec >= desired.usec ) ) { + } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) { break; } - sleepTime = ( ( 1000 * ( desired.sec - now.sec ) ) - + ( ( desired.usec - now.usec ) / 1000 ) ); - } + vdelay.sec = desired.sec - now.sec; + vdelay.usec = desired.usec - now.usec; + + (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); + sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; + } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |