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