ghc/rts/RtsUtils.c

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