ghc/rts/RtsUtils.c

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