ghc/rts/RtsUtils.c

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