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 #include "PosixSource.h"
  10
  11 #include "Rts.h"
  12 #include "RtsAPI.h"
  13 #include "RtsFlags.h"
  14 #include "RtsUtils.h"
  15 #include "Ticky.h"
  16
  17 #ifdef HAVE_TIME_H
  18 #include <time.h>
  19 #endif
  20
  21 #ifdef HAVE_FCNTL_H
  22 #include <fcntl.h>
  23 #endif
  24
  25 #ifdef HAVE_GETTIMEOFDAY
  26 #include <sys/time.h>
  27 #endif
  28
  29 #include <stdlib.h>
  30 #include <string.h>
  31 #include <stdarg.h>
  32 #include <stdio.h>
  33
  34 #ifdef HAVE_SIGNAL_H
  35 #include <signal.h>
  36 #endif
  37
  38 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
  39 #include <pthread.h>
  40 #endif
  41
  42
  43 #if defined(_WIN32)
  44 #include <windows.h>
  45 #endif
  46
  47 /* -----------------------------------------------------------------------------
  48    Debugging allocator
  49    -------------------------------------------------------------------------- */
  50
  51 #if defined(DEBUG)
  52
  53 typedef struct Allocated_ {
  54     void *addr;
  55     size_t len;
  56     struct Allocated_ *next;
  57 } Allocated;
  58
  59 static Allocated *allocs = NULL;
  60
  61 #ifdef THREADED_RTS
  62 static Mutex allocator_mutex;
  63 #endif
  64
  65 void
  66 initAllocator(void)
  67 {
  68     Allocated *a;
  69     size_t alloc_size;
  70
  71 #ifdef THREADED_RTS
  72     initMutex(&allocator_mutex);
  73 #endif
  74     alloc_size = sizeof(Allocated);
  75     if ((a = (Allocated *) malloc(alloc_size)) == NULL) {
  76       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  77       MallocFailHook((W_) alloc_size, "initialising debugging allocator");
  78       stg_exit(EXIT_INTERNAL_ERROR);
  79     }
  80     a->addr = NULL;
  81     a->len = 0;
  82     a->next = NULL;
  83     allocs = a;
  84 }
  85
  86 void
  87 shutdownAllocator(void)
  88 {
  89     Allocated *prev, *a;
  90
  91     if (allocs == NULL) {
  92         barf("Allocator shutdown requested, but not initialised!");
  93     }
  94
  95 #ifdef THREADED_RTS
  96     closeMutex(&allocator_mutex);
  97 #endif
  98
  99     prev = allocs;
 100     while (1) {
 101         a = prev->next;
 102         free(prev);
 103         if (a == NULL) return;
 104         IF_DEBUG(sanity,
 105                  debugBelch("Warning: %p still allocated at shutdown\n",
 106                             a->addr);)
 107         prev = a;
 108     }
 109 }
 110
 111 static void addAllocation(void *addr, size_t len) {
 112     Allocated *a;
 113     size_t alloc_size;
 114
 115     if (allocs != NULL) {
 116         alloc_size = sizeof(Allocated);
 117         if ((a = (Allocated *) malloc(alloc_size)) == NULL) {
 118           /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 119           MallocFailHook((W_) alloc_size,
 120                          "creating info for debugging allocator");
 121           stg_exit(EXIT_INTERNAL_ERROR);
 122         }
 123         a->addr = addr;
 124         a->len = len;
 125         ACQUIRE_LOCK(&allocator_mutex);
 126         a->next = allocs->next;
 127         allocs->next = a;
 128         RELEASE_LOCK(&allocator_mutex);
 129     }
 130     else {
 131         /* This doesn't actually help as we haven't looked at the flags
 132          * at the time that it matters (while running constructors) */
 133         IF_DEBUG(sanity,
 134                  debugBelch("Ignoring allocation %p %zd as allocs is NULL\n",
 135                             addr, len);)
 136     }
 137 }
 138
 139 static void removeAllocation(void *addr, int overwrite_with_aa) {
 140     Allocated *prev, *a;
 141
 142     if (addr == NULL) {
 143         barf("Freeing NULL!");
 144     }
 145
 146     if (allocs != NULL) {
 147         ACQUIRE_LOCK(&allocator_mutex);
 148         prev = allocs;
 149         a = prev->next;
 150         while (a != NULL) {
 151             if (a->addr == addr) {
 152                 prev->next = a->next;
 153                 if (overwrite_with_aa) {
 154                     memset(addr, 0xaa, a->len);
 155                 }
 156                 free(a);
 157                 RELEASE_LOCK(&allocator_mutex);
 158                 return;
 159             }
 160             prev = a;
 161             a = a->next;
 162         }
 163         /* We would like to barf here, but we can't as conc021
 164          * allocates some stuff in a constructor which then gets freed
 165          * during hs_exit */
 166         /* barf("Freeing non-allocated memory at %p", addr); */
 167         IF_DEBUG(sanity,
 168                  debugBelch("Warning: Freeing non-allocated memory at %p\n",
 169                             addr);)
 170         RELEASE_LOCK(&allocator_mutex);
 171     }
 172     else {
 173         IF_DEBUG(sanity,
 174                  debugBelch("Ignoring free of %p as allocs is NULL\n",
 175                             addr);)
 176     }
 177 }
 178 #endif
 179
 180 /* -----------------------------------------------------------------------------
 181    Result-checking malloc wrappers.
 182    -------------------------------------------------------------------------- */
 183
 184 void *
 185 stgMallocBytes (int n, char *msg)
 186 {
 187     char *space;
 188     size_t n2;
 189
 190     n2 = (size_t) n;
 191     if ((space = (char *) malloc(n2)) == NULL) {
 192       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 193       MallocFailHook((W_) n, msg); /*msg*/
 194       stg_exit(EXIT_INTERNAL_ERROR);
 195     }
 196 #if defined(DEBUG)
 197     addAllocation(space, n2);
 198 #endif
 199     return space;
 200 }
 201
 202 void *
 203 stgReallocBytes (void *p, int n, char *msg)
 204 {
 205     char *space;
 206     size_t n2;
 207
 208     n2 = (size_t) n;
 209     if ((space = (char *) realloc(p, (size_t) n2)) == NULL) {
 210       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 211       MallocFailHook((W_) n, msg); /*msg*/
 212       stg_exit(EXIT_INTERNAL_ERROR);
 213     }
 214 #if defined(DEBUG)
 215     removeAllocation(p, 0);
 216     addAllocation(space, n2);
 217 #endif
 218     return space;
 219 }
 220
 221 void *
 222 stgCallocBytes (int n, int m, char *msg)
 223 {
 224     char *space;
 225
 226     if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
 227       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 228       MallocFailHook((W_) n*m, msg); /*msg*/
 229       stg_exit(EXIT_INTERNAL_ERROR);
 230     }
 231 #if defined(DEBUG)
 232     addAllocation(space, (size_t) n * (size_t) m);
 233 #endif
 234     return space;
 235 }
 236
 237 /* To simplify changing the underlying allocator used
 238  * by stgMallocBytes(), provide stgFree() as well.
 239  */
 240 void
 241 stgFree(void* p)
 242 {
 243 #if defined(DEBUG)
 244   removeAllocation(p, 1);
 245 #endif
 246   free(p);
 247 }
 248
 249 /* -----------------------------------------------------------------------------
 250    Stack overflow
 251
 252    Not sure if this belongs here.
 253    -------------------------------------------------------------------------- */
 254
 255 void
 256 stackOverflow(void)
 257 {
 258   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
 259
 260 #if defined(TICKY_TICKY)
 261   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 262 #endif
 263 }
 264
 265 void
 266 heapOverflow(void)
 267 {
 268   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 269   OutOfHeapHook(0/*unknown request size*/,
 270                 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 271
 272 #if defined(TICKY_TICKY)
 273   if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 274 #endif
 275
 276   stg_exit(EXIT_HEAPOVERFLOW);
 277 }
 278
 279 /* -----------------------------------------------------------------------------
 280    Out-of-line strlen.
 281
 282    Used in addr2Integer because the C compiler on x86 chokes on
 283    strlen, trying to inline it with not enough registers available.
 284    -------------------------------------------------------------------------- */
 285
 286 nat stg_strlen(char *s)
 287 {
 288    char *p = s;
 289
 290    while (*p) p++;
 291    return p-s;
 292 }
 293
 294
 295 /* -----------------------------------------------------------------------------
 296    genSym stuff, used by GHC itself for its splitting unique supply.
 297
 298    ToDo: put this somewhere sensible.
 299    -------------------------------------------------------------------------  */
 300
 301 static HsInt __GenSymCounter = 0;
 302
 303 HsInt
 304 genSymZh(void)
 305 {
 306     return(__GenSymCounter++);
 307 }
 308 HsInt
 309 resetGenSymZh(void) /* it's your funeral */
 310 {
 311     __GenSymCounter=0;
 312     return(__GenSymCounter);
 313 }
 314
 315 /* -----------------------------------------------------------------------------
 316    Get the current time as a string.  Used in profiling reports.
 317    -------------------------------------------------------------------------- */
 318
 319 char *
 320 time_str(void)
 321 {
 322     static time_t now = 0;
 323     static char nowstr[26];
 324
 325     if (now == 0) {
 326         time(&now);
 327 #if HAVE_CTIME_R
 328         ctime_r(&now, nowstr);
 329 #else
 330         strcpy(nowstr, ctime(&now));
 331 #endif
 332         memmove(nowstr+16,nowstr+19,7);
 333         nowstr[21] = '\0';  // removes the \n
 334     }
 335     return nowstr;
 336 }
 337
 338 /* -----------------------------------------------------------------------------
 339  * Reset a file handle to blocking mode.  We do this for the standard
 340  * file descriptors before exiting, because the shell doesn't always
 341  * clean up for us.
 342  * -------------------------------------------------------------------------- */
 343
 344 #if !defined(mingw32_HOST_OS)
 345 void
 346 resetNonBlockingFd(int fd)
 347 {
 348   long fd_flags;
 349
 350   /* clear the non-blocking flag on this file descriptor */
 351   fd_flags = fcntl(fd, F_GETFL);
 352   if (fd_flags & O_NONBLOCK) {
 353     fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
 354   }
 355 }
 356
 357 void
 358 setNonBlockingFd(int fd)
 359 {
 360   long fd_flags;
 361
 362   /* clear the non-blocking flag on this file descriptor */
 363   fd_flags = fcntl(fd, F_GETFL);
 364   if (!(fd_flags & O_NONBLOCK)) {
 365     fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
 366   }
 367 }
 368 #else
 369 /* Stub defns -- async / non-blocking IO is not done
 370  * via O_NONBLOCK and select() under Win32.
 371  */
 372 void resetNonBlockingFd(int fd STG_UNUSED) {}
 373 void setNonBlockingFd(int fd STG_UNUSED) {}
 374 #endif
 375
 376 #ifdef PAR
 377 static ullong startTime = 0;
 378
 379 /* used in a parallel setup */
 380 ullong
 381 msTime(void)
 382 {
 383 # if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
 384     struct timespec tv;
 385
 386     if (getclock(TIMEOFDAY, &tv) != 0) {
 387         fflush(stdout);
 388         fprintf(stderr, "Clock failed\n");
 389         stg_exit(EXIT_FAILURE);
 390     }
 391     return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
 392 # elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
 393     struct timeval tv;
 394
 395     if (gettimeofday(&tv, NULL) != 0) {
 396         fflush(stdout);
 397         fprintf(stderr, "Clock failed\n");
 398         stg_exit(EXIT_FAILURE);
 399     }
 400     return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
 401 # else
 402     time_t t;
 403     if ((t = time(NULL)) == (time_t) -1) {
 404         fflush(stdout);
 405         fprintf(stderr, "Clock failed\n");
 406         stg_exit(EXIT_FAILURE);
 407     }
 408     return t * LL(1000) - startTime;
 409 # endif
 410 }
 411 #endif /* PAR */
 412
 413 /* -----------------------------------------------------------------------------
 414    Print large numbers, with punctuation.
 415    -------------------------------------------------------------------------- */
 416
 417 char *
 418 ullong_format_string(ullong x, char *s, rtsBool with_commas)
 419 {
 420     if (x < (ullong)1000)
 421         sprintf(s, "%lu", (lnat)x);
 422     else if (x < (ullong)1000000)
 423         sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
 424                 (lnat)((x)/(ullong)1000),
 425                 (lnat)((x)%(ullong)1000));
 426     else if (x < (ullong)1000000000)
 427         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" :  "%lu%3.3lu%3.3lu",
 428                 (lnat)((x)/(ullong)1000000),
 429                 (lnat)((x)/(ullong)1000%(ullong)1000),
 430                 (lnat)((x)%(ullong)1000));
 431     else
 432         sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
 433                 (lnat)((x)/(ullong)1000000000),
 434                 (lnat)((x)/(ullong)1000000%(ullong)1000),
 435                 (lnat)((x)/(ullong)1000%(ullong)1000),
 436                 (lnat)((x)%(ullong)1000));
 437     return s;
 438 }
 439
 440
 441 // Can be used as a breakpoint to set on every heap check failure.
 442 #ifdef DEBUG
 443 void
 444 heapCheckFail( void )
 445 {
 446 }
 447 #endif
 448
 449 /*
 450  * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
 451  * pthreads (and possibly others). When linking with -lpthreads, we
 452  * have to use pthread_kill to send blockable signals. So use that
 453  * when we have a threaded rts. So System.Posix.Signals will call
 454  * genericRaise(), rather than raise(3).
 455  */
 456 int genericRaise(int sig) {
 457 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
 458         return pthread_kill(pthread_self(), sig);
 459 #else
 460         return raise(sig);
 461 #endif
 462 }