X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsUtils.c;h=ce1c0a2493a67077bb234d71cbede8a71cd02237;hb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;hp=3ff2f4156e6ee32e97b0dccd84fa6cdf183d9278;hpb=ab9711d8af0e7eb8ae677079f3cc9d9a1907cdec;p=ghc-hetmet.git diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c index 3ff2f41..ce1c0a2 100644 --- a/ghc/rts/RtsUtils.c +++ b/ghc/rts/RtsUtils.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsUtils.c,v 1.25 2002/05/18 05:28:14 ken Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * General utility functions used in the RTS. * @@ -11,11 +10,8 @@ /* #include "PosixSource.h" */ #include "Rts.h" -#include "RtsTypes.h" #include "RtsAPI.h" #include "RtsFlags.h" -#include "Hooks.h" -#include "Main.h" #include "RtsUtils.h" #include "Ticky.h" @@ -31,51 +27,22 @@ #include #endif +#include +#include #include +#include -/* variable-argument error function. */ - -void barf(char *s, ...) -{ - va_list ap; - va_start(ap,s); - /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ - if (prog_argv != NULL && prog_argv[0] != NULL) { - fprintf(stderr, "%s: fatal error: ", prog_argv[0]); - } else { - fprintf(stderr, "fatal error: "); - } - vfprintf(stderr, s, ap); - fprintf(stderr, "\n"); - fflush(stderr); - stg_exit(EXIT_INTERNAL_ERROR); - va_end(ap); -} - -void prog_belch(char *s, ...) -{ - va_list ap; - va_start(ap,s); - /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ - if (prog_argv != NULL && prog_argv[0] != NULL) { - fprintf(stderr, "%s: ", prog_argv[0]); - } - vfprintf(stderr, s, ap); - fprintf(stderr, "\n"); - va_end(ap); -} +#ifdef HAVE_SIGNAL_H +#include +#endif -void belch(char *s, ...) -{ - va_list ap; - va_start(ap,s); - /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ - vfprintf(stderr, s, ap); - fprintf(stderr, "\n"); - va_end(ap); -} +#if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H) +#include +#endif -/* result-checking malloc wrappers. */ +/* ----------------------------------------------------------------------------- + Result-checking malloc wrappers. + -------------------------------------------------------------------------- */ void * stgMallocBytes (int n, char *msg) @@ -104,18 +71,6 @@ stgReallocBytes (void *p, int n, char *msg) } void * -stgMallocWords (int n, char *msg) -{ - return(stgMallocBytes(n * sizeof(W_), msg)); -} - -void * -stgReallocWords (void *p, int n, char *msg) -{ - return(stgReallocBytes(p, n * sizeof(W_), msg)); -} - -void * stgCallocBytes (int n, int m, char *msg) { int i; @@ -125,6 +80,15 @@ stgCallocBytes (int n, int m, char *msg) return p; } +/* To simplify changing the underlying allocator used + * by stgMallocBytes(), provide stgFree() as well. + */ +void +stgFree(void* p) +{ + free(p); +} + void _stgAssert (char *filename, unsigned int linenum) { @@ -186,7 +150,7 @@ nat stg_strlen(char *s) ToDo: put this somewhere sensible. ------------------------------------------------------------------------- */ -I_ __GenSymCounter = 0; +static I_ __GenSymCounter = 0; I_ genSymZh(void) @@ -227,7 +191,7 @@ time_str(void) * clean up for us. * -------------------------------------------------------------------------- */ -#if !defined(mingw32_TARGET_OS) +#if !defined(mingw32_HOST_OS) void resetNonBlockingFd(int fd) { @@ -247,21 +211,26 @@ setNonBlockingFd(int fd) /* clear the non-blocking flag on this file descriptor */ fd_flags = fcntl(fd, F_GETFL); - fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK); + if (!(fd_flags & O_NONBLOCK)) { + fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK); + } } #else -/* Don't support non-blocking FDs (yet) on mingw */ +/* Stub defns -- async / non-blocking IO is not done + * via O_NONBLOCK and select() under Win32. + */ void resetNonBlockingFd(int fd STG_UNUSED) {} void setNonBlockingFd(int fd STG_UNUSED) {} #endif +#ifdef PAR static ullong startTime = 0; /* used in a parallel setup */ ullong msTime(void) { -# if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH) && !defined(hppa1_1_TARGET_ARCH) +# if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH) struct timespec tv; if (getclock(TIMEOFDAY, &tv) != 0) { @@ -270,7 +239,7 @@ msTime(void) stg_exit(EXIT_FAILURE); } return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime; -# elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH) +# elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH) struct timeval tv; if (gettimeofday(&tv, NULL) != 0) { @@ -289,6 +258,7 @@ msTime(void) return t * LL(1000) - startTime; # endif } +#endif /* PAR */ /* ----------------------------------------------------------------------------- Print large numbers, with punctuation. @@ -298,21 +268,45 @@ char * ullong_format_string(ullong x, char *s, rtsBool with_commas) { if (x < (ullong)1000) - sprintf(s, "%d", (nat)x); + sprintf(s, "%lu", (lnat)x); else if (x < (ullong)1000000) - sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld", - (nat)((x)/(ullong)1000), - (nat)((x)%(ullong)1000)); + sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu", + (lnat)((x)/(ullong)1000), + (lnat)((x)%(ullong)1000)); else if (x < (ullong)1000000000) - sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld", - (nat)((x)/(ullong)1000000), - (nat)((x)/(ullong)1000%(ullong)1000), - (nat)((x)%(ullong)1000)); + sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu", + (lnat)((x)/(ullong)1000000), + (lnat)((x)/(ullong)1000%(ullong)1000), + (lnat)((x)%(ullong)1000)); else - sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld", - (nat)((x)/(ullong)1000000000), - (nat)((x)/(ullong)1000000%(ullong)1000), - (nat)((x)/(ullong)1000%(ullong)1000), - (nat)((x)%(ullong)1000)); + sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu", + (lnat)((x)/(ullong)1000000000), + (lnat)((x)/(ullong)1000000%(ullong)1000), + (lnat)((x)/(ullong)1000%(ullong)1000), + (lnat)((x)%(ullong)1000)); return s; } + + +// Can be used as a breakpoint to set on every heap check failure. +#ifdef DEBUG +void +heapCheckFail( void ) +{ +} +#endif + +/* + * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD + * pthreads (and possibly others). When linking with -lpthreads, we + * have to use pthread_kill to send blockable signals. So use that + * when we have a threaded rts. So System.Posix.Signals will call + * genericRaise(), rather than raise(3). + */ +int genericRaise(int sig) { +#if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS)) + return pthread_kill(pthread_self(), sig); +#else + return raise(sig); +#endif +}