ghc/rts/RtsUtils.c

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