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