ghc/rts/RtsUtils.c

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