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

9
/* gettimeofday isn't POSIX */
10
/* #include "PosixSource.h" */
11

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

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

22
23
24
25
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif

26
27
28
29
#ifdef HAVE_GETTIMEOFDAY
#include <sys/time.h>
#endif

30
31
#include <stdlib.h>
#include <string.h>
32
#include <stdarg.h>
33
#include <stdio.h>
34

35
36
37
38
#ifdef HAVE_SIGNAL_H
#include <signal.h>
#endif

39
#if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
40
#include <pthread.h>
dons's avatar
dons committed
41
42
#endif

43
#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS)
44
45
46
47
48
49
50
51
52
53
54
55
56
#include <unistd.h>
#include <sys/types.h>
#include <sys/mman.h>

/* no C99 header stdint.h on OpenBSD? */
#if defined(openbsd_HOST_OS)
typedef unsigned long my_uintptr_t;
#else
#include <stdint.h>
typedef uintptr_t my_uintptr_t;
#endif
#endif

57
58
59
60
#if defined(_WIN32)
#include <windows.h>
#endif

61
62
63
/* -----------------------------------------------------------------------------
   Result-checking malloc wrappers.
   -------------------------------------------------------------------------- */
64
65
66
67
68
69
70

void *
stgMallocBytes (int n, char *msg)
{
    char *space;

    if ((space = (char *) malloc((size_t) n)) == NULL) {
71
      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
72
73
      MallocFailHook((W_) n, msg); /*msg*/
      stg_exit(EXIT_INTERNAL_ERROR);
74
75
76
77
78
79
80
81
82
83
    }
    return space;
}

void *
stgReallocBytes (void *p, int n, char *msg)
{
    char *space;

    if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
84
      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
85
86
      MallocFailHook((W_) n, msg); /*msg*/
      stg_exit(EXIT_INTERNAL_ERROR);
87
88
89
90
    }
    return space;
}

91
92
93
void *
stgCallocBytes (int n, int m, char *msg)
{
94
95
96
97
98
99
100
101
    char *space;

    if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
      MallocFailHook((W_) n*m, msg); /*msg*/
      stg_exit(EXIT_INTERNAL_ERROR);
    }
    return space;
102
103
}

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

113
114
115
116
117
118
119
/* -----------------------------------------------------------------------------
   Stack overflow
   
   Not sure if this belongs here.
   -------------------------------------------------------------------------- */

void
120
stackOverflow(void)
121
{
122
  StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
123
124

#if defined(TICKY_TICKY)
125
  if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
126
127
128
129
130
131
#endif
}

void
heapOverflow(void)
{
132
133
134
135
  /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  OutOfHeapHook(0/*unknown request size*/, 
		RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
  
136
#if defined(TICKY_TICKY)
137
  if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
138
139
#endif

140
  stg_exit(EXIT_HEAPOVERFLOW);
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
}

/* -----------------------------------------------------------------------------
   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.
   -------------------------------------------------------------------------  */

165
static I_ __GenSymCounter = 0;
166
167

I_
168
genSymZh(void)
169
170
171
172
{
    return(__GenSymCounter++);
}
I_
173
resetGenSymZh(void) /* it's your funeral */
174
175
176
177
178
179
180
181
182
{
    __GenSymCounter=0;
    return(__GenSymCounter);
}

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

183
#if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
184
185
186
187
188
189
190
191
char *
time_str(void)
{
    static time_t now = 0;
    static char nowstr[26];

    if (now == 0) {
	time(&now);
192
193
194
#if HAVE_CTIME_R
	ctime_r(&now, nowstr);
#else
195
	strcpy(nowstr, ctime(&now));
196
197
198
#endif
	memmove(nowstr+16,nowstr+19,7);
	nowstr[21] = '\0';  // removes the \n
199
200
201
202
203
    }
    return nowstr;
}
#endif

204
205
206
207
208
209
/* -----------------------------------------------------------------------------
 * 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.
 * -------------------------------------------------------------------------- */

210
#if !defined(mingw32_HOST_OS)
211
212
213
214
215
216
217
218
219
220
221
222
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);
  }
}

223
224
225
226
227
228
229
void
setNonBlockingFd(int fd)
{
  long fd_flags;

  /* clear the non-blocking flag on this file descriptor */
  fd_flags = fcntl(fd, F_GETFL);
230
231
232
  if (!(fd_flags & O_NONBLOCK)) {
    fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
  }
233
}
sof's avatar
sof committed
234
#else
sof's avatar
sof committed
235
236
237
/* Stub defns -- async / non-blocking IO is not done 
 * via O_NONBLOCK and select() under Win32. 
 */
sof's avatar
sof committed
238
239
240
void resetNonBlockingFd(int fd STG_UNUSED) {}
void setNonBlockingFd(int fd STG_UNUSED) {}
#endif
241

sof's avatar
sof committed
242
#ifdef PAR
243
244
245
246
247
248
static ullong startTime = 0;

/* used in a parallel setup */
ullong
msTime(void)
{
249
# if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
250
251
252
253
254
255
256
257
    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;
258
# elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
    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
}
sof's avatar
sof committed
277
#endif /* PAR */
278

279
280
281
282
283
284
285
286
/* -----------------------------------------------------------------------------
   Print large numbers, with punctuation.
   -------------------------------------------------------------------------- */

char *
ullong_format_string(ullong x, char *s, rtsBool with_commas)
{
    if (x < (ullong)1000) 
287
	sprintf(s, "%lu", (lnat)x);
288
    else if (x < (ullong)1000000)
289
290
291
	sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
		(lnat)((x)/(ullong)1000),
		(lnat)((x)%(ullong)1000));
292
    else if (x < (ullong)1000000000)
293
294
295
296
	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));
297
    else
298
299
300
301
302
	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));
303
304
    return s;
}
305
306
307
308
309
310
311
312
313
314


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

dons's avatar
dons committed
315
/* 
316
317
 * 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
318
319
320
321
322
 * 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) {
323
#if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
dons's avatar
dons committed
324
        return pthread_kill(pthread_self(), sig);
dons's avatar
dons committed
325
#else
dons's avatar
dons committed
326
327
        return raise(sig);
#endif
dons's avatar
dons committed
328
}
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354

/* -----------------------------------------------------------------------------
   Allocating executable memory
   -------------------------------------------------------------------------- */

/* Heavily arch-specific, I'm afraid.. */

/*
 * Allocate len bytes which are readable, writable, and executable.
 *
 * ToDo: If this turns out to be a performance bottleneck, one could
 * e.g. cache the last VirtualProtect/mprotect-ed region and do
 * nothing in case of a cache hit.
 */
void*
stgMallocBytesRWX(int len)
{
  void *addr = stgMallocBytes(len, "mallocBytesRWX");
#if defined(i386_HOST_ARCH) && defined(_WIN32)
  /* This could be necessary for processors which distinguish between READ and
     EXECUTE memory accesses, e.g. Itaniums. */
  DWORD dwOldProtect = 0;
  if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) {
    barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
         addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
  }
355
#elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS)
356
357
358
359
360
361
362
363
364
365
366
367
  /* malloced memory isn't executable by default on OpenBSD */
  my_uintptr_t pageSize         = sysconf(_SC_PAGESIZE);
  my_uintptr_t mask             = ~(pageSize - 1);
  my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr          ) & mask;
  my_uintptr_t startOfLastPage  = ((my_uintptr_t)addr + len - 1) & mask;
  my_uintptr_t size             = startOfLastPage - startOfFirstPage + pageSize;
  if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) {
    barf("mallocBytesRWX: failed to protect 0x%p\n", addr);
  }
#endif
  return addr;
}