Fix and improve deriving for indexed data types
[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       hStopEvent = INVALID_HANDLE_VALUE;
58       return 0;
59     case WAIT_TIMEOUT:
60       /* tick */
61       tickProc(0);
62       break;
63     case WAIT_FAILED: {
64         DWORD dw = GetLastError();
65         fprintf(stderr, "TimerProc: wait failed -- error code: %lu\n", dw); fflush(stderr);
66         break; 
67     }
68     default:
69       fprintf(stderr, "TimerProc: unexpected result %lu\n", waitRes); fflush(stderr);
70       break;
71     }
72   }
73   return 0;
74 }
75
76
77 int
78 startTicker(nat ms, TickProc handle_tick)
79 {
80   unsigned threadId;
81   /* 'hStopEvent' is a manual-reset event that's signalled upon
82    * shutdown of timer service (=> timer thread.)
83    */
84   hStopEvent = CreateEvent ( NULL,
85                              TRUE,
86                              FALSE,
87                              NULL);
88   if (hStopEvent == INVALID_HANDLE_VALUE) {
89     return 0;
90   }
91   tickProc = handle_tick;
92   tickThread = (HANDLE)(long)_beginthreadex( NULL,
93                                0,
94                                TimerProc,
95                                (LPVOID)ms,
96                                0,
97                                &threadId);
98   return (tickThread != 0);
99 }
100
101 int
102 stopTicker(void)
103 {
104     // We must wait for the ticker thread to terminate, since if we
105     // are in a DLL that is about to be unloaded, the ticker thread
106     // cannot be allowed to return to a missing DLL.
107
108     if (hStopEvent != INVALID_HANDLE_VALUE && 
109         tickThread != INVALID_HANDLE_VALUE) {
110         DWORD exitCode;
111         SetEvent(hStopEvent);
112         while (1) {
113             WaitForSingleObject(tickThread, 20);
114             if (!GetExitCodeThread(tickThread, &exitCode)) {
115                 return 1;
116             }
117             if (exitCode != STILL_ACTIVE) {
118                 tickThread = INVALID_HANDLE_VALUE;
119                 if ( hStopEvent != INVALID_HANDLE_VALUE ) {
120                     CloseHandle(hStopEvent);
121                     hStopEvent = INVALID_HANDLE_VALUE;
122                 }
123                 return 0;
124             }
125             TerminateThread(tickThread, 0);
126         }
127     }
128     return 0;
129 }