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 #ifdef HAVE_SIGNAL_H
  36 #include <signal.h>
  37 #endif
  38
  39 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
  40 #include <pthread.h>
  41 #endif
  42
  43 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
  44 #include <unistd.h>
  45 #include <sys/types.h>
  46 #include <sys/mman.h>
  47
  48 /* no C99 header stdint.h on OpenBSD? */
  49 #if defined(openbsd_HOST_OS)
  50 typedef unsigned long my_uintptr_t;
  51 #else
  52 #include <stdint.h>
  53 typedef uintptr_t my_uintptr_t;
  54 #endif
  55 #endif
  56
  57 #if defined(_WIN32)
  58 #include <windows.h>
  59 #endif
  60
  61 /* -----------------------------------------------------------------------------
  62    Result-checking malloc wrappers.
  63    -------------------------------------------------------------------------- */
  64
  65 void *
  66 stgMallocBytes (int n, char *msg)
  67 {
  68     char *space;
  69
  70     if ((space = (char *) malloc((size_t) n)) == NULL) {
  71       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  72       MallocFailHook((W_) n, msg); /*msg*/
  73       stg_exit(EXIT_INTERNAL_ERROR);
  74     }
  75     return space;
  76 }
  77
  78 void *
  79 stgReallocBytes (void *p, int n, char *msg)
  80 {
  81     char *space;
  82
  83     if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
  84       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  85       MallocFailHook((W_) n, msg); /*msg*/
  86       stg_exit(EXIT_INTERNAL_ERROR);
  87     }
  88     return space;
  89 }
  90
  91 void *
  92 stgCallocBytes (int n, int m, char *msg)
  93 {
  94     char *space;
  95
  96     if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
  97       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  98       MallocFailHook((W_) n*m, msg); /*msg*/
  99       stg_exit(EXIT_INTERNAL_ERROR);
 100     }
 101     return space;
 102 }
 103
 104 /* To simplify changing the underlying allocator used
 105  * by stgMallocBytes(), provide stgFree() as well.
 106  */
 107 void
 108 stgFree(void* p)
 109 {
 110   free(p);
 111 }
 112
 113 /* -----------------------------------------------------------------------------
 114    Stack overflow
 115
 116    Not sure if this belongs here.
 117    -------------------------------------------------------------------------- */
 118
 119 void
 120 stackOverflow(void)
 121 {
 122   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
 123
 124 #if defined(TICKY_TICKY)
 125   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 126 #endif
 127 }
 128
 129 void
 130 heapOverflow(void)
 131 {
 132   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 133   OutOfHeapHook(0/*unknown request size*/,
 134                 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 135
 136 #if defined(TICKY_TICKY)
 137   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 138 #endif
 139
 140   stg_exit(EXIT_HEAPOVERFLOW);
 141 }
 142
 143 /* -----------------------------------------------------------------------------
 144    Out-of-line strlen.
 145
 146    Used in addr2Integer because the C compiler on x86 chokes on
 147    strlen, trying to inline it with not enough registers available.
 148    -------------------------------------------------------------------------- */
 149
 150 nat stg_strlen(char *s)
 151 {
 152    char *p = s;
 153
 154    while (*p) p++;
 155    return p-s;
 156 }
 157
 158
 159 /* -----------------------------------------------------------------------------
 160    genSym stuff, used by GHC itself for its splitting unique supply.
 161
 162    ToDo: put this somewhere sensible.
 163    -------------------------------------------------------------------------  */
 164
 165 static I_ __GenSymCounter = 0;
 166
 167 I_
 168 genSymZh(void)
 169 {
 170     return(__GenSymCounter++);
 171 }
 172 I_
 173 resetGenSymZh(void) /* it's your funeral */
 174 {
 175     __GenSymCounter=0;
 176     return(__GenSymCounter);
 177 }
 178
 179 /* -----------------------------------------------------------------------------
 180    Get the current time as a string.  Used in profiling reports.
 181    -------------------------------------------------------------------------- */
 182
 183 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
 184 char *
 185 time_str(void)
 186 {
 187     static time_t now = 0;
 188     static char nowstr[26];
 189
 190     if (now == 0) {
 191         time(&now);
 192         strcpy(nowstr, ctime(&now));
 193         strcpy(nowstr+16,nowstr+19);
 194         nowstr[21] = '\0';
 195     }
 196     return nowstr;
 197 }
 198 #endif
 199
 200 /* -----------------------------------------------------------------------------
 201  * Reset a file handle to blocking mode.  We do this for the standard
 202  * file descriptors before exiting, because the shell doesn't always
 203  * clean up for us.
 204  * -------------------------------------------------------------------------- */
 205
 206 #if !defined(mingw32_HOST_OS)
 207 void
 208 resetNonBlockingFd(int fd)
 209 {
 210   long fd_flags;
 211
 212   /* clear the non-blocking flag on this file descriptor */
 213   fd_flags = fcntl(fd, F_GETFL);
 214   if (fd_flags & O_NONBLOCK) {
 215     fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
 216   }
 217 }
 218
 219 void
 220 setNonBlockingFd(int fd)
 221 {
 222   long fd_flags;
 223
 224   /* clear the non-blocking flag on this file descriptor */
 225   fd_flags = fcntl(fd, F_GETFL);
 226   if (!(fd_flags & O_NONBLOCK)) {
 227     fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
 228   }
 229 }
 230 #else
 231 /* Stub defns -- async / non-blocking IO is not done
 232  * via O_NONBLOCK and select() under Win32.
 233  */
 234 void resetNonBlockingFd(int fd STG_UNUSED) {}
 235 void setNonBlockingFd(int fd STG_UNUSED) {}
 236 #endif
 237
 238 #ifdef PAR
 239 static ullong startTime = 0;
 240
 241 /* used in a parallel setup */
 242 ullong
 243 msTime(void)
 244 {
 245 # if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
 246     struct timespec tv;
 247
 248     if (getclock(TIMEOFDAY, &tv) != 0) {
 249         fflush(stdout);
 250         fprintf(stderr, "Clock failed\n");
 251         stg_exit(EXIT_FAILURE);
 252     }
 253     return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
 254 # elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
 255     struct timeval tv;
 256
 257     if (gettimeofday(&tv, NULL) != 0) {
 258         fflush(stdout);
 259         fprintf(stderr, "Clock failed\n");
 260         stg_exit(EXIT_FAILURE);
 261     }
 262     return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
 263 # else
 264     time_t t;
 265     if ((t = time(NULL)) == (time_t) -1) {
 266         fflush(stdout);
 267         fprintf(stderr, "Clock failed\n");
 268         stg_exit(EXIT_FAILURE);
 269     }
 270     return t * LL(1000) - startTime;
 271 # endif
 272 }
 273 #endif /* PAR */
 274
 275 /* -----------------------------------------------------------------------------
 276    Print large numbers, with punctuation.
 277    -------------------------------------------------------------------------- */
 278
 279 char *
 280 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 281 {
 282     if (x < (ullong)1000)
 283         sprintf(s, "%lu", (lnat)x);
 284     else if (x < (ullong)1000000)
 285         sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
 286                 (lnat)((x)/(ullong)1000),
 287                 (lnat)((x)%(ullong)1000));
 288     else if (x < (ullong)1000000000)
 289         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" :  "%lu%3.3lu%3.3lu",
 290                 (lnat)((x)/(ullong)1000000),
 291                 (lnat)((x)/(ullong)1000%(ullong)1000),
 292                 (lnat)((x)%(ullong)1000));
 293     else
 294         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
 295                 (lnat)((x)/(ullong)1000000000),
 296                 (lnat)((x)/(ullong)1000000%(ullong)1000),
 297                 (lnat)((x)/(ullong)1000%(ullong)1000),
 298                 (lnat)((x)%(ullong)1000));
 299     return s;
 300 }
 301
 302
 303 // Can be used as a breakpoint to set on every heap check failure.
 304 #ifdef DEBUG
 305 void
 306 heapCheckFail( void )
 307 {
 308 }
 309 #endif
 310
 311 /*
 312  * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
 313  * pthreads (and possibly others). When linking with -lpthreads, we
 314  * have to use pthread_kill to send blockable signals. So use that
 315  * when we have a threaded rts. So System.Posix.Signals will call
 316  * genericRaise(), rather than raise(3).
 317  */
 318 int genericRaise(int sig) {
 319 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
 320         return pthread_kill(pthread_self(), sig);
 321 #else
 322         return raise(sig);
 323 #endif
 324 }
 325
 326 /* -----------------------------------------------------------------------------
 327    Allocating executable memory
 328    -------------------------------------------------------------------------- */
 329
 330 /* Heavily arch-specific, I'm afraid.. */
 331
 332 /*
 333  * Allocate len bytes which are readable, writable, and executable.
 334  *
 335  * ToDo: If this turns out to be a performance bottleneck, one could
 336  * e.g. cache the last VirtualProtect/mprotect-ed region and do
 337  * nothing in case of a cache hit.
 338  */
 339 void*
 340 stgMallocBytesRWX(int len)
 341 {
 342   void *addr = stgMallocBytes(len, "mallocBytesRWX");
 343 #if defined(i386_HOST_ARCH) && defined(_WIN32)
 344   /* This could be necessary for processors which distinguish between READ and
 345      EXECUTE memory accesses, e.g. Itaniums. */
 346   DWORD dwOldProtect = 0;
 347   if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) {
 348     barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
 349          addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
 350   }
 351 #elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
 352   /* malloced memory isn't executable by default on OpenBSD */
 353   my_uintptr_t pageSize         = sysconf(_SC_PAGESIZE);
 354   my_uintptr_t mask             = ~(pageSize - 1);
 355   my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr          ) & mask;
 356   my_uintptr_t startOfLastPage  = ((my_uintptr_t)addr + len - 1) & mask;
 357   my_uintptr_t size             = startOfLastPage - startOfFirstPage + pageSize;
 358   if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) {
 359     barf("mallocBytesRWX: failed to protect 0x%p\n", addr);
 360   }
 361 #endif
 362   return addr;
 363 }