1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 1995-1999
*
* Interval timer for profiling and pre-emptive scheduling.
*
* ---------------------------------------------------------------------------*/
/*
* The interval timer is used for profiling and for context switching in the
* threaded build. Though POSIX 1003.1b includes a standard interface for
* such things, no one really seems to be implementing them yet. Even
* Solaris 2.3 only seems to provide support for @CLOCK_REAL@, whereas we're
* keen on getting access to @CLOCK_VIRTUAL@.
*
* Hence, we use the old-fashioned @setitimer@ that just about everyone seems
* to support. So much for standards.
*/
#include "Rts.h"
#include "RtsFlags.h"
#include "Timer.h"
#include "Ticker.h"
#include "posix/Itimer.h"
#include "Proftimer.h"
#include "Schedule.h"
#include "posix/Select.h"
/* As recommended in the autoconf manual */
# ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
# else
# ifdef HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
# endif
#ifdef HAVE_SIGNAL_H
# include <signal.h>
#endif
/* Major bogosity:
*
* In the threaded RTS, we can't set the virtual timer because the
* thread which has the virtual timer might be sitting waiting for a
* capability, and the virtual timer only ticks in CPU time.
*
* So, possible solutions:
*
* (1) tick in realtime. Not very good, because this ticker is used for
* profiling, and this will give us unreliable time profiling
* results. Furthermore, this requires picking a single OS thread
* to be the timekeeper, which is a bad idea because the thread in
* question might just be making a temporary call into Haskell land.
*
* (2) save/restore the virtual timer around excursions into STG land.
* Sounds great, but I tried it and the resolution of the virtual timer
* isn't good enough (on Linux) - most of our excursions fall
* within the timer's resolution and we never make any progress.
*
* (3) have a virtual timer in every OS thread. Might be reasonable,
* because most of the time there is only ever one of these
* threads running, so it approximates a single virtual timer.
* But still quite bogus (and I got crashes when I tried this).
*
* For now, we're using (1), but this needs a better solution. --SDM
*/
#ifdef THREADED_RTS
#define ITIMER_FLAVOUR ITIMER_REAL
#define ITIMER_SIGNAL SIGALRM
#else
#define ITIMER_FLAVOUR ITIMER_VIRTUAL
#define ITIMER_SIGNAL SIGVTALRM
#endif
static
int
install_vtalrm_handler(TickProc handle_tick)
{
struct sigaction action;
action.sa_handler = handle_tick;
sigemptyset(&action.sa_mask);
#ifdef SA_RESTART
// specify SA_RESTART. One consequence if we don't do this is
// that readline gets confused by the -threaded RTS. It seems
// that if a SIGALRM handler is installed without SA_RESTART,
// readline installs its own SIGALRM signal handler (see
// readline's signals.c), and this somehow causes readline to go
// wrong when the input exceeds a single line (try it).
action.sa_flags = SA_RESTART;
#else
action.sa_flags = 0;
#endif
return sigaction(ITIMER_SIGNAL, &action, NULL);
}
int
startTicker(nat ms, TickProc handle_tick)
{
# ifndef HAVE_SETITIMER
/* debugBelch("No virtual timer on this system\n"); */
return -1;
# else
struct itimerval it;
install_vtalrm_handler(handle_tick);
#if !defined(THREADED_RTS)
timestamp = getourtimeofday();
#endif
it.it_value.tv_sec = ms / 1000;
it.it_value.tv_usec = 1000 * (ms - (1000 * it.it_value.tv_sec));
it.it_interval = it.it_value;
return (setitimer(ITIMER_FLAVOUR, &it, NULL));
# endif
}
int
stopTicker()
{
# ifndef HAVE_SETITIMER
/* debugBelch("No virtual timer on this system\n"); */
return -1;
# else
struct itimerval it;
it.it_value.tv_sec = 0;
it.it_value.tv_usec = 0;
it.it_interval = it.it_value;
return (setitimer(ITIMER_FLAVOUR, &it, NULL));
# endif
}
# if 0
/* This is a potential POSIX version */
int
startTicker(nat ms)
{
struct sigevent se;
struct itimerspec it;
timer_t tid;
#if !defined(THREADED_RTS)
timestamp = getourtimeofday();
#endif
se.sigev_notify = SIGEV_SIGNAL;
se.sigev_signo = ITIMER_SIGNAL;
se.sigev_value.sival_int = ITIMER_SIGNAL;
if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
barf("can't create virtual timer");
}
it.it_value.tv_sec = ms / 1000;
it.it_value.tv_nsec = 1000000 * (ms - 1000 * it.it_value.tv_sec);
it.it_interval = it.it_value;
return timer_settime(tid, TIMER_RELTIME, &it, NULL);
}
int
stopTicker()
{
struct sigevent se;
struct itimerspec it;
timer_t tid;
#if !defined(THREADED_RTS)
timestamp = getourtimeofday();
#endif
se.sigev_notify = SIGEV_SIGNAL;
se.sigev_signo = ITIMER_SIGNAL;
se.sigev_value.sival_int = ITIMER_SIGNAL;
if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
barf("can't create virtual timer");
}
it.it_value.tv_sec = 0;
it.it_value.tv_nsec = 0;
it.it_interval = it.it_value;
return timer_settime(tid, TIMER_RELTIME, &it, NULL);
}
# endif
#if 0
/* Currently unused */
void
block_vtalrm_signal(void)
{
sigset_t signals;
sigemptyset(&signals);
sigaddset(&signals, ITIMER_SIGNAL);
(void) sigprocmask(SIG_BLOCK, &signals, NULL);
}
void
unblock_vtalrm_signal(void)
{
sigset_t signals;
sigemptyset(&signals);
sigaddset(&signals, ITIMER_SIGNAL);
(void) sigprocmask(SIG_UNBLOCK, &signals, NULL);
}
#endif
/* gettimeofday() takes around 1us on our 500MHz PIII. Since we're
* only calling it 50 times/s, it shouldn't have any great impact.
*/
lnat
getourtimeofday(void)
{
struct timeval tv;
gettimeofday(&tv, (struct timezone *) NULL);
// cast to lnat because nat may be 64 bit when int is only 32 bit
return ((lnat)tv.tv_sec * TICK_FREQUENCY +
(lnat)tv.tv_usec * TICK_FREQUENCY / 1000000);
}
|
