rts/posix/Itimer.c: Handle EINTR when reading timerfd
[ghc.git] / rts / win32 / Ticker.c
1 /*
2 * RTS periodic timers.
3 *
4 */
5
6 #include "Rts.h"
7 #include "Ticker.h"
8 #include <windows.h>
9 #include <stdio.h>
10 #include <process.h>
11
12 static TickProc tick_proc = NULL;
13 static HANDLE timer_queue = NULL;
14 static HANDLE timer = NULL;
15 static Time tick_interval = 0;
16
17 static VOID CALLBACK tick_callback(
18 PVOID lpParameter STG_UNUSED,
19 BOOLEAN TimerOrWaitFired STG_UNUSED
20 )
21 {
22 tick_proc(0);
23 }
24
25 // We use the CreateTimerQueue() API which has been around since
26 // Windows 2000. Apparently it gives bad results before Windows 7,
27 // though: http://www.virtualdub.org/blog/pivot/entry.php?id=272
28 //
29 // Even with the improvements in Windows 7, this timer isn't going to
30 // be very useful for profiling with a max usable resolution of
31 // 15ms. Unfortunately we don't have anything better.
32
33 void
34 initTicker (Time interval, TickProc handle_tick)
35 {
36 tick_interval = interval;
37 tick_proc = handle_tick;
38
39 timer_queue = CreateTimerQueue();
40 if (timer_queue == NULL) {
41 sysErrorBelch("CreateTimerQueue");
42 stg_exit(EXIT_FAILURE);
43 }
44 }
45
46 void
47 startTicker(void)
48 {
49 BOOL r;
50
51 r = CreateTimerQueueTimer(&timer,
52 timer_queue,
53 tick_callback,
54 0,
55 0,
56 TimeToUS(tick_interval) / 1000, // ms
57 WT_EXECUTEINTIMERTHREAD);
58 if (r == 0) {
59 sysErrorBelch("CreateTimerQueueTimer");
60 stg_exit(EXIT_FAILURE);
61 }
62 }
63
64 void
65 stopTicker(void)
66 {
67 if (timer_queue != NULL && timer != NULL) {
68 DeleteTimerQueueTimer(timer_queue, timer, NULL);
69 timer = NULL;
70 }
71 }
72
73 void
74 exitTicker (rtsBool wait)
75 {
76 if (timer_queue != NULL) {
77 DeleteTimerQueueEx(timer_queue, wait ? INVALID_HANDLE_VALUE : NULL);
78 timer_queue = NULL;
79 }
80 }