1 /*
2 * tclWinNotify.c --
3 *
4 * This file contains Windows-specific procedures for the notifier, which
5 * is the lowest-level part of the Tcl event loop. This file works
6 * together with ../generic/tclNotify.c.
7 *
8 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 */
13
14 #include "tclInt.h"
15
16 /*
17 * The follwing static indicates whether this module has been initialized.
18 */
19
20 #define INTERVAL_TIMER 1 /* Handle of interval timer. */
21
22 #define WM_WAKEUP WM_USER /* Message that is send by
23 * Tcl_AlertNotifier. */
24 /*
25 * The following static structure contains the state information for the
26 * Windows implementation of the Tcl notifier. One of these structures is
27 * created for each thread that is using the notifier.
28 */
29
30 typedef struct ThreadSpecificData {
31 CRITICAL_SECTION crit; /* Monitor for this notifier. */
32 DWORD thread; /* Identifier for thread associated with this
33 * notifier. */
34 HANDLE event; /* Event object used to wake up the notifier
35 * thread. */
36 int pending; /* Alert message pending, this field is locked
37 * by the notifierMutex. */
38 HWND hwnd; /* Messaging window. */
39 int timeout; /* Current timeout value. */
40 int timerActive; /* 1 if interval timer is running. */
41 } ThreadSpecificData;
42
43 static Tcl_ThreadDataKey dataKey;
44
45 /*
46 * The following static indicates the number of threads that have initialized
47 * notifiers. It controls the lifetime of the TclNotifier window class.
48 *
49 * You must hold the notifierMutex lock before accessing this variable.
50 */
51
52 static int notifierCount = 0;
53 static const WCHAR classname[] = L"TclNotifier";
54 TCL_DECLARE_MUTEX(notifierMutex)
55
56 /*
57 * Static routines defined in this file.
58 */
59
60 static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
61 WPARAM wParam, LPARAM lParam);
62
63 /*
64 *----------------------------------------------------------------------
65 *
66 * Tcl_InitNotifier --
67 *
68 * Initializes the platform specific notifier state.
69 *
70 * Results:
71 * Returns a handle to the notifier state for this thread..
72 *
73 * Side effects:
74 * None.
75 *
76 *----------------------------------------------------------------------
77 */
78
79 ClientData
Tcl_InitNotifier(void)80 Tcl_InitNotifier(void)
81 {
82 if (tclNotifierHooks.initNotifierProc) {
83 return tclNotifierHooks.initNotifierProc();
84 } else {
85 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
86 WNDCLASSW windowClass;
87
88 /*
89 * Register Notifier window class if this is the first thread to use
90 * this module.
91 */
92
93 Tcl_MutexLock(¬ifierMutex);
94 if (notifierCount == 0) {
95 windowClass.style = 0;
96 windowClass.cbClsExtra = 0;
97 windowClass.cbWndExtra = 0;
98 windowClass.hInstance = TclWinGetTclInstance();
99 windowClass.hbrBackground = NULL;
100 windowClass.lpszMenuName = NULL;
101 windowClass.lpszClassName = classname;
102 windowClass.lpfnWndProc = NotifierProc;
103 windowClass.hIcon = NULL;
104 windowClass.hCursor = NULL;
105
106 if (!RegisterClassW(&windowClass)) {
107 Tcl_Panic("Unable to register TclNotifier window class");
108 }
109 }
110 notifierCount++;
111 Tcl_MutexUnlock(¬ifierMutex);
112
113 tsdPtr->pending = 0;
114 tsdPtr->timerActive = 0;
115
116 InitializeCriticalSection(&tsdPtr->crit);
117
118 tsdPtr->hwnd = NULL;
119 tsdPtr->thread = GetCurrentThreadId();
120 tsdPtr->event = CreateEventW(NULL, TRUE /* manual */,
121 FALSE /* !signaled */, NULL);
122
123 return tsdPtr;
124 }
125 }
126
127 /*
128 *----------------------------------------------------------------------
129 *
130 * Tcl_FinalizeNotifier --
131 *
132 * This function is called to cleanup the notifier state before a thread
133 * is terminated.
134 *
135 * Results:
136 * None.
137 *
138 * Side effects:
139 * May dispose of the notifier window and class.
140 *
141 *----------------------------------------------------------------------
142 */
143
144 void
Tcl_FinalizeNotifier(ClientData clientData)145 Tcl_FinalizeNotifier(
146 ClientData clientData) /* Pointer to notifier data. */
147 {
148 if (tclNotifierHooks.finalizeNotifierProc) {
149 tclNotifierHooks.finalizeNotifierProc(clientData);
150 return;
151 } else {
152 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
153
154 /*
155 * Only finalize the notifier if a notifier was installed in the
156 * current thread; there is a route in which this is not guaranteed to
157 * be true (when tclWin32Dll.c:DllMain() is called with the flag
158 * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
159 * that's never previously been involved with Tcl, e.g. the task
160 * manager) so this check is important.
161 *
162 * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
163 */
164
165 if (tsdPtr == NULL) {
166 return;
167 }
168
169 DeleteCriticalSection(&tsdPtr->crit);
170 CloseHandle(tsdPtr->event);
171
172 /*
173 * Clean up the timer and messaging window for this thread.
174 */
175
176 if (tsdPtr->hwnd) {
177 KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
178 DestroyWindow(tsdPtr->hwnd);
179 }
180
181 /*
182 * If this is the last thread to use the notifier, unregister the
183 * notifier window class.
184 */
185
186 Tcl_MutexLock(¬ifierMutex);
187 notifierCount--;
188 if (notifierCount == 0) {
189 UnregisterClassW(classname, TclWinGetTclInstance());
190 }
191 Tcl_MutexUnlock(¬ifierMutex);
192 }
193 }
194
195 /*
196 *----------------------------------------------------------------------
197 *
198 * Tcl_AlertNotifier --
199 *
200 * Wake up the specified notifier from any thread. This routine is called
201 * by the platform independent notifier code whenever the Tcl_ThreadAlert
202 * routine is called. This routine is guaranteed not to be called on a
203 * given notifier after Tcl_FinalizeNotifier is called for that notifier.
204 * This routine is typically called from a thread other than the
205 * notifier's thread.
206 *
207 * Results:
208 * None.
209 *
210 * Side effects:
211 * Sends a message to the messaging window for the notifier if there
212 * isn't already one pending.
213 *
214 *----------------------------------------------------------------------
215 */
216
217 void
Tcl_AlertNotifier(ClientData clientData)218 Tcl_AlertNotifier(
219 ClientData clientData) /* Pointer to thread data. */
220 {
221 if (tclNotifierHooks.alertNotifierProc) {
222 tclNotifierHooks.alertNotifierProc(clientData);
223 return;
224 } else {
225 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
226
227 /*
228 * Note that we do not need to lock around access to the hwnd because
229 * the race condition has no effect since any race condition implies
230 * that the notifier thread is already awake.
231 */
232
233 if (tsdPtr->hwnd) {
234 /*
235 * We do need to lock around access to the pending flag.
236 */
237
238 EnterCriticalSection(&tsdPtr->crit);
239 if (!tsdPtr->pending) {
240 PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
241 }
242 tsdPtr->pending = 1;
243 LeaveCriticalSection(&tsdPtr->crit);
244 } else {
245 SetEvent(tsdPtr->event);
246 }
247 }
248 }
249
250 /*
251 *----------------------------------------------------------------------
252 *
253 * Tcl_SetTimer --
254 *
255 * This procedure sets the current notifier timer value. The notifier
256 * will ensure that Tcl_ServiceAll() is called after the specified
257 * interval, even if no events have occurred.
258 *
259 * Results:
260 * None.
261 *
262 * Side effects:
263 * Replaces any previous timer.
264 *
265 *----------------------------------------------------------------------
266 */
267
268 void
Tcl_SetTimer(const Tcl_Time * timePtr)269 Tcl_SetTimer(
270 const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
271 {
272 if (tclNotifierHooks.setTimerProc) {
273 tclNotifierHooks.setTimerProc(timePtr);
274 return;
275 } else {
276 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
277 UINT timeout;
278
279 /*
280 * We only need to set up an interval timer if we're being called from
281 * an external event loop. If we don't have a window handle then we
282 * just return immediately and let Tcl_WaitForEvent handle timeouts.
283 */
284
285 if (!tsdPtr->hwnd) {
286 return;
287 }
288
289 if (!timePtr) {
290 timeout = 0;
291 } else {
292 /*
293 * Make sure we pass a non-zero value into the timeout argument.
294 * Windows seems to get confused by zero length timers.
295 */
296
297 timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
298 if (timeout == 0) {
299 timeout = 1;
300 }
301 }
302 tsdPtr->timeout = timeout;
303 if (timeout != 0) {
304 tsdPtr->timerActive = 1;
305 SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
306 (unsigned long) tsdPtr->timeout, NULL);
307 } else {
308 tsdPtr->timerActive = 0;
309 KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
310 }
311 }
312 }
313
314 /*
315 *----------------------------------------------------------------------
316 *
317 * Tcl_ServiceModeHook --
318 *
319 * This function is invoked whenever the service mode changes.
320 *
321 * Results:
322 * None.
323 *
324 * Side effects:
325 * If this is the first time the notifier is set into TCL_SERVICE_ALL,
326 * then the communication window is created.
327 *
328 *----------------------------------------------------------------------
329 */
330
331 void
Tcl_ServiceModeHook(int mode)332 Tcl_ServiceModeHook(
333 int mode) /* Either TCL_SERVICE_ALL, or
334 * TCL_SERVICE_NONE. */
335 {
336 if (tclNotifierHooks.serviceModeHookProc) {
337 tclNotifierHooks.serviceModeHookProc(mode);
338 return;
339 } else {
340 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
341
342 /*
343 * If this is the first time that the notifier has been used from a
344 * modal loop, then create a communication window. Note that after this
345 * point, the application needs to service events in a timely fashion
346 * or Windows will hang waiting for the window to respond to
347 * synchronous system messages. At some point, we may want to consider
348 * destroying the window if we leave the modal loop, but for now we'll
349 * leave it around.
350 */
351
352 if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
353 tsdPtr->hwnd = CreateWindowW(classname, classname,
354 WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(),
355 NULL);
356
357 /*
358 * Send an initial message to the window to ensure that we wake up
359 * the notifier once we get into the modal loop. This will force
360 * the notifier to recompute the timeout value and schedule a timer
361 * if one is needed.
362 */
363
364 Tcl_AlertNotifier(tsdPtr);
365 }
366 }
367 }
368
369 /*
370 *----------------------------------------------------------------------
371 *
372 * NotifierProc --
373 *
374 * This procedure is invoked by Windows to process events on the notifier
375 * window. Messages will be sent to this window in response to external
376 * timer events or calls to TclpAlertTsdPtr->
377 *
378 * Results:
379 * A standard windows result.
380 *
381 * Side effects:
382 * Services any pending events.
383 *
384 *----------------------------------------------------------------------
385 */
386
387 static LRESULT CALLBACK
NotifierProc(HWND hwnd,UINT message,WPARAM wParam,LPARAM lParam)388 NotifierProc(
389 HWND hwnd, /* Passed on... */
390 UINT message, /* What messsage is this? */
391 WPARAM wParam, /* Passed on... */
392 LPARAM lParam) /* Passed on... */
393 {
394 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
395
396 if (message == WM_WAKEUP) {
397 EnterCriticalSection(&tsdPtr->crit);
398 tsdPtr->pending = 0;
399 LeaveCriticalSection(&tsdPtr->crit);
400 } else if (message != WM_TIMER) {
401 return DefWindowProcW(hwnd, message, wParam, lParam);
402 }
403
404 /*
405 * Process all of the runnable events.
406 */
407
408 Tcl_ServiceAll();
409 return 0;
410 }
411
412 /*
413 *----------------------------------------------------------------------
414 *
415 * Tcl_WaitForEvent --
416 *
417 * This function is called by Tcl_DoOneEvent to wait for new events on
418 * the message queue. If the block time is 0, then Tcl_WaitForEvent just
419 * polls the event queue without blocking.
420 *
421 * Results:
422 * Returns -1 if a WM_QUIT message is detected, returns 1 if a message
423 * was dispatched, otherwise returns 0.
424 *
425 * Side effects:
426 * Dispatches a message to a window procedure, which could do anything.
427 *
428 *----------------------------------------------------------------------
429 */
430
431 int
Tcl_WaitForEvent(const Tcl_Time * timePtr)432 Tcl_WaitForEvent(
433 const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
434 {
435 if (tclNotifierHooks.waitForEventProc) {
436 return tclNotifierHooks.waitForEventProc(timePtr);
437 } else {
438 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
439 MSG msg;
440 DWORD timeout, result;
441 int status;
442
443 /*
444 * Compute the timeout in milliseconds.
445 */
446
447 if (timePtr) {
448 /*
449 * TIP #233 (Virtualized Time). Convert virtual domain delay to
450 * real-time.
451 */
452
453 Tcl_Time myTime;
454
455 myTime.sec = timePtr->sec;
456 myTime.usec = timePtr->usec;
457
458 if (myTime.sec != 0 || myTime.usec != 0) {
459 tclScaleTimeProcPtr(&myTime, tclTimeClientData);
460 }
461
462 timeout = myTime.sec * 1000 + myTime.usec / 1000;
463 } else {
464 timeout = INFINITE;
465 }
466
467 /*
468 * Check to see if there are any messages in the queue before waiting
469 * because MsgWaitForMultipleObjects will not wake up if there are
470 * events currently sitting in the queue.
471 */
472
473 if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
474 /*
475 * Wait for something to happen (a signal from another thread, a
476 * message, or timeout) or loop servicing asynchronous procedure
477 * calls queued to this thread.
478 */
479
480 again:
481 result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
482 QS_ALLINPUT, MWMO_ALERTABLE);
483 if (result == WAIT_IO_COMPLETION) {
484 goto again;
485 } else if (result == WAIT_FAILED) {
486 status = -1;
487 goto end;
488 }
489 }
490
491 /*
492 * Check to see if there are any messages to process.
493 */
494
495 if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
496 /*
497 * Retrieve and dispatch the first message.
498 */
499
500 result = GetMessageW(&msg, NULL, 0, 0);
501 if (result == 0) {
502 /*
503 * We received a request to exit this thread (WM_QUIT), so
504 * propagate the quit message and start unwinding.
505 */
506
507 PostQuitMessage((int) msg.wParam);
508 status = -1;
509 } else if (result == (DWORD)-1) {
510 /*
511 * We got an error from the system. I have no idea why this
512 * would happen, so we'll just unwind.
513 */
514
515 status = -1;
516 } else {
517 TranslateMessage(&msg);
518 DispatchMessageW(&msg);
519 status = 1;
520 }
521 } else {
522 status = 0;
523 }
524
525 end:
526 ResetEvent(tsdPtr->event);
527 return status;
528 }
529 }
530
531 /*
532 *----------------------------------------------------------------------
533 *
534 * Tcl_Sleep --
535 *
536 * Delay execution for the specified number of milliseconds.
537 *
538 * Results:
539 * None.
540 *
541 * Side effects:
542 * Time passes.
543 *
544 *----------------------------------------------------------------------
545 */
546
547 void
Tcl_Sleep(int ms)548 Tcl_Sleep(
549 int ms) /* Number of milliseconds to sleep. */
550 {
551 /*
552 * Simply calling 'Sleep' for the requisite number of milliseconds can
553 * make the process appear to wake up early because it isn't synchronized
554 * with the CPU performance counter that is used in tclWinTime.c. This
555 * behavior is probably benign, but messes up some of the corner cases in
556 * the test suite. We get around this problem by repeating the 'Sleep'
557 * call as many times as necessary to make the clock advance by the
558 * requisite amount.
559 */
560
561 Tcl_Time now; /* Current wall clock time. */
562 Tcl_Time desired; /* Desired wakeup time. */
563 Tcl_Time vdelay; /* Time to sleep, for scaling virtual ->
564 * real. */
565 DWORD sleepTime; /* Time to sleep, real-time */
566
567 vdelay.sec = ms / 1000;
568 vdelay.usec = (ms % 1000) * 1000;
569
570 Tcl_GetTime(&now);
571 desired.sec = now.sec + vdelay.sec;
572 desired.usec = now.usec + vdelay.usec;
573 if (desired.usec > 1000000) {
574 ++desired.sec;
575 desired.usec -= 1000000;
576 }
577
578 /*
579 * TIP #233: Scale delay from virtual to real-time.
580 */
581
582 tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
583 sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
584
585 for (;;) {
586 SleepEx(sleepTime, TRUE);
587 Tcl_GetTime(&now);
588 if (now.sec > desired.sec) {
589 break;
590 } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
591 break;
592 }
593
594 vdelay.sec = desired.sec - now.sec;
595 vdelay.usec = desired.usec - now.usec;
596
597 tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
598 sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
599 }
600 }
601
602 /*
603 * Local Variables:
604 * mode: c
605 * c-basic-offset: 4
606 * fill-column: 78
607 * End:
608 */
609