ghc/rts/RtsUtils.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RtsUtils.c,v 1.35 2003/08/22 22:24:16 sof Exp $
   3  *
   4  * (c) The GHC Team, 1998-2002
   5  *
   6  * General utility functions used in the RTS.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 /* gettimeofday isn't POSIX */
  11 /* #include "PosixSource.h" */
  12
  13 #include "Rts.h"
  14 #include "RtsTypes.h"
  15 #include "RtsAPI.h"
  16 #include "RtsFlags.h"
  17 #include "Hooks.h"
  18 #include "RtsUtils.h"
  19 #include "Ticky.h"
  20
  21 #ifdef HAVE_TIME_H
  22 #include <time.h>
  23 #endif
  24
  25 #ifdef HAVE_FCNTL_H
  26 #include <fcntl.h>
  27 #endif
  28
  29 #ifdef HAVE_GETTIMEOFDAY
  30 #include <sys/time.h>
  31 #endif
  32
  33 #include <stdlib.h>
  34 #include <string.h>
  35 #include <stdarg.h>
  36
  37 /* variable-argument internal error function. */
  38
  39 void
  40 barf(char *s, ...)
  41 {
  42   va_list ap;
  43   va_start(ap,s);
  44   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  45   if (prog_argv != NULL && prog_name != NULL) {
  46     fprintf(stderr, "%s: internal error: ", prog_name);
  47   } else {
  48     fprintf(stderr, "internal error: ");
  49   }
  50   vfprintf(stderr, s, ap);
  51   fprintf(stderr, "\n");
  52   fprintf(stderr, "    Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n    or http://www.sourceforge.net/projects/ghc/\n");
  53   fflush(stderr);
  54   stg_exit(EXIT_INTERNAL_ERROR);
  55   va_end(ap);
  56 }
  57
  58 void
  59 prog_belch(char *s, ...)
  60 {
  61   va_list ap;
  62   va_start(ap,s);
  63   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  64   if (prog_argv != NULL && prog_name != NULL) {
  65     fprintf(stderr, "%s: ", prog_name);
  66   }
  67   vfprintf(stderr, s, ap);
  68   fprintf(stderr, "\n");
  69   va_end(ap);
  70 }
  71
  72 void
  73 belch(char *s, ...)
  74 {
  75   va_list ap;
  76   va_start(ap,s);
  77   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  78   vfprintf(stderr, s, ap);
  79   fprintf(stderr, "\n");
  80   va_end(ap);
  81 }
  82
  83 /* result-checking malloc wrappers. */
  84
  85 void *
  86 stgMallocBytes (int n, char *msg)
  87 {
  88     char *space;
  89
  90     if ((space = (char *) malloc((size_t) n)) == NULL) {
  91       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  92       MallocFailHook((W_) n, msg); /*msg*/
  93       stg_exit(EXIT_INTERNAL_ERROR);
  94     }
  95     return space;
  96 }
  97
  98 void *
  99 stgReallocBytes (void *p, int n, char *msg)
 100 {
 101     char *space;
 102
 103     if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
 104       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 105       MallocFailHook((W_) n, msg); /*msg*/
 106       stg_exit(EXIT_INTERNAL_ERROR);
 107     }
 108     return space;
 109 }
 110
 111 void *
 112 stgCallocBytes (int n, int m, char *msg)
 113 {
 114   int   i;
 115   int   sz = n * m;
 116   char* p  = stgMallocBytes(sz, msg);
 117   for (i = 0; i < sz; i++) p[i] = 0;
 118   return p;
 119 }
 120
 121 /* To simplify changing the underlying allocator used
 122  * by stgMallocBytes(), provide stgFree() as well.
 123  */
 124 void
 125 stgFree(void* p)
 126 {
 127   free(p);
 128 }
 129
 130 void
 131 _stgAssert (char *filename, unsigned int linenum)
 132 {
 133   fflush(stdout);
 134   fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
 135   fflush(stderr);
 136   abort();
 137 }
 138
 139 /* -----------------------------------------------------------------------------
 140    Stack overflow
 141
 142    Not sure if this belongs here.
 143    -------------------------------------------------------------------------- */
 144
 145 void
 146 stackOverflow(void)
 147 {
 148   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
 149
 150 #if defined(TICKY_TICKY)
 151   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 152 #endif
 153 }
 154
 155 void
 156 heapOverflow(void)
 157 {
 158   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 159   OutOfHeapHook(0/*unknown request size*/,
 160                 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 161
 162 #if defined(TICKY_TICKY)
 163   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 164 #endif
 165
 166   stg_exit(EXIT_HEAPOVERFLOW);
 167 }
 168
 169 /* -----------------------------------------------------------------------------
 170    Out-of-line strlen.
 171
 172    Used in addr2Integer because the C compiler on x86 chokes on
 173    strlen, trying to inline it with not enough registers available.
 174    -------------------------------------------------------------------------- */
 175
 176 nat stg_strlen(char *s)
 177 {
 178    char *p = s;
 179
 180    while (*p) p++;
 181    return p-s;
 182 }
 183
 184
 185 /* -----------------------------------------------------------------------------
 186    genSym stuff, used by GHC itself for its splitting unique supply.
 187
 188    ToDo: put this somewhere sensible.
 189    -------------------------------------------------------------------------  */
 190
 191 static I_ __GenSymCounter = 0;
 192
 193 I_
 194 genSymZh(void)
 195 {
 196     return(__GenSymCounter++);
 197 }
 198 I_
 199 resetGenSymZh(void) /* it's your funeral */
 200 {
 201     __GenSymCounter=0;
 202     return(__GenSymCounter);
 203 }
 204
 205 /* -----------------------------------------------------------------------------
 206    Get the current time as a string.  Used in profiling reports.
 207    -------------------------------------------------------------------------- */
 208
 209 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
 210 char *
 211 time_str(void)
 212 {
 213     static time_t now = 0;
 214     static char nowstr[26];
 215
 216     if (now == 0) {
 217         time(&now);
 218         strcpy(nowstr, ctime(&now));
 219         strcpy(nowstr+16,nowstr+19);
 220         nowstr[21] = '\0';
 221     }
 222     return nowstr;
 223 }
 224 #endif
 225
 226 /* -----------------------------------------------------------------------------
 227  * Reset a file handle to blocking mode.  We do this for the standard
 228  * file descriptors before exiting, because the shell doesn't always
 229  * clean up for us.
 230  * -------------------------------------------------------------------------- */
 231
 232 #if !defined(mingw32_TARGET_OS)
 233 void
 234 resetNonBlockingFd(int fd)
 235 {
 236   long fd_flags;
 237
 238   /* clear the non-blocking flag on this file descriptor */
 239   fd_flags = fcntl(fd, F_GETFL);
 240   if (fd_flags & O_NONBLOCK) {
 241     fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
 242   }
 243 }
 244
 245 void
 246 setNonBlockingFd(int fd)
 247 {
 248   long fd_flags;
 249
 250   /* clear the non-blocking flag on this file descriptor */
 251   fd_flags = fcntl(fd, F_GETFL);
 252   fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
 253 }
 254 #else
 255 /* Stub defns -- async / non-blocking IO is not done
 256  * via O_NONBLOCK and select() under Win32.
 257  */
 258 void resetNonBlockingFd(int fd STG_UNUSED) {}
 259 void setNonBlockingFd(int fd STG_UNUSED) {}
 260 #endif
 261
 262 #ifdef PAR
 263 static ullong startTime = 0;
 264
 265 /* used in a parallel setup */
 266 ullong
 267 msTime(void)
 268 {
 269 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH) && !defined(hppa1_1_TARGET_ARCH)
 270     struct timespec tv;
 271
 272     if (getclock(TIMEOFDAY, &tv) != 0) {
 273         fflush(stdout);
 274         fprintf(stderr, "Clock failed\n");
 275         stg_exit(EXIT_FAILURE);
 276     }
 277     return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
 278 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
 279     struct timeval tv;
 280
 281     if (gettimeofday(&tv, NULL) != 0) {
 282         fflush(stdout);
 283         fprintf(stderr, "Clock failed\n");
 284         stg_exit(EXIT_FAILURE);
 285     }
 286     return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
 287 # else
 288     time_t t;
 289     if ((t = time(NULL)) == (time_t) -1) {
 290         fflush(stdout);
 291         fprintf(stderr, "Clock failed\n");
 292         stg_exit(EXIT_FAILURE);
 293     }
 294     return t * LL(1000) - startTime;
 295 # endif
 296 }
 297 #endif /* PAR */
 298
 299 /* -----------------------------------------------------------------------------
 300    Print large numbers, with punctuation.
 301    -------------------------------------------------------------------------- */
 302
 303 char *
 304 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 305 {
 306     if (x < (ullong)1000)
 307         sprintf(s, "%lu", (lnat)x);
 308     else if (x < (ullong)1000000)
 309         sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
 310                 (lnat)((x)/(ullong)1000),
 311                 (lnat)((x)%(ullong)1000));
 312     else if (x < (ullong)1000000000)
 313         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" :  "%lu%3.3lu%3.3lu",
 314                 (lnat)((x)/(ullong)1000000),
 315                 (lnat)((x)/(ullong)1000%(ullong)1000),
 316                 (lnat)((x)%(ullong)1000));
 317     else
 318         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
 319                 (lnat)((x)/(ullong)1000000000),
 320                 (lnat)((x)/(ullong)1000000%(ullong)1000),
 321                 (lnat)((x)/(ullong)1000%(ullong)1000),
 322                 (lnat)((x)%(ullong)1000));
 323     return s;
 324 }
 325
 326
 327 // Can be used as a breakpoint to set on every heap check failure.
 328 #ifdef DEBUG
 329 void
 330 heapCheckFail( void )
 331 {
 332 }
 333 #endif
 334