ghc/rts/RtsUtils.c

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