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(void)
 118 {
 119   StackOverflowHook(RtsFlags.GcFlags.maxStkSize * 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                       RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 134
 135         heap_overflow = rtsTrue;
 136     }
 137 }
 138
 139 /* -----------------------------------------------------------------------------
 140    genSym stuff, used by GHC itself for its splitting unique supply.
 141
 142    ToDo: put this somewhere sensible.
 143    -------------------------------------------------------------------------  */
 144
 145 static HsInt __GenSymCounter = 0;
 146
 147 HsInt
 148 genSymZh(void)
 149 {
 150     return(__GenSymCounter++);
 151 }
 152 HsInt
 153 resetGenSymZh(void) /* it's your funeral */
 154 {
 155     __GenSymCounter=0;
 156     return(__GenSymCounter);
 157 }
 158
 159 /* -----------------------------------------------------------------------------
 160    Get the current time as a string.  Used in profiling reports.
 161    -------------------------------------------------------------------------- */
 162
 163 char *
 164 time_str(void)
 165 {
 166     static time_t now = 0;
 167     static char nowstr[26];
 168
 169     if (now == 0) {
 170         time(&now);
 171 #if HAVE_CTIME_R
 172         ctime_r(&now, nowstr);
 173 #else
 174         strcpy(nowstr, ctime(&now));
 175 #endif
 176         memmove(nowstr+16,nowstr+19,7);
 177         nowstr[21] = '\0';  // removes the \n
 178     }
 179     return nowstr;
 180 }
 181
 182 /* -----------------------------------------------------------------------------
 183    Print large numbers, with punctuation.
 184    -------------------------------------------------------------------------- */
 185
 186 char *
 187 showStgWord64(StgWord64 x, char *s, rtsBool with_commas)
 188 {
 189     if (with_commas) {
 190         if (x < (StgWord64)1e3)
 191                 sprintf(s, "%" FMT_Word64, (StgWord64)x);
 192         else if (x < (StgWord64)1e6)
 193                 sprintf(s, "%" FMT_Word64 ",%03" FMT_Word64,
 194                         (StgWord64)(x / 1000),
 195                         (StgWord64)(x % 1000));
 196         else if (x < (StgWord64)1e9)
 197                 sprintf(s, "%"    FMT_Word64
 198                            ",%03" FMT_Word64
 199                            ",%03" FMT_Word64,
 200                         (StgWord64)(x / 1e6),
 201                         (StgWord64)((x / 1000) % 1000),
 202                         (StgWord64)(x          % 1000));
 203         else if (x < (StgWord64)1e12)
 204                 sprintf(s, "%"    FMT_Word64
 205                            ",%03" FMT_Word64
 206                            ",%03" FMT_Word64
 207                            ",%03" FMT_Word64,
 208                         (StgWord64)(x / (StgWord64)1e9),
 209                         (StgWord64)((x / (StgWord64)1e6) % 1000),
 210                         (StgWord64)((x / (StgWord64)1e3) % 1000),
 211                         (StgWord64)(x                    % 1000));
 212         else if (x < (StgWord64)1e15)
 213                 sprintf(s, "%"    FMT_Word64
 214                            ",%03" FMT_Word64
 215                            ",%03" FMT_Word64
 216                            ",%03" FMT_Word64
 217                            ",%03" FMT_Word64,
 218                         (StgWord64)(x / (StgWord64)1e12),
 219                         (StgWord64)((x / (StgWord64)1e9) % 1000),
 220                         (StgWord64)((x / (StgWord64)1e6) % 1000),
 221                         (StgWord64)((x / (StgWord64)1e3) % 1000),
 222                         (StgWord64)(x                    % 1000));
 223         else if (x < (StgWord64)1e18)
 224                 sprintf(s, "%"    FMT_Word64
 225                            ",%03" FMT_Word64
 226                            ",%03" FMT_Word64
 227                            ",%03" FMT_Word64
 228                            ",%03" FMT_Word64
 229                            ",%03" FMT_Word64,
 230                         (StgWord64)(x / (StgWord64)1e15),
 231                         (StgWord64)((x / (StgWord64)1e12) % 1000),
 232                         (StgWord64)((x / (StgWord64)1e9)  % 1000),
 233                         (StgWord64)((x / (StgWord64)1e6)  % 1000),
 234                         (StgWord64)((x / (StgWord64)1e3)  % 1000),
 235                         (StgWord64)(x                     % 1000));
 236         else
 237                 sprintf(s, "%"    FMT_Word64
 238                            ",%03" FMT_Word64
 239                            ",%03" FMT_Word64
 240                            ",%03" FMT_Word64
 241                            ",%03" FMT_Word64
 242                            ",%03" FMT_Word64
 243                            ",%03" FMT_Word64,
 244                         (StgWord64)(x / (StgWord64)1e18),
 245                         (StgWord64)((x / (StgWord64)1e15) % 1000),
 246                         (StgWord64)((x / (StgWord64)1e12) % 1000),
 247                         (StgWord64)((x / (StgWord64)1e9)  % 1000),
 248                         (StgWord64)((x / (StgWord64)1e6)  % 1000),
 249                         (StgWord64)((x / (StgWord64)1e3)  % 1000),
 250                         (StgWord64)(x                     % 1000));
 251     }
 252     else {
 253         sprintf(s, "%" FMT_Word64, x);
 254     }
 255     return s;
 256 }
 257
 258
 259 // Can be used as a breakpoint to set on every heap check failure.
 260 #ifdef DEBUG
 261 void
 262 heapCheckFail( void )
 263 {
 264 }
 265 #endif
 266
 267 /*
 268  * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
 269  * pthreads (and possibly others). When linking with -lpthreads, we
 270  * have to use pthread_kill to send blockable signals. So use that
 271  * when we have a threaded rts. So System.Posix.Signals will call
 272  * genericRaise(), rather than raise(3).
 273  */
 274 int genericRaise(int sig) {
 275 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS))
 276         return pthread_kill(pthread_self(), sig);
 277 #else
 278         return raise(sig);
 279 #endif
 280 }
 281
 282 static void mkRtsInfoPair(char *key, char *val) {
 283     /* XXX should check for "s, \s etc in key and val */
 284     printf(" ,(\"%s\", \"%s\")\n", key, val);
 285 }
 286
 287 /* This little bit of magic allows us to say TOSTRING(SYM) and get
 288  * "5" if SYM is 5 */
 289 #define TOSTRING2(x) #x
 290 #define TOSTRING(x)  TOSTRING2(x)
 291
 292 void printRtsInfo(void) {
 293     /* The first entry is just a hack to make it easy to get the
 294      * commas right */
 295     printf(" [(\"GHC RTS\", \"YES\")\n");
 296     mkRtsInfoPair("GHC version",             ProjectVersion);
 297     mkRtsInfoPair("RTS way",                 RtsWay);
 298     mkRtsInfoPair("Build platform",          BuildPlatform);
 299     mkRtsInfoPair("Build architecture",      BuildArch);
 300     mkRtsInfoPair("Build OS",                BuildOS);
 301     mkRtsInfoPair("Build vendor",            BuildVendor);
 302     mkRtsInfoPair("Host platform",           HostPlatform);
 303     mkRtsInfoPair("Host architecture",       HostArch);
 304     mkRtsInfoPair("Host OS",                 HostOS);
 305     mkRtsInfoPair("Host vendor",             HostVendor);
 306     mkRtsInfoPair("Target platform",         TargetPlatform);
 307     mkRtsInfoPair("Target architecture",     TargetArch);
 308     mkRtsInfoPair("Target OS",               TargetOS);
 309     mkRtsInfoPair("Target vendor",           TargetVendor);
 310     mkRtsInfoPair("Word size",               TOSTRING(WORD_SIZE_IN_BITS));
 311     mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
 312     mkRtsInfoPair("Tables next to code",     GhcEnableTablesNextToCode);
 313     printf(" ]\n");
 314 }
 315
 316 // Provides a way for Haskell programs to tell whether they're being
 317 // profiled or not.  GHCi uses it (see #2197).
 318 int rts_isProfiled(void)
 319 {
 320 #ifdef PROFILING
 321     return 1;
 322 #else
 323     return 0;
 324 #endif
 325 }
 326
 327 // Used for detecting a non-empty FPU stack on x86 (see #4914)
 328 void checkFPUStack(void)
 329 {
 330 #ifdef x86_HOST_ARCH
 331     static unsigned char buf[108];
 332     asm("FSAVE %0":"=m" (buf));
 333
 334     if(buf[8]!=255 || buf[9]!=255) {
 335         errorBelch("NONEMPTY FPU Stack, TAG = %x %x\n",buf[8],buf[9]);
 336         abort();
 337     }
 338 #endif
 339 }
 340