Massive patch for the first months work adding System FC to GHC #35
[ghc-hetmet.git] / rts / win32 / Ticker.c
1 /*
2  * RTS periodic timers.
3  * 
4  */
5 #include "Rts.h"
6 #include "Timer.h"
7 #include "Ticker.h"
8 #include <windows.h>
9 #include <stdio.h>
10 #include <process.h>
11 #include "OSThreads.h"
12
13 /*
14  * Provide a timer service for the RTS, periodically
15  * notifying it that a number of 'ticks' has passed.
16  *
17  */
18
19 /* To signal shutdown of the timer service, we use a local
20  * event which the timer thread listens to (and stopVirtTimer()
21  * signals.)
22  */
23 static HANDLE hStopEvent = INVALID_HANDLE_VALUE;
24 static HANDLE tickThread = INVALID_HANDLE_VALUE;
25
26 static TickProc tickProc = NULL;
27
28 /*
29  * Ticking is done by a separate thread which periodically
30  * wakes up to handle a tick.
31  *
32  * This is the portable way of providing a timer service under
33  * Win32; features like waitable timers or timer queues are only
34  * supported by a subset of the Win32 platforms (notably not
35  * under Win9x.)
36  *
37  */
38 static
39 unsigned
40 WINAPI
41 TimerProc(PVOID param)
42 {
43   int ms = (int)param;
44   DWORD waitRes;
45   
46   /* interpret a < 0 timeout period as 'instantaneous' */ 
47  if (ms < 0) ms = 0;
48
49   while (1) {
50     waitRes = WaitForSingleObject(hStopEvent, ms);
51     
52     switch (waitRes) {
53     case WAIT_OBJECT_0:
54       /* event has become signalled */
55       tickProc = NULL;
56       CloseHandle(hStopEvent);
57       return 0;
58     case WAIT_TIMEOUT:
59       /* tick */
60       tickProc(0);
61       break;
62     case WAIT_FAILED: {
63         DWORD dw = GetLastError();
64         fprintf(stderr, "TimerProc: wait failed -- error code: %lu\n", dw); fflush(stderr);
65         break; 
66     }
67     default:
68       fprintf(stderr, "TimerProc: unexpected result %lu\n", waitRes); fflush(stderr);
69       break;
70     }
71   }
72   return 0;
73 }
74
75
76 int
77 startTicker(nat ms, TickProc handle_tick)
78 {
79   unsigned threadId;
80   /* 'hStopEvent' is a manual-reset event that's signalled upon
81    * shutdown of timer service (=> timer thread.)
82    */
83   hStopEvent = CreateEvent ( NULL,
84                              TRUE,
85                              FALSE,
86                              NULL);
87   if (hStopEvent == INVALID_HANDLE_VALUE) {
88     return 0;
89   }
90   tickProc = handle_tick;
91   tickThread = (HANDLE)(long)_beginthreadex( NULL,
92                                0,
93                                TimerProc,
94                                (LPVOID)ms,
95                                0,
96                                &threadId);
97   return (tickThread != 0);
98 }
99
100 int
101 stopTicker(void)
102 {
103     // We must wait for the ticker thread to terminate, since if we
104     // are in a DLL that is about to be unloaded, the ticker thread
105     // cannot be allowed to return to a missing DLL.
106
107     if (hStopEvent != INVALID_HANDLE_VALUE && 
108         tickThread != INVALID_HANDLE_VALUE) {
109         DWORD exitCode;
110         SetEvent(hStopEvent);
111         while (1) {
112             WaitForSingleObject(tickThread, 20);
113             if (!GetExitCodeThread(tickThread, &exitCode)) {
114                 return 1;
115             }
116             if (exitCode != STILL_ACTIVE) {
117                 tickThread = INVALID_HANDLE_VALUE;
118                 CloseHandle(hStopEvent);
119                 return 0;
120             }
121             TerminateThread(tickThread, 0);
122         }
123     }
124     return 0;
125 }