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