X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsUtils.c;h=8f6579cb740a62a9155fe99e4a5317b0998c1c16;hb=7bd8a0491055e7ca5709109400459556e870250a;hp=0e302a79aaa9e0cac6cc6ba182f3dc16b3d0eada;hpb=ab01dd3748fb245fe3feacafd87f91abd1822409;p=ghc-hetmet.git diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c index 0e302a7..8f6579c 100644 --- a/ghc/rts/RtsUtils.c +++ b/ghc/rts/RtsUtils.c @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsUtils.c,v 1.23 2001/10/31 10:30:29 simonmar Exp $ + * $Id: RtsUtils.c,v 1.34 2003/04/01 15:40:27 sof Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2002 * * General utility functions used in the RTS. * @@ -15,7 +15,6 @@ #include "RtsAPI.h" #include "RtsFlags.h" #include "Hooks.h" -#include "Main.h" #include "RtsUtils.h" #include "Ticky.h" @@ -31,27 +30,33 @@ #include #endif +#include +#include #include -/* variable-argument error function. */ +/* variable-argument internal error function. */ -void barf(char *s, ...) +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]); + fprintf(stderr, "%s: internal error: ", prog_argv[0]); } else { - fprintf(stderr, "fatal error: "); + fprintf(stderr, "internal error: "); } vfprintf(stderr, s, ap); fprintf(stderr, "\n"); + fprintf(stderr, " Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n or http://www.sourceforge.net/projects/ghc/\n"); fflush(stderr); stg_exit(EXIT_INTERNAL_ERROR); + va_end(ap); } -void prog_belch(char *s, ...) +void +prog_belch(char *s, ...) { va_list ap; va_start(ap,s); @@ -61,15 +66,18 @@ void prog_belch(char *s, ...) } vfprintf(stderr, s, ap); fprintf(stderr, "\n"); + va_end(ap); } -void belch(char *s, ...) +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); } /* result-checking malloc wrappers. */ @@ -101,18 +109,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; @@ -122,6 +118,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) { @@ -183,7 +188,7 @@ nat stg_strlen(char *s) ToDo: put this somewhere sensible. ------------------------------------------------------------------------- */ -I_ __GenSymCounter = 0; +static I_ __GenSymCounter = 0; I_ genSymZh(void) @@ -224,18 +229,17 @@ time_str(void) * clean up for us. * -------------------------------------------------------------------------- */ +#if !defined(mingw32_TARGET_OS) void resetNonBlockingFd(int fd) { long fd_flags; -#if !defined(mingw32_TARGET_OS) /* 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); } -#endif } void @@ -243,13 +247,19 @@ setNonBlockingFd(int fd) { long fd_flags; -#if !defined(mingw32_TARGET_OS) /* clear the non-blocking flag on this file descriptor */ fd_flags = fcntl(fd, F_GETFL); fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK); -#endif } +#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 */ @@ -284,6 +294,7 @@ msTime(void) return t * LL(1000) - startTime; # endif } +#endif /* PAR */ /* ----------------------------------------------------------------------------- Print large numbers, with punctuation. @@ -293,21 +304,31 @@ 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 +