ghc/rts/RtsUtils.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: RtsUtils.c,v 1.15 2000/04/14 14:07:43 simonmar 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 #define NON_POSIX_SOURCE
  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 _stgAssert (char *filename, nat linenum)
 117 {
 118   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 119   fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
 120   abort();
 121 }
 122
 123 /* -----------------------------------------------------------------------------
 124    Stack overflow
 125
 126    Not sure if this belongs here.
 127    -------------------------------------------------------------------------- */
 128
 129 void
 130 stackOverflow(void)
 131 {
 132   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
 133
 134 #if defined(TICKY_TICKY)
 135   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 136 #endif
 137 }
 138
 139 void
 140 heapOverflow(void)
 141 {
 142   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 143   OutOfHeapHook(0/*unknown request size*/,
 144                 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 145
 146 #if defined(TICKY_TICKY)
 147   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 148 #endif
 149
 150   stg_exit(EXIT_HEAPOVERFLOW);
 151 }
 152
 153 /* -----------------------------------------------------------------------------
 154    Out-of-line strlen.
 155
 156    Used in addr2Integer because the C compiler on x86 chokes on
 157    strlen, trying to inline it with not enough registers available.
 158    -------------------------------------------------------------------------- */
 159
 160 nat stg_strlen(char *s)
 161 {
 162    char *p = s;
 163
 164    while (*p) p++;
 165    return p-s;
 166 }
 167
 168
 169 /* -----------------------------------------------------------------------------
 170    genSym stuff, used by GHC itself for its splitting unique supply.
 171
 172    ToDo: put this somewhere sensible.
 173    -------------------------------------------------------------------------  */
 174
 175 I_ __GenSymCounter = 0;
 176
 177 I_
 178 genSymZh(void)
 179 {
 180     return(__GenSymCounter++);
 181 }
 182 I_
 183 resetGenSymZh(void) /* it's your funeral */
 184 {
 185     __GenSymCounter=0;
 186     return(__GenSymCounter);
 187 }
 188
 189 /* -----------------------------------------------------------------------------
 190    Get the current time as a string.  Used in profiling reports.
 191    -------------------------------------------------------------------------- */
 192
 193 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
 194 char *
 195 time_str(void)
 196 {
 197     static time_t now = 0;
 198     static char nowstr[26];
 199
 200     if (now == 0) {
 201         time(&now);
 202         strcpy(nowstr, ctime(&now));
 203         strcpy(nowstr+16,nowstr+19);
 204         nowstr[21] = '\0';
 205     }
 206     return nowstr;
 207 }
 208 #endif
 209
 210 /* -----------------------------------------------------------------------------
 211  * Reset a file handle to blocking mode.  We do this for the standard
 212  * file descriptors before exiting, because the shell doesn't always
 213  * clean up for us.
 214  * -------------------------------------------------------------------------- */
 215
 216 void
 217 resetNonBlockingFd(int fd)
 218 {
 219   long fd_flags;
 220
 221 #if !defined(_WIN32) || defined(__CYGWIN__) || defined(__CYGWIN32__)
 222   /* clear the non-blocking flag on this file descriptor */
 223   fd_flags = fcntl(fd, F_GETFL);
 224   if (fd_flags & O_NONBLOCK) {
 225     fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
 226   }
 227 #endif
 228 }
 229
 230 static ullong startTime = 0;
 231
 232 /* used in a parallel setup */
 233 ullong
 234 msTime(void)
 235 {
 236 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH)
 237     struct timespec tv;
 238
 239     if (getclock(TIMEOFDAY, &tv) != 0) {
 240         fflush(stdout);
 241         fprintf(stderr, "Clock failed\n");
 242         stg_exit(EXIT_FAILURE);
 243     }
 244     return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
 245 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
 246     struct timeval tv;
 247
 248     if (gettimeofday(&tv, NULL) != 0) {
 249         fflush(stdout);
 250         fprintf(stderr, "Clock failed\n");
 251         stg_exit(EXIT_FAILURE);
 252     }
 253     return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
 254 # else
 255     time_t t;
 256     if ((t = time(NULL)) == (time_t) -1) {
 257         fflush(stdout);
 258         fprintf(stderr, "Clock failed\n");
 259         stg_exit(EXIT_FAILURE);
 260     }
 261     return t * LL(1000) - startTime;
 262 # endif
 263 }
 264
 265 /* -----------------------------------------------------------------------------
 266    Print large numbers, with punctuation.
 267    -------------------------------------------------------------------------- */
 268
 269 char *
 270 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 271 {
 272     if (x < (ullong)1000)
 273         sprintf(s, "%d", (nat)x);
 274     else if (x < (ullong)1000000)
 275         sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
 276                 (nat)((x)/(ullong)1000),
 277                 (nat)((x)%(ullong)1000));
 278     else if (x < (ullong)1000000000)
 279         sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" :  "%ld%3.3ld%3.3ld",
 280                 (nat)((x)/(ullong)1000000),
 281                 (nat)((x)/(ullong)1000%(ullong)1000),
 282                 (nat)((x)%(ullong)1000));
 283     else
 284         sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
 285                 (nat)((x)/(ullong)1000000000),
 286                 (nat)((x)/(ullong)1000000%(ullong)1000),
 287                 (nat)((x)/(ullong)1000%(ullong)1000),
 288                 (nat)((x)%(ullong)1000));
 289     return s;
 290 }