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