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