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 /* -----------------------------------------------------------------------------
  93    Stack overflow
  94
  95    Not sure if this belongs here.
  96    -------------------------------------------------------------------------- */
  97
  98 void
  99 stackOverflow(void)
 100 {
 101   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
 102
 103 #if defined(TICKY_TICKY)
 104   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 105 #endif
 106 }
 107
 108 void
 109 heapOverflow(void)
 110 {
 111   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 112   OutOfHeapHook(0/*unknown request size*/,
 113                 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 114
 115 #if defined(TICKY_TICKY)
 116   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 117 #endif
 118
 119   stg_exit(EXIT_HEAPOVERFLOW);
 120 }
 121
 122 /* -----------------------------------------------------------------------------
 123    Out-of-line strlen.
 124
 125    Used in addr2Integer because the C compiler on x86 chokes on
 126    strlen, trying to inline it with not enough registers available.
 127    -------------------------------------------------------------------------- */
 128
 129 nat stg_strlen(char *s)
 130 {
 131    char *p = s;
 132
 133    while (*p) p++;
 134    return p-s;
 135 }
 136
 137
 138 /* -----------------------------------------------------------------------------
 139    genSym stuff, used by GHC itself for its splitting unique supply.
 140
 141    ToDo: put this somewhere sensible.
 142    -------------------------------------------------------------------------  */
 143
 144 static I_ __GenSymCounter = 0;
 145
 146 I_
 147 genSymZh(void)
 148 {
 149     return(__GenSymCounter++);
 150 }
 151 I_
 152 resetGenSymZh(void) /* it's your funeral */
 153 {
 154     __GenSymCounter=0;
 155     return(__GenSymCounter);
 156 }
 157
 158 /* -----------------------------------------------------------------------------
 159    Get the current time as a string.  Used in profiling reports.
 160    -------------------------------------------------------------------------- */
 161
 162 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
 163 char *
 164 time_str(void)
 165 {
 166     static time_t now = 0;
 167     static char nowstr[26];
 168
 169     if (now == 0) {
 170         time(&now);
 171         strcpy(nowstr, ctime(&now));
 172         strcpy(nowstr+16,nowstr+19);
 173         nowstr[21] = '\0';
 174     }
 175     return nowstr;
 176 }
 177 #endif
 178
 179 /* -----------------------------------------------------------------------------
 180  * Reset a file handle to blocking mode.  We do this for the standard
 181  * file descriptors before exiting, because the shell doesn't always
 182  * clean up for us.
 183  * -------------------------------------------------------------------------- */
 184
 185 #if !defined(mingw32_HOST_OS)
 186 void
 187 resetNonBlockingFd(int fd)
 188 {
 189   long fd_flags;
 190
 191   /* clear the non-blocking flag on this file descriptor */
 192   fd_flags = fcntl(fd, F_GETFL);
 193   if (fd_flags & O_NONBLOCK) {
 194     fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
 195   }
 196 }
 197
 198 void
 199 setNonBlockingFd(int fd)
 200 {
 201   long fd_flags;
 202
 203   /* clear the non-blocking flag on this file descriptor */
 204   fd_flags = fcntl(fd, F_GETFL);
 205   if (!(fd_flags & O_NONBLOCK)) {
 206     fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
 207   }
 208 }
 209 #else
 210 /* Stub defns -- async / non-blocking IO is not done
 211  * via O_NONBLOCK and select() under Win32.
 212  */
 213 void resetNonBlockingFd(int fd STG_UNUSED) {}
 214 void setNonBlockingFd(int fd STG_UNUSED) {}
 215 #endif
 216
 217 #ifdef PAR
 218 static ullong startTime = 0;
 219
 220 /* used in a parallel setup */
 221 ullong
 222 msTime(void)
 223 {
 224 # if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
 225     struct timespec tv;
 226
 227     if (getclock(TIMEOFDAY, &tv) != 0) {
 228         fflush(stdout);
 229         fprintf(stderr, "Clock failed\n");
 230         stg_exit(EXIT_FAILURE);
 231     }
 232     return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
 233 # elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
 234     struct timeval tv;
 235
 236     if (gettimeofday(&tv, NULL) != 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_usec / LL(1000) - startTime;
 242 # else
 243     time_t t;
 244     if ((t = time(NULL)) == (time_t) -1) {
 245         fflush(stdout);
 246         fprintf(stderr, "Clock failed\n");
 247         stg_exit(EXIT_FAILURE);
 248     }
 249     return t * LL(1000) - startTime;
 250 # endif
 251 }
 252 #endif /* PAR */
 253
 254 /* -----------------------------------------------------------------------------
 255    Print large numbers, with punctuation.
 256    -------------------------------------------------------------------------- */
 257
 258 char *
 259 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 260 {
 261     if (x < (ullong)1000)
 262         sprintf(s, "%lu", (lnat)x);
 263     else if (x < (ullong)1000000)
 264         sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
 265                 (lnat)((x)/(ullong)1000),
 266                 (lnat)((x)%(ullong)1000));
 267     else if (x < (ullong)1000000000)
 268         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" :  "%lu%3.3lu%3.3lu",
 269                 (lnat)((x)/(ullong)1000000),
 270                 (lnat)((x)/(ullong)1000%(ullong)1000),
 271                 (lnat)((x)%(ullong)1000));
 272     else
 273         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
 274                 (lnat)((x)/(ullong)1000000000),
 275                 (lnat)((x)/(ullong)1000000%(ullong)1000),
 276                 (lnat)((x)/(ullong)1000%(ullong)1000),
 277                 (lnat)((x)%(ullong)1000));
 278     return s;
 279 }
 280
 281
 282 // Can be used as a breakpoint to set on every heap check failure.
 283 #ifdef DEBUG
 284 void
 285 heapCheckFail( void )
 286 {
 287 }
 288 #endif
 289
 290 /*
 291  * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
 292  * pthreads (and possibly others). When linking with -lpthreads, we
 293  * have to use pthread_kill to send blockable signals. So use that
 294  * when we have a threaded rts. So System.Posix.Signals will call
 295  * genericRaise(), rather than raise(3).
 296  */
 297 int genericRaise(int sig) {
 298 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
 299         return pthread_kill(pthread_self(), sig);
 300 #else
 301         return raise(sig);
 302 #endif
 303 }