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 #include "Rts.h"
  11 #include "RtsAPI.h"
  12
  13 #include "RtsUtils.h"
  14 #include "Ticky.h"
  15 #include "Schedule.h"
  16
  17 #ifdef HAVE_TIME_H
  18 #include <time.h>
  19 #endif
  20
  21 /* HACK: On Mac OS X 10.4 (at least), time.h doesn't declare ctime_r with
  22  *       _POSIX_C_SOURCE. If this is the case, we declare it ourselves.
  23  */
  24 #if HAVE_CTIME_R && !HAVE_DECL_CTIME_R
  25 extern char *ctime_r(const time_t *, char *);
  26 #endif
  27
  28 #ifdef HAVE_FCNTL_H
  29 #include <fcntl.h>
  30 #endif
  31
  32 #ifdef HAVE_GETTIMEOFDAY
  33 #include <sys/time.h>
  34 #endif
  35
  36 #include <stdlib.h>
  37 #include <string.h>
  38 #include <stdarg.h>
  39 #include <stdio.h>
  40
  41 #ifdef HAVE_SIGNAL_H
  42 #include <signal.h>
  43 #endif
  44
  45 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
  46 #include <pthread.h>
  47 #endif
  48
  49
  50 #if defined(_WIN32)
  51 #include <windows.h>
  52 #endif
  53
  54 /* -----------------------------------------------------------------------------
  55    Result-checking malloc wrappers.
  56    -------------------------------------------------------------------------- */
  57
  58 void *
  59 stgMallocBytes (int n, char *msg)
  60 {
  61     char *space;
  62     size_t n2;
  63
  64     n2 = (size_t) n;
  65     if ((space = (char *) malloc(n2)) == NULL) {
  66       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  67       MallocFailHook((W_) n, msg); /*msg*/
  68       stg_exit(EXIT_INTERNAL_ERROR);
  69     }
  70     return space;
  71 }
  72
  73 void *
  74 stgReallocBytes (void *p, int n, char *msg)
  75 {
  76     char *space;
  77     size_t n2;
  78
  79     n2 = (size_t) n;
  80     if ((space = (char *) realloc(p, (size_t) n2)) == NULL) {
  81       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  82       MallocFailHook((W_) n, msg); /*msg*/
  83       stg_exit(EXIT_INTERNAL_ERROR);
  84     }
  85     return space;
  86 }
  87
  88 void *
  89 stgCallocBytes (int n, int m, char *msg)
  90 {
  91     char *space;
  92
  93     if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
  94       /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  95       MallocFailHook((W_) n*m, msg); /*msg*/
  96       stg_exit(EXIT_INTERNAL_ERROR);
  97     }
  98     return space;
  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(StgTSO* tso)
 118 {
 119     StackOverflowHook(tso->tot_stack_size * 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     if (!heap_overflow)
 130     {
 131         /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 132         OutOfHeapHook(0/*unknown request size*/,
 133                       (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 134
 135         heap_overflow = rtsTrue;
 136     }
 137 }
 138
 139 /* -----------------------------------------------------------------------------
 140    Get the current time as a string.  Used in profiling reports.
 141    -------------------------------------------------------------------------- */
 142
 143 char *
 144 time_str(void)
 145 {
 146     static time_t now = 0;
 147     static char nowstr[26];
 148
 149     if (now == 0) {
 150         time(&now);
 151 #if HAVE_CTIME_R
 152         ctime_r(&now, nowstr);
 153 #else
 154         strcpy(nowstr, ctime(&now));
 155 #endif
 156         memmove(nowstr+16,nowstr+19,7);
 157         nowstr[21] = '\0';  // removes the \n
 158     }
 159     return nowstr;
 160 }
 161
 162 /* -----------------------------------------------------------------------------
 163    Print large numbers, with punctuation.
 164    -------------------------------------------------------------------------- */
 165
 166 char *
 167 showStgWord64(StgWord64 x, char *s, rtsBool with_commas)
 168 {
 169     if (with_commas) {
 170         if (x < (StgWord64)1e3)
 171                 sprintf(s, "%" FMT_Word64, (StgWord64)x);
 172         else if (x < (StgWord64)1e6)
 173                 sprintf(s, "%" FMT_Word64 ",%03" FMT_Word64,
 174                         (StgWord64)(x / 1000),
 175                         (StgWord64)(x % 1000));
 176         else if (x < (StgWord64)1e9)
 177                 sprintf(s, "%"    FMT_Word64
 178                            ",%03" FMT_Word64
 179                            ",%03" FMT_Word64,
 180                         (StgWord64)(x / 1e6),
 181                         (StgWord64)((x / 1000) % 1000),
 182                         (StgWord64)(x          % 1000));
 183         else if (x < (StgWord64)1e12)
 184                 sprintf(s, "%"    FMT_Word64
 185                            ",%03" FMT_Word64
 186                            ",%03" FMT_Word64
 187                            ",%03" FMT_Word64,
 188                         (StgWord64)(x / (StgWord64)1e9),
 189                         (StgWord64)((x / (StgWord64)1e6) % 1000),
 190                         (StgWord64)((x / (StgWord64)1e3) % 1000),
 191                         (StgWord64)(x                    % 1000));
 192         else if (x < (StgWord64)1e15)
 193                 sprintf(s, "%"    FMT_Word64
 194                            ",%03" FMT_Word64
 195                            ",%03" FMT_Word64
 196                            ",%03" FMT_Word64
 197                            ",%03" FMT_Word64,
 198                         (StgWord64)(x / (StgWord64)1e12),
 199                         (StgWord64)((x / (StgWord64)1e9) % 1000),
 200                         (StgWord64)((x / (StgWord64)1e6) % 1000),
 201                         (StgWord64)((x / (StgWord64)1e3) % 1000),
 202                         (StgWord64)(x                    % 1000));
 203         else if (x < (StgWord64)1e18)
 204                 sprintf(s, "%"    FMT_Word64
 205                            ",%03" FMT_Word64
 206                            ",%03" FMT_Word64
 207                            ",%03" FMT_Word64
 208                            ",%03" FMT_Word64
 209                            ",%03" FMT_Word64,
 210                         (StgWord64)(x / (StgWord64)1e15),
 211                         (StgWord64)((x / (StgWord64)1e12) % 1000),
 212                         (StgWord64)((x / (StgWord64)1e9)  % 1000),
 213                         (StgWord64)((x / (StgWord64)1e6)  % 1000),
 214                         (StgWord64)((x / (StgWord64)1e3)  % 1000),
 215                         (StgWord64)(x                     % 1000));
 216         else
 217                 sprintf(s, "%"    FMT_Word64
 218                            ",%03" FMT_Word64
 219                            ",%03" FMT_Word64
 220                            ",%03" FMT_Word64
 221                            ",%03" FMT_Word64
 222                            ",%03" FMT_Word64
 223                            ",%03" FMT_Word64,
 224                         (StgWord64)(x / (StgWord64)1e18),
 225                         (StgWord64)((x / (StgWord64)1e15) % 1000),
 226                         (StgWord64)((x / (StgWord64)1e12) % 1000),
 227                         (StgWord64)((x / (StgWord64)1e9)  % 1000),
 228                         (StgWord64)((x / (StgWord64)1e6)  % 1000),
 229                         (StgWord64)((x / (StgWord64)1e3)  % 1000),
 230                         (StgWord64)(x                     % 1000));
 231     }
 232     else {
 233         sprintf(s, "%" FMT_Word64, x);
 234     }
 235     return s;
 236 }
 237
 238
 239 // Can be used as a breakpoint to set on every heap check failure.
 240 #ifdef DEBUG
 241 void
 242 heapCheckFail( void )
 243 {
 244 }
 245 #endif
 246
 247 /*
 248  * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
 249  * pthreads (and possibly others). When linking with -lpthreads, we
 250  * have to use pthread_kill to send blockable signals. So use that
 251  * when we have a threaded rts. So System.Posix.Signals will call
 252  * genericRaise(), rather than raise(3).
 253  */
 254 int genericRaise(int sig) {
 255 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS))
 256         return pthread_kill(pthread_self(), sig);
 257 #else
 258         return raise(sig);
 259 #endif
 260 }
 261
 262 static void mkRtsInfoPair(char *key, char *val) {
 263     /* XXX should check for "s, \s etc in key and val */
 264     printf(" ,(\"%s\", \"%s\")\n", key, val);
 265 }
 266
 267 /* This little bit of magic allows us to say TOSTRING(SYM) and get
 268  * "5" if SYM is 5 */
 269 #define TOSTRING2(x) #x
 270 #define TOSTRING(x)  TOSTRING2(x)
 271
 272 void printRtsInfo(void) {
 273     /* The first entry is just a hack to make it easy to get the
 274      * commas right */
 275     printf(" [(\"GHC RTS\", \"YES\")\n");
 276     mkRtsInfoPair("GHC version",             ProjectVersion);
 277     mkRtsInfoPair("RTS way",                 RtsWay);
 278     mkRtsInfoPair("Build platform",          BuildPlatform);
 279     mkRtsInfoPair("Build architecture",      BuildArch);
 280     mkRtsInfoPair("Build OS",                BuildOS);
 281     mkRtsInfoPair("Build vendor",            BuildVendor);
 282     mkRtsInfoPair("Host platform",           HostPlatform);
 283     mkRtsInfoPair("Host architecture",       HostArch);
 284     mkRtsInfoPair("Host OS",                 HostOS);
 285     mkRtsInfoPair("Host vendor",             HostVendor);
 286     mkRtsInfoPair("Target platform",         TargetPlatform);
 287     mkRtsInfoPair("Target architecture",     TargetArch);
 288     mkRtsInfoPair("Target OS",               TargetOS);
 289     mkRtsInfoPair("Target vendor",           TargetVendor);
 290     mkRtsInfoPair("Word size",               TOSTRING(WORD_SIZE_IN_BITS));
 291     mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
 292     mkRtsInfoPair("Tables next to code",     GhcEnableTablesNextToCode);
 293     printf(" ]\n");
 294 }
 295
 296 // Provides a way for Haskell programs to tell whether they're being
 297 // profiled or not.  GHCi uses it (see #2197).
 298 int rts_isProfiled(void)
 299 {
 300 #ifdef PROFILING
 301     return 1;
 302 #else
 303     return 0;
 304 #endif
 305 }
 306
 307 // Provides a way for Haskell programs to tell whether they're
 308 // dynamically-linked or not.
 309 int rts_isDynamic(void)
 310 {
 311 #ifdef DYNAMIC
 312     return 1;
 313 #else
 314     return 0;
 315 #endif
 316 }
 317
 318 // Used for detecting a non-empty FPU stack on x86 (see #4914)
 319 void checkFPUStack(void)
 320 {
 321 #ifdef x86_HOST_ARCH
 322     static unsigned char buf[108];
 323     asm("FSAVE %0":"=m" (buf));
 324
 325     if(buf[8]!=255 || buf[9]!=255) {
 326         errorBelch("NONEMPTY FPU Stack, TAG = %x %x\n",buf[8],buf[9]);
 327         abort();
 328     }
 329 #endif
 330 }
 331