summaryrefslogtreecommitdiffstats
path: root/win/tclWinNotify.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinNotify.c')
-rw-r--r--win/tclWinNotify.c286
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(&notifierMutex);
@@ -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(&notifierMutex);
@@ -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:
+ */