ghc/rts/RtsUtils.c

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