In +RTS --info output, use YES rather than Yes
[ghc.git] / rts / RtsUtils.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2004
4 *
5 * General utility functions used in the RTS.
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10
11 #include "Rts.h"
12 #include "RtsAPI.h"
13 #include "RtsFlags.h"
14 #include "RtsUtils.h"
15 #include "Ticky.h"
16 #include "Schedule.h"
17
18 #ifdef HAVE_TIME_H
19 #include <time.h>
20 #endif
21
22 /* HACK: On Mac OS X 10.4 (at least), time.h doesn't declare ctime_r with
23 * _POSIX_C_SOURCE. If this is the case, we declare it ourselves.
24 */
25 #if HAVE_CTIME_R && !HAVE_DECL_CTIME_R
26 extern char *ctime_r(const time_t *, char *);
27 #endif
28
29 #ifdef HAVE_FCNTL_H
30 #include <fcntl.h>
31 #endif
32
33 #ifdef HAVE_GETTIMEOFDAY
34 #include <sys/time.h>
35 #endif
36
37 #include <stdlib.h>
38 #include <string.h>
39 #include <stdarg.h>
40 #include <stdio.h>
41
42 #ifdef HAVE_SIGNAL_H
43 #include <signal.h>
44 #endif
45
46 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
47 #include <pthread.h>
48 #endif
49
50
51 #if defined(_WIN32)
52 #include <windows.h>
53 #endif
54
55 /* -----------------------------------------------------------------------------
56 Debugging allocator
57 -------------------------------------------------------------------------- */
58
59 #if defined(DEBUG)
60
61 typedef struct Allocated_ {
62 void *addr;
63 size_t len;
64 struct Allocated_ *next;
65 } Allocated;
66
67 static Allocated *allocs = NULL;
68
69 #ifdef THREADED_RTS
70 static Mutex allocator_mutex;
71 #endif
72
73 void
74 initAllocator(void)
75 {
76 Allocated *a;
77 size_t alloc_size;
78
79 #ifdef THREADED_RTS
80 initMutex(&allocator_mutex);
81 #endif
82 alloc_size = sizeof(Allocated);
83 if ((a = (Allocated *) malloc(alloc_size)) == NULL) {
84 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
85 MallocFailHook((W_) alloc_size, "initialising debugging allocator");
86 stg_exit(EXIT_INTERNAL_ERROR);
87 }
88 a->addr = NULL;
89 a->len = 0;
90 a->next = NULL;
91 allocs = a;
92 }
93
94 void
95 shutdownAllocator(void)
96 {
97 Allocated *prev, *a;
98
99 if (allocs == NULL) {
100 barf("Allocator shutdown requested, but not initialised!");
101 }
102
103 #ifdef THREADED_RTS
104 closeMutex(&allocator_mutex);
105 #endif
106
107 prev = allocs;
108 while (1) {
109 a = prev->next;
110 free(prev);
111 if (a == NULL) return;
112 IF_DEBUG(sanity,
113 debugBelch("Warning: %p still allocated at shutdown\n",
114 a->addr);)
115 prev = a;
116 }
117 }
118
119 static void addAllocation(void *addr, size_t len) {
120 Allocated *a;
121 size_t alloc_size;
122
123 if (allocs != NULL) {
124 alloc_size = sizeof(Allocated);
125 if ((a = (Allocated *) malloc(alloc_size)) == NULL) {
126 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
127 MallocFailHook((W_) alloc_size,
128 "creating info for debugging allocator");
129 stg_exit(EXIT_INTERNAL_ERROR);
130 }
131 a->addr = addr;
132 a->len = len;
133 ACQUIRE_LOCK(&allocator_mutex);
134 a->next = allocs->next;
135 allocs->next = a;
136 RELEASE_LOCK(&allocator_mutex);
137 }
138 else {
139 /* This doesn't actually help as we haven't looked at the flags
140 * at the time that it matters (while running constructors) */
141 IF_DEBUG(sanity,
142 debugBelch("Ignoring allocation %p %zd as allocs is NULL\n",
143 addr, len);)
144 }
145 }
146
147 static void removeAllocation(void *addr, int overwrite_with_aa) {
148 Allocated *prev, *a;
149
150 if (addr == NULL) {
151 barf("Freeing NULL!");
152 }
153
154 if (allocs != NULL) {
155 ACQUIRE_LOCK(&allocator_mutex);
156 prev = allocs;
157 a = prev->next;
158 while (a != NULL) {
159 if (a->addr == addr) {
160 prev->next = a->next;
161 if (overwrite_with_aa) {
162 memset(addr, 0xaa, a->len);
163 }
164 free(a);
165 RELEASE_LOCK(&allocator_mutex);
166 return;
167 }
168 prev = a;
169 a = a->next;
170 }
171 /* We would like to barf here, but we can't as conc021
172 * allocates some stuff in a constructor which then gets freed
173 * during hs_exit */
174 /* barf("Freeing non-allocated memory at %p", addr); */
175 IF_DEBUG(sanity,
176 debugBelch("Warning: Freeing non-allocated memory at %p\n",
177 addr);)
178 RELEASE_LOCK(&allocator_mutex);
179 }
180 else {
181 IF_DEBUG(sanity,
182 debugBelch("Ignoring free of %p as allocs is NULL\n",
183 addr);)
184 }
185 }
186 #endif
187
188 /* -----------------------------------------------------------------------------
189 Result-checking malloc wrappers.
190 -------------------------------------------------------------------------- */
191
192 void *
193 stgMallocBytes (int n, char *msg)
194 {
195 char *space;
196 size_t n2;
197
198 n2 = (size_t) n;
199 if ((space = (char *) malloc(n2)) == NULL) {
200 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
201 MallocFailHook((W_) n, msg); /*msg*/
202 stg_exit(EXIT_INTERNAL_ERROR);
203 }
204 #if defined(DEBUG)
205 addAllocation(space, n2);
206 #endif
207 return space;
208 }
209
210 void *
211 stgReallocBytes (void *p, int n, char *msg)
212 {
213 char *space;
214 size_t n2;
215
216 n2 = (size_t) n;
217 if ((space = (char *) realloc(p, (size_t) n2)) == NULL) {
218 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
219 MallocFailHook((W_) n, msg); /*msg*/
220 stg_exit(EXIT_INTERNAL_ERROR);
221 }
222 #if defined(DEBUG)
223 removeAllocation(p, 0);
224 addAllocation(space, n2);
225 #endif
226 return space;
227 }
228
229 void *
230 stgCallocBytes (int n, int m, char *msg)
231 {
232 char *space;
233
234 if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
235 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
236 MallocFailHook((W_) n*m, msg); /*msg*/
237 stg_exit(EXIT_INTERNAL_ERROR);
238 }
239 #if defined(DEBUG)
240 addAllocation(space, (size_t) n * (size_t) m);
241 #endif
242 return space;
243 }
244
245 /* To simplify changing the underlying allocator used
246 * by stgMallocBytes(), provide stgFree() as well.
247 */
248 void
249 stgFree(void* p)
250 {
251 #if defined(DEBUG)
252 removeAllocation(p, 1);
253 #endif
254 free(p);
255 }
256
257 /* -----------------------------------------------------------------------------
258 Stack overflow
259
260 Not sure if this belongs here.
261 -------------------------------------------------------------------------- */
262
263 void
264 stackOverflow(void)
265 {
266 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
267
268 #if defined(TICKY_TICKY)
269 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
270 #endif
271 }
272
273 void
274 heapOverflow(void)
275 {
276 if (!heap_overflow)
277 {
278 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
279 OutOfHeapHook(0/*unknown request size*/,
280 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
281
282 heap_overflow = rtsTrue;
283 }
284 }
285
286 /* -----------------------------------------------------------------------------
287 Out-of-line strlen.
288
289 Used in addr2Integer because the C compiler on x86 chokes on
290 strlen, trying to inline it with not enough registers available.
291 -------------------------------------------------------------------------- */
292
293 nat stg_strlen(char *s)
294 {
295 char *p = s;
296
297 while (*p) p++;
298 return p-s;
299 }
300
301
302 /* -----------------------------------------------------------------------------
303 genSym stuff, used by GHC itself for its splitting unique supply.
304
305 ToDo: put this somewhere sensible.
306 ------------------------------------------------------------------------- */
307
308 static HsInt __GenSymCounter = 0;
309
310 HsInt
311 genSymZh(void)
312 {
313 return(__GenSymCounter++);
314 }
315 HsInt
316 resetGenSymZh(void) /* it's your funeral */
317 {
318 __GenSymCounter=0;
319 return(__GenSymCounter);
320 }
321
322 /* -----------------------------------------------------------------------------
323 Get the current time as a string. Used in profiling reports.
324 -------------------------------------------------------------------------- */
325
326 char *
327 time_str(void)
328 {
329 static time_t now = 0;
330 static char nowstr[26];
331
332 if (now == 0) {
333 time(&now);
334 #if HAVE_CTIME_R
335 ctime_r(&now, nowstr);
336 #else
337 strcpy(nowstr, ctime(&now));
338 #endif
339 memmove(nowstr+16,nowstr+19,7);
340 nowstr[21] = '\0'; // removes the \n
341 }
342 return nowstr;
343 }
344
345 /* -----------------------------------------------------------------------------
346 * Reset a file handle to blocking mode. We do this for the standard
347 * file descriptors before exiting, because the shell doesn't always
348 * clean up for us.
349 * -------------------------------------------------------------------------- */
350
351 #if !defined(mingw32_HOST_OS)
352 void
353 resetNonBlockingFd(int fd)
354 {
355 long fd_flags;
356
357 /* clear the non-blocking flag on this file descriptor */
358 fd_flags = fcntl(fd, F_GETFL);
359 if (fd_flags & O_NONBLOCK) {
360 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
361 }
362 }
363
364 void
365 setNonBlockingFd(int fd)
366 {
367 long fd_flags;
368
369 /* clear the non-blocking flag on this file descriptor */
370 fd_flags = fcntl(fd, F_GETFL);
371 if (!(fd_flags & O_NONBLOCK)) {
372 fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
373 }
374 }
375 #else
376 /* Stub defns -- async / non-blocking IO is not done
377 * via O_NONBLOCK and select() under Win32.
378 */
379 void resetNonBlockingFd(int fd STG_UNUSED) {}
380 void setNonBlockingFd(int fd STG_UNUSED) {}
381 #endif
382
383 #ifdef PAR
384 static ullong startTime = 0;
385
386 /* used in a parallel setup */
387 ullong
388 msTime(void)
389 {
390 # if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
391 struct timespec tv;
392
393 if (getclock(TIMEOFDAY, &tv) != 0) {
394 fflush(stdout);
395 fprintf(stderr, "Clock failed\n");
396 stg_exit(EXIT_FAILURE);
397 }
398 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
399 # elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
400 struct timeval tv;
401
402 if (gettimeofday(&tv, NULL) != 0) {
403 fflush(stdout);
404 fprintf(stderr, "Clock failed\n");
405 stg_exit(EXIT_FAILURE);
406 }
407 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
408 # else
409 time_t t;
410 if ((t = time(NULL)) == (time_t) -1) {
411 fflush(stdout);
412 fprintf(stderr, "Clock failed\n");
413 stg_exit(EXIT_FAILURE);
414 }
415 return t * LL(1000) - startTime;
416 # endif
417 }
418 #endif /* PAR */
419
420 /* -----------------------------------------------------------------------------
421 Print large numbers, with punctuation.
422 -------------------------------------------------------------------------- */
423
424 char *
425 ullong_format_string(ullong x, char *s, rtsBool with_commas)
426 {
427 if (x < (ullong)1000)
428 sprintf(s, "%lu", (lnat)x);
429 else if (x < (ullong)1000000)
430 sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
431 (lnat)((x)/(ullong)1000),
432 (lnat)((x)%(ullong)1000));
433 else if (x < (ullong)1000000000)
434 sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu",
435 (lnat)((x)/(ullong)1000000),
436 (lnat)((x)/(ullong)1000%(ullong)1000),
437 (lnat)((x)%(ullong)1000));
438 else
439 sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
440 (lnat)((x)/(ullong)1000000000),
441 (lnat)((x)/(ullong)1000000%(ullong)1000),
442 (lnat)((x)/(ullong)1000%(ullong)1000),
443 (lnat)((x)%(ullong)1000));
444 return s;
445 }
446
447
448 // Can be used as a breakpoint to set on every heap check failure.
449 #ifdef DEBUG
450 void
451 heapCheckFail( void )
452 {
453 }
454 #endif
455
456 /*
457 * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
458 * pthreads (and possibly others). When linking with -lpthreads, we
459 * have to use pthread_kill to send blockable signals. So use that
460 * when we have a threaded rts. So System.Posix.Signals will call
461 * genericRaise(), rather than raise(3).
462 */
463 int genericRaise(int sig) {
464 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
465 return pthread_kill(pthread_self(), sig);
466 #else
467 return raise(sig);
468 #endif
469 }
470
471 static void mkRtsInfoPair(char *key, char *val) {
472 /* XXX should check for "s, \s etc in key and val */
473 printf(" ,(\"%s\", \"%s\")\n", key, val);
474 }
475
476 /* This little bit of magic allows us to say TOSTRING(SYM) and get
477 * "5" if SYM is 5 */
478 #define TOSTRING2(x) #x
479 #define TOSTRING(x) TOSTRING2(x)
480
481 void printRtsInfo(void) {
482 /* The first entry is just a hack to make it easy to get the
483 * commas right */
484 printf(" [(\"GHC RTS\", \"YES\")\n");
485 mkRtsInfoPair("GHC version", ProjectVersion);
486 mkRtsInfoPair("RTS way", RtsWay);
487 mkRtsInfoPair("Host platform", HostPlatform);
488 mkRtsInfoPair("Host architecture", HostArch);
489 mkRtsInfoPair("Host OS", HostOS);
490 mkRtsInfoPair("Host vendor", HostVendor);
491 mkRtsInfoPair("Build platform", BuildPlatform);
492 mkRtsInfoPair("Build architecture", BuildArch);
493 mkRtsInfoPair("Build OS", BuildOS);
494 mkRtsInfoPair("Build vendor", BuildVendor);
495 mkRtsInfoPair("Target platform", TargetPlatform);
496 mkRtsInfoPair("Target architecture", TargetArch);
497 mkRtsInfoPair("Target OS", TargetOS);
498 mkRtsInfoPair("Target vendor", TargetVendor);
499 mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS));
500 mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
501 mkRtsInfoPair("Tables next to code", GhcEnableTablesNextToCode);
502 printf(" ]\n");
503 }
504