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