X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsUtils.c;h=3e7e225dda3314468ed3deccab22b7d6545e2437;hb=be44e76beb4d5c1dcdc57cee65220d479117cb21;hp=081c205cb603264c064487ab65bdbe1092fcfd44;hpb=63c93617ad4000a878702aa5c6eaa3825f0a103d;p=ghc-hetmet.git diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c index 081c205..3e7e225 100644 --- a/ghc/rts/RtsUtils.c +++ b/ghc/rts/RtsUtils.c @@ -1,17 +1,17 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsUtils.c,v 1.7 1999/03/02 20:05:41 sof Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * General utility functions used in the RTS. * * ---------------------------------------------------------------------------*/ +/* gettimeofday isn't POSIX */ +/* #include "PosixSource.h" */ + #include "Rts.h" #include "RtsAPI.h" #include "RtsFlags.h" -#include "Hooks.h" -#include "Main.h" #include "RtsUtils.h" #include "Ticky.h" @@ -19,36 +19,48 @@ #include #endif +#ifdef HAVE_FCNTL_H +#include +#endif + +#ifdef HAVE_GETTIMEOFDAY +#include +#endif + +#include +#include #include +#include -/* variable-argument error function. */ +#ifdef HAVE_SIGNAL_H +#include +#endif -void barf(char *s, ...) -{ - va_list ap; - va_start(ap,s); - fflush(stdout); - 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_FAILURE); -} +#if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H) +#include +#endif -void belch(char *s, ...) -{ - va_list ap; - va_start(ap,s); - fflush(stdout); - vfprintf(stderr, s, ap); - fprintf(stderr, "\n"); -} +#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS) +#include +#include +#include + +/* no C99 header stdint.h on OpenBSD? */ +#if defined(openbsd_HOST_OS) +typedef unsigned long my_uintptr_t; +#else +#include +typedef uintptr_t my_uintptr_t; +#endif +#endif + +#if defined(_WIN32) +#include +#endif -/* result-checking malloc wrappers. */ +/* ----------------------------------------------------------------------------- + Result-checking malloc wrappers. + -------------------------------------------------------------------------- */ void * stgMallocBytes (int n, char *msg) @@ -56,9 +68,9 @@ stgMallocBytes (int n, char *msg) char *space; if ((space = (char *) malloc((size_t) n)) == NULL) { - fflush(stdout); - MallocFailHook((W_) n, msg); /*msg*/ - stg_exit(EXIT_FAILURE); + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + MallocFailHook((W_) n, msg); /*msg*/ + stg_exit(EXIT_INTERNAL_ERROR); } return space; } @@ -69,40 +81,33 @@ stgReallocBytes (void *p, int n, char *msg) char *space; if ((space = (char *) realloc(p, (size_t) n)) == NULL) { - fflush(stdout); - MallocFailHook((W_) n, msg); /*msg*/ - exit(EXIT_FAILURE); + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + MallocFailHook((W_) n, msg); /*msg*/ + stg_exit(EXIT_INTERNAL_ERROR); } return space; } void * -stgMallocWords (int n, char *msg) +stgCallocBytes (int n, int m, char *msg) { - return(stgMallocBytes(n * sizeof(W_), msg)); -} - -void * -stgReallocWords (void *p, int n, char *msg) -{ - return(stgReallocBytes(p, n * sizeof(W_), msg)); -} + char *space; -void -_stgAssert (char *filename, nat linenum) -{ - fflush(stdout); - fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum); - abort(); + if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) { + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + MallocFailHook((W_) n*m, msg); /*msg*/ + stg_exit(EXIT_INTERNAL_ERROR); + } + return space; } -StgStablePtr errorHandler = -1; /* -1 indicates no handler installed */ - +/* To simplify changing the underlying allocator used + * by stgMallocBytes(), provide stgFree() as well. + */ void -raiseError( StgStablePtr handler STG_UNUSED ) +stgFree(void* p) { - shutdownHaskell(); - stg_exit(EXIT_FAILURE); + free(p); } /* ----------------------------------------------------------------------------- @@ -112,30 +117,27 @@ raiseError( StgStablePtr handler STG_UNUSED ) -------------------------------------------------------------------------- */ void -stackOverflow(nat max_stack_size) +stackOverflow(void) { - fflush(stdout); - StackOverflowHook(max_stack_size * sizeof(W_)); /*msg*/ + StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_)); #if defined(TICKY_TICKY) - if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo(); + if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo(); #endif - - stg_exit(EXIT_FAILURE); } void heapOverflow(void) { - fflush(stdout); - OutOfHeapHook(0/*unknown request size*/, - RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE); - + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + OutOfHeapHook(0/*unknown request size*/, + RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE); + #if defined(TICKY_TICKY) - if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo(); + if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo(); #endif - stg_exit(EXIT_FAILURE); + stg_exit(EXIT_HEAPOVERFLOW); } /* ----------------------------------------------------------------------------- @@ -160,7 +162,7 @@ nat stg_strlen(char *s) ToDo: put this somewhere sensible. ------------------------------------------------------------------------- */ -I_ __GenSymCounter = 0; +static I_ __GenSymCounter = 0; I_ genSymZh(void) @@ -178,7 +180,7 @@ resetGenSymZh(void) /* it's your funeral */ Get the current time as a string. Used in profiling reports. -------------------------------------------------------------------------- */ -#if defined(PROFILING) || defined(DEBUG) +#if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN) char * time_str(void) { @@ -187,15 +189,94 @@ time_str(void) if (now == 0) { time(&now); +#if HAVE_CTIME_R + ctime_r(&now, nowstr); +#else strcpy(nowstr, ctime(&now)); - strcpy(nowstr+16,nowstr+19); - nowstr[21] = '\0'; +#endif + memmove(nowstr+16,nowstr+19,7); + nowstr[21] = '\0'; // removes the \n } return nowstr; } #endif /* ----------------------------------------------------------------------------- + * Reset a file handle to blocking mode. We do this for the standard + * file descriptors before exiting, because the shell doesn't always + * clean up for us. + * -------------------------------------------------------------------------- */ + +#if !defined(mingw32_HOST_OS) +void +resetNonBlockingFd(int fd) +{ + long fd_flags; + + /* clear the non-blocking flag on this file descriptor */ + fd_flags = fcntl(fd, F_GETFL); + if (fd_flags & O_NONBLOCK) { + fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK); + } +} + +void +setNonBlockingFd(int fd) +{ + long fd_flags; + + /* clear the non-blocking flag on this file descriptor */ + fd_flags = fcntl(fd, F_GETFL); + if (!(fd_flags & O_NONBLOCK)) { + fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK); + } +} +#else +/* 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_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH) + struct timespec tv; + + if (getclock(TIMEOFDAY, &tv) != 0) { + fflush(stdout); + fprintf(stderr, "Clock failed\n"); + stg_exit(EXIT_FAILURE); + } + return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime; +# elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH) + struct timeval tv; + + if (gettimeofday(&tv, NULL) != 0) { + fflush(stdout); + fprintf(stderr, "Clock failed\n"); + stg_exit(EXIT_FAILURE); + } + return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime; +# else + time_t t; + if ((t = time(NULL)) == (time_t) -1) { + fflush(stdout); + fprintf(stderr, "Clock failed\n"); + stg_exit(EXIT_FAILURE); + } + return t * LL(1000) - startTime; +# endif +} +#endif /* PAR */ + +/* ----------------------------------------------------------------------------- Print large numbers, with punctuation. -------------------------------------------------------------------------- */ @@ -203,21 +284,84 @@ 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 +} + +/* ----------------------------------------------------------------------------- + Allocating executable memory + -------------------------------------------------------------------------- */ + +/* Heavily arch-specific, I'm afraid.. */ + +/* + * Allocate len bytes which are readable, writable, and executable. + * + * ToDo: If this turns out to be a performance bottleneck, one could + * e.g. cache the last VirtualProtect/mprotect-ed region and do + * nothing in case of a cache hit. + */ +void* +stgMallocBytesRWX(int len) +{ + void *addr = stgMallocBytes(len, "mallocBytesRWX"); +#if defined(i386_HOST_ARCH) && defined(_WIN32) + /* This could be necessary for processors which distinguish between READ and + EXECUTE memory accesses, e.g. Itaniums. */ + DWORD dwOldProtect = 0; + if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) { + barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n", + addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect); + } +#elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS) + /* malloced memory isn't executable by default on OpenBSD */ + my_uintptr_t pageSize = sysconf(_SC_PAGESIZE); + my_uintptr_t mask = ~(pageSize - 1); + my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr ) & mask; + my_uintptr_t startOfLastPage = ((my_uintptr_t)addr + len - 1) & mask; + my_uintptr_t size = startOfLastPage - startOfFirstPage + pageSize; + if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) { + barf("mallocBytesRWX: failed to protect 0x%p\n", addr); + } +#endif + return addr; +}