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