A few typofixes
[ghc.git] / rts / RtsUtils.c
index bf02c32..618815d 100644 (file)
@@ -7,22 +7,30 @@
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
-
 #include "Rts.h"
 #include "RtsAPI.h"
-#include "RtsFlags.h"
+
 #include "RtsUtils.h"
 #include "Ticky.h"
+#include "Schedule.h"
+#include "RtsFlags.h"
 
-#ifdef HAVE_TIME_H
+#if defined(HAVE_TIME_H)
 #include <time.h>
 #endif
 
-#ifdef HAVE_FCNTL_H
+/* HACK: On Mac OS X 10.4 (at least), time.h doesn't declare ctime_r with
+ *       _POSIX_C_SOURCE. If this is the case, we declare it ourselves.
+ */
+#if defined(HAVE_CTIME_R) && !HAVE_DECL_CTIME_R
+extern char *ctime_r(const time_t *, char *);
+#endif
+
+#if defined(HAVE_FCNTL_H)
 #include <fcntl.h>
 #endif
 
-#ifdef HAVE_GETTIMEOFDAY
+#if defined(HAVE_GETTIMEOFDAY)
 #include <sys/time.h>
 #endif
 
@@ -31,7 +39,7 @@
 #include <stdarg.h>
 #include <stdio.h>
 
-#ifdef HAVE_SIGNAL_H
+#if defined(HAVE_SIGNAL_H)
 #include <signal.h>
 #endif
 
    -------------------------------------------------------------------------- */
 
 void *
-stgMallocBytes (int n, char *msg)
+stgMallocBytes (size_t n, char *msg)
 {
-    char *space;
+    void *space;
+
+    if ((space = malloc(n)) == NULL) {
+      /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99):
+       *
+       *   "Upon successful completion with size not equal to 0, malloc() shall
+       *   return a pointer to the allocated space. If size is 0, either a null
+       *   pointer or a unique pointer that can be successfully passed to free()
+       *   shall be returned. Otherwise, it shall return a null pointer and set
+       *   errno to indicate the error."
+       *
+       * Consequently, a NULL pointer being returned by `malloc()` for a 0-size
+       * allocation is *not* to be considered an error.
+       */
+      if (n == 0) return NULL;
 
-    if ((space = (char *) malloc((size_t) n)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n, msg); /*msg*/
+      rtsConfig.mallocFailHook((W_) n, msg);
       stg_exit(EXIT_INTERNAL_ERROR);
     }
+    IF_DEBUG(sanity, memset(space, 0xbb, n));
     return space;
 }
 
 void *
-stgReallocBytes (void *p, int n, char *msg)
+stgReallocBytes (void *p, size_t n, char *msg)
 {
-    char *space;
+    void *space;
 
-    if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
+    if ((space = realloc(p, n)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n, msg); /*msg*/
+      rtsConfig.mallocFailHook((W_) n, msg);
       stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
 }
 
 void *
-stgCallocBytes (int n, int m, char *msg)
+stgCallocBytes (size_t n, size_t m, char *msg)
 {
-    char *space;
+    void *space;
 
-    if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
+    if ((space = calloc(n, m)) == NULL) {
       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n*m, msg); /*msg*/
+      rtsConfig.mallocFailHook((W_) n*m, msg);
       stg_exit(EXIT_INTERNAL_ERROR);
     }
     return space;
 }
 
+/* borrowed from the MUSL libc project */
+char *stgStrndup(const char *s, size_t n)
+{
+    size_t l = strnlen(s, n);
+    char *d = stgMallocBytes(l+1, "stgStrndup");
+    if (!d) return NULL;
+    memcpy(d, s, l);
+    d[l] = 0;
+    return d;
+}
+
+
 /* To simplify changing the underlying allocator used
  * by stgMallocBytes(), provide stgFree() as well.
  */
@@ -97,76 +131,31 @@ stgFree(void* p)
 }
 
 /* -----------------------------------------------------------------------------
-   Stack overflow
-   
-   Not sure if this belongs here.
+   Stack/heap overflow
    -------------------------------------------------------------------------- */
 
 void
-stackOverflow(void)
+reportStackOverflow(StgTSO* tso)
 {
-  StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
+    rtsConfig.stackOverflowHook(tso->tot_stack_size * sizeof(W_));
 
 #if defined(TICKY_TICKY)
-  if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
+    if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
 }
 
 void
-heapOverflow(void)
+reportHeapOverflow(void)
 {
-  /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-  OutOfHeapHook(0/*unknown request size*/, 
-               RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
-  
-#if defined(TICKY_TICKY)
-  if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
-#endif
-
-  stg_exit(EXIT_HEAPOVERFLOW);
-}
-
-/* -----------------------------------------------------------------------------
-   Out-of-line strlen.
-
-   Used in addr2Integer because the C compiler on x86 chokes on
-   strlen, trying to inline it with not enough registers available.
-   -------------------------------------------------------------------------- */
-
-nat stg_strlen(char *s)
-{
-   char *p = s;
-
-   while (*p) p++;
-   return p-s;
-}
-
-
-/* -----------------------------------------------------------------------------
-   genSym stuff, used by GHC itself for its splitting unique supply.
-
-   ToDo: put this somewhere sensible.
-   -------------------------------------------------------------------------  */
-
-static I_ __GenSymCounter = 0;
-
-I_
-genSymZh(void)
-{
-    return(__GenSymCounter++);
-}
-I_
-resetGenSymZh(void) /* it's your funeral */
-{
-    __GenSymCounter=0;
-    return(__GenSymCounter);
+    /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+    rtsConfig.outOfHeapHook(0/*unknown request size*/,
+                            (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 }
 
 /* -----------------------------------------------------------------------------
    Get the current time as a string.  Used in profiling reports.
    -------------------------------------------------------------------------- */
 
-#if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
 char *
 time_str(void)
 {
@@ -174,131 +163,104 @@ time_str(void)
     static char nowstr[26];
 
     if (now == 0) {
-       time(&now);
-#if HAVE_CTIME_R
-       ctime_r(&now, nowstr);
+        time(&now);
+#if defined(HAVE_CTIME_R)
+        ctime_r(&now, nowstr);
 #else
-       strcpy(nowstr, ctime(&now));
+        strcpy(nowstr, ctime(&now));
 #endif
-       memmove(nowstr+16,nowstr+19,7);
-       nowstr[21] = '\0';  // removes the \n
+        memmove(nowstr+16,nowstr+19,7);
+        nowstr[21] = '\0';  // removes the \n
     }
     return nowstr;
 }
-#endif
-
-/* -----------------------------------------------------------------------------
- * Reset a file handle to blocking mode.  We do this for the standard
- * file descriptors before exiting, because the shell doesn't always
- * clean up for us.
- * -------------------------------------------------------------------------- */
-
-#if !defined(mingw32_HOST_OS)
-void
-resetNonBlockingFd(int fd)
-{
-  long fd_flags;
-
-  /* clear the non-blocking flag on this file descriptor */
-  fd_flags = fcntl(fd, F_GETFL);
-  if (fd_flags & O_NONBLOCK) {
-    fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
-  }
-}
-
-void
-setNonBlockingFd(int fd)
-{
-  long fd_flags;
-
-  /* clear the non-blocking flag on this file descriptor */
-  fd_flags = fcntl(fd, F_GETFL);
-  if (!(fd_flags & O_NONBLOCK)) {
-    fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
-  }
-}
-#else
-/* Stub defns -- async / non-blocking IO is not done 
- * via O_NONBLOCK and select() under Win32. 
- */
-void resetNonBlockingFd(int fd STG_UNUSED) {}
-void setNonBlockingFd(int fd STG_UNUSED) {}
-#endif
-
-#ifdef PAR
-static ullong startTime = 0;
-
-/* used in a parallel setup */
-ullong
-msTime(void)
-{
-# if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
-    struct timespec tv;
-
-    if (getclock(TIMEOFDAY, &tv) != 0) {
-       fflush(stdout);
-       fprintf(stderr, "Clock failed\n");
-       stg_exit(EXIT_FAILURE);
-    }
-    return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
-# elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
-    struct timeval tv;
-    if (gettimeofday(&tv, NULL) != 0) {
-       fflush(stdout);
-       fprintf(stderr, "Clock failed\n");
-       stg_exit(EXIT_FAILURE);
-    }
-    return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
-# else
-    time_t t;
-    if ((t = time(NULL)) == (time_t) -1) {
-       fflush(stdout);
-       fprintf(stderr, "Clock failed\n");
-       stg_exit(EXIT_FAILURE);
-    }
-    return t * LL(1000) - startTime;
-# endif
-}
-#endif /* PAR */
 
 /* -----------------------------------------------------------------------------
    Print large numbers, with punctuation.
    -------------------------------------------------------------------------- */
 
 char *
-ullong_format_string(ullong x, char *s, rtsBool with_commas)
+showStgWord64(StgWord64 x, char *s, bool with_commas)
 {
-    if (x < (ullong)1000) 
-       sprintf(s, "%lu", (lnat)x);
-    else if (x < (ullong)1000000)
-       sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
-               (lnat)((x)/(ullong)1000),
-               (lnat)((x)%(ullong)1000));
-    else if (x < (ullong)1000000000)
-       sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" :  "%lu%3.3lu%3.3lu",
-               (lnat)((x)/(ullong)1000000),
-               (lnat)((x)/(ullong)1000%(ullong)1000),
-               (lnat)((x)%(ullong)1000));
-    else
-       sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
-               (lnat)((x)/(ullong)1000000000),
-               (lnat)((x)/(ullong)1000000%(ullong)1000),
-               (lnat)((x)/(ullong)1000%(ullong)1000), 
-               (lnat)((x)%(ullong)1000));
+    if (with_commas) {
+        if (x < (StgWord64)1e3)
+                sprintf(s, "%" FMT_Word64, (StgWord64)x);
+        else if (x < (StgWord64)1e6)
+                sprintf(s, "%" FMT_Word64 ",%03" FMT_Word64,
+                        (StgWord64)(x / 1000),
+                        (StgWord64)(x % 1000));
+        else if (x < (StgWord64)1e9)
+                sprintf(s, "%"    FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64,
+                        (StgWord64)(x / 1e6),
+                        (StgWord64)((x / 1000) % 1000),
+                        (StgWord64)(x          % 1000));
+        else if (x < (StgWord64)1e12)
+                sprintf(s, "%"    FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64,
+                        (StgWord64)(x / (StgWord64)1e9),
+                        (StgWord64)((x / (StgWord64)1e6) % 1000),
+                        (StgWord64)((x / (StgWord64)1e3) % 1000),
+                        (StgWord64)(x                    % 1000));
+        else if (x < (StgWord64)1e15)
+                sprintf(s, "%"    FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64,
+                        (StgWord64)(x / (StgWord64)1e12),
+                        (StgWord64)((x / (StgWord64)1e9) % 1000),
+                        (StgWord64)((x / (StgWord64)1e6) % 1000),
+                        (StgWord64)((x / (StgWord64)1e3) % 1000),
+                        (StgWord64)(x                    % 1000));
+        else if (x < (StgWord64)1e18)
+                sprintf(s, "%"    FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64,
+                        (StgWord64)(x / (StgWord64)1e15),
+                        (StgWord64)((x / (StgWord64)1e12) % 1000),
+                        (StgWord64)((x / (StgWord64)1e9)  % 1000),
+                        (StgWord64)((x / (StgWord64)1e6)  % 1000),
+                        (StgWord64)((x / (StgWord64)1e3)  % 1000),
+                        (StgWord64)(x                     % 1000));
+        else
+                sprintf(s, "%"    FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64
+                           ",%03" FMT_Word64,
+                        (StgWord64)(x / (StgWord64)1e18),
+                        (StgWord64)((x / (StgWord64)1e15) % 1000),
+                        (StgWord64)((x / (StgWord64)1e12) % 1000),
+                        (StgWord64)((x / (StgWord64)1e9)  % 1000),
+                        (StgWord64)((x / (StgWord64)1e6)  % 1000),
+                        (StgWord64)((x / (StgWord64)1e3)  % 1000),
+                        (StgWord64)(x                     % 1000));
+    }
+    else {
+        sprintf(s, "%" FMT_Word64, x);
+    }
     return s;
 }
 
 
 // Can be used as a breakpoint to set on every heap check failure.
-#ifdef DEBUG
+#if defined(DEBUG)
 void
 heapCheckFail( void )
 {
 }
 #endif
 
-/* 
+/*
  * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
  * pthreads (and possibly others). When linking with -lpthreads, we
  * have to use pthread_kill to send blockable signals. So use that
@@ -306,9 +268,81 @@ heapCheckFail( void )
  * genericRaise(), rather than raise(3).
  */
 int genericRaise(int sig) {
-#if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
+#if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS))
         return pthread_kill(pthread_self(), sig);
 #else
         return raise(sig);
 #endif
 }
+
+static void mkRtsInfoPair(const char *key, const char *val) {
+    /* XXX should check for "s, \s etc in key and val */
+    printf(" ,(\"%s\", \"%s\")\n", key, val);
+}
+
+/* This little bit of magic allows us to say TOSTRING(SYM) and get
+ * "5" if SYM is 5 */
+#define TOSTRING2(x) #x
+#define TOSTRING(x)  TOSTRING2(x)
+
+void printRtsInfo(const RtsConfig rts_config) {
+    /* The first entry is just a hack to make it easy to get the
+     * commas right */
+    printf(" [(\"GHC RTS\", \"YES\")\n");
+    mkRtsInfoPair("GHC version",             ProjectVersion);
+    mkRtsInfoPair("RTS way",                 RtsWay);
+    mkRtsInfoPair("Build platform",          BuildPlatform);
+    mkRtsInfoPair("Build architecture",      BuildArch);
+    mkRtsInfoPair("Build OS",                BuildOS);
+    mkRtsInfoPair("Build vendor",            BuildVendor);
+    mkRtsInfoPair("Host platform",           HostPlatform);
+    mkRtsInfoPair("Host architecture",       HostArch);
+    mkRtsInfoPair("Host OS",                 HostOS);
+    mkRtsInfoPair("Host vendor",             HostVendor);
+    mkRtsInfoPair("Target platform",         TargetPlatform);
+    mkRtsInfoPair("Target architecture",     TargetArch);
+    mkRtsInfoPair("Target OS",               TargetOS);
+    mkRtsInfoPair("Target vendor",           TargetVendor);
+    mkRtsInfoPair("Word size",               TOSTRING(WORD_SIZE_IN_BITS));
+    mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
+    mkRtsInfoPair("Tables next to code",     GhcEnableTablesNextToCode);
+    mkRtsInfoPair("Flag -with-rtsopts",      /* See Trac #15261 */
+        rts_config.rts_opts != NULL ? rts_config.rts_opts : "");
+    printf(" ]\n");
+}
+
+// Provides a way for Haskell programs to tell whether they're being
+// profiled or not.  GHCi uses it (see #2197).
+int rts_isProfiled(void)
+{
+#if defined(PROFILING)
+    return 1;
+#else
+    return 0;
+#endif
+}
+
+// Provides a way for Haskell programs to tell whether they're
+// dynamically-linked or not.
+int rts_isDynamic(void)
+{
+#if defined(DYNAMIC)
+    return 1;
+#else
+    return 0;
+#endif
+}
+
+// Used for detecting a non-empty FPU stack on x86 (see #4914)
+void checkFPUStack(void)
+{
+#if defined(i386_HOST_ARCH)
+    static unsigned char buf[108];
+    asm("FSAVE %0":"=m" (buf));
+
+    if(buf[8]!=255 || buf[9]!=255) {
+        errorBelch("NONEMPTY FPU Stack, TAG = %x %x\n",buf[8],buf[9]);
+        abort();
+    }
+#endif
+}