RtsUtils.c 9.95 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 *
3
 * (c) The GHC Team, 1998-2004
4 5 6 7 8
 *
 * General utility functions used in the RTS.
 *
 * ---------------------------------------------------------------------------*/

Simon Marlow's avatar
Simon Marlow committed
9
#include "PosixSource.h"
10 11
#include "Rts.h"
#include "RtsAPI.h"
Simon Marlow's avatar
Simon Marlow committed
12

13
#include "RtsUtils.h"
14
#include "Ticky.h"
15
#include "Schedule.h"
16
#include "RtsFlags.h"
17 18 19 20 21

#ifdef HAVE_TIME_H
#include <time.h>
#endif

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
22 23 24 25 26 27 28
/* 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 HAVE_CTIME_R && !HAVE_DECL_CTIME_R
extern char *ctime_r(const time_t *, char *);
#endif

29 30 31 32
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif

33 34 35 36
#ifdef HAVE_GETTIMEOFDAY
#include <sys/time.h>
#endif

37 38
#include <stdlib.h>
#include <string.h>
39
#include <stdarg.h>
40
#include <stdio.h>
41

42 43 44 45
#ifdef HAVE_SIGNAL_H
#include <signal.h>
#endif

46
#if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
47
#include <pthread.h>
dons's avatar
dons committed
48 49
#endif

50

51 52 53 54
#if defined(_WIN32)
#include <windows.h>
#endif

55 56 57
/* -----------------------------------------------------------------------------
   Result-checking malloc wrappers.
   -------------------------------------------------------------------------- */
58 59 60 61 62

void *
stgMallocBytes (int n, char *msg)
{
    char *space;
63
    size_t n2;
64

65 66
    n2 = (size_t) n;
    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 72 73 74 75 76 77
    }
    return space;
}

void *
stgReallocBytes (void *p, int n, char *msg)
{
    char *space;
78
    size_t n2;
79

80 81
    n2 = (size_t) n;
    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 87 88
    }
    return space;
}

89 90 91
void *
stgCallocBytes (int n, int m, char *msg)
{
92 93 94 95
    char *space;

    if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
96
      rtsConfig.mallocFailHook((W_) n*m, msg); /*msg*/
97 98 99
      stg_exit(EXIT_INTERNAL_ERROR);
    }
    return space;
100 101
}

sof's avatar
sof committed
102 103 104 105 106 107 108 109 110
/* To simplify changing the underlying allocator used
 * by stgMallocBytes(), provide stgFree() as well.
 */
void
stgFree(void* p)
{
  free(p);
}

111 112
/* -----------------------------------------------------------------------------
   Stack overflow
113

114 115 116 117
   Not sure if this belongs here.
   -------------------------------------------------------------------------- */

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 125 126 127 128 129
#endif
}

void
heapOverflow(void)
{
130 131 132
    if (!heap_overflow)
    {
        /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
133 134
        rtsConfig.outOfHeapHook(0/*unknown request size*/,
                                (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
135

136 137
        heap_overflow = rtsTrue;
    }
138 139 140 141 142 143 144 145 146 147 148 149 150
}

/* -----------------------------------------------------------------------------
   Get the current time as a string.  Used in profiling reports.
   -------------------------------------------------------------------------- */

char *
time_str(void)
{
    static time_t now = 0;
    static char nowstr[26];

    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 158
        memmove(nowstr+16,nowstr+19,7);
        nowstr[21] = '\0';  // removes the \n
159 160 161 162 163 164 165 166 167
    }
    return nowstr;
}

/* -----------------------------------------------------------------------------
   Print large numbers, with punctuation.
   -------------------------------------------------------------------------- */

char *
Ian Lynagh's avatar
Ian Lynagh committed
168
showStgWord64(StgWord64 x, char *s, rtsBool with_commas)
169
{
Ian Lynagh's avatar
Ian Lynagh committed
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
    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);
    }
236 237
    return s;
}
238 239 240 241 242 243 244 245 246 247


// Can be used as a breakpoint to set on every heap check failure.
#ifdef DEBUG
void
heapCheckFail( void )
{
}
#endif

248
/*
249 250
 * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
 * pthreads (and possibly others). When linking with -lpthreads, we
dons's avatar
dons committed
251 252 253 254 255
 * have to use pthread_kill to send blockable signals. So use that
 * when we have a threaded rts. So System.Posix.Signals will call
 * genericRaise(), rather than raise(3).
 */
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))
dons's avatar
dons committed
257
        return pthread_kill(pthread_self(), sig);
dons's avatar
dons committed
258
#else
dons's avatar
dons committed
259 260
        return raise(sig);
#endif
dons's avatar
dons committed
261
}
262 263 264 265 266 267

static void mkRtsInfoPair(char *key, char *val) {
    /* XXX should check for "s, \s etc in key and val */
    printf(" ,(\"%s\", \"%s\")\n", key, val);
}

268 269 270 271 272
/* 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)

273 274 275
void printRtsInfo(void) {
    /* The first entry is just a hack to make it easy to get the
     * commas right */
276
    printf(" [(\"GHC RTS\", \"YES\")\n");
277 278 279
    mkRtsInfoPair("GHC version",             ProjectVersion);
    mkRtsInfoPair("RTS way",                 RtsWay);
    mkRtsInfoPair("Build platform",          BuildPlatform);
280 281 282
    mkRtsInfoPair("Build architecture",      BuildArch);
    mkRtsInfoPair("Build OS",                BuildOS);
    mkRtsInfoPair("Build vendor",            BuildVendor);
Ian Lynagh's avatar
Ian Lynagh committed
283 284 285 286
    mkRtsInfoPair("Host platform",           HostPlatform);
    mkRtsInfoPair("Host architecture",       HostArch);
    mkRtsInfoPair("Host OS",                 HostOS);
    mkRtsInfoPair("Host vendor",             HostVendor);
287
    mkRtsInfoPair("Target platform",         TargetPlatform);
288 289 290
    mkRtsInfoPair("Target architecture",     TargetArch);
    mkRtsInfoPair("Target OS",               TargetOS);
    mkRtsInfoPair("Target vendor",           TargetVendor);
291
    mkRtsInfoPair("Word size",               TOSTRING(WORD_SIZE_IN_BITS));
292 293 294 295 296
    mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
    mkRtsInfoPair("Tables next to code",     GhcEnableTablesNextToCode);
    printf(" ]\n");
}

Simon Marlow's avatar
Simon Marlow committed
297 298 299 300 301 302 303 304 305 306
// Provides a way for Haskell programs to tell whether they're being
// profiled or not.  GHCi uses it (see #2197).
int rts_isProfiled(void)
{
#ifdef PROFILING
    return 1;
#else
    return 0;
#endif
}
307

308 309 310 311 312 313 314 315 316 317 318
// Provides a way for Haskell programs to tell whether they're
// dynamically-linked or not.
int rts_isDynamic(void)
{
#ifdef DYNAMIC
    return 1;
#else
    return 0;
#endif
}

319 320 321 322 323 324 325 326 327 328 329 330 331 332
// Used for detecting a non-empty FPU stack on x86 (see #4914)
void checkFPUStack(void)
{
#ifdef x86_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
}