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