1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * General utility functions used in the RTS.
7 * ---------------------------------------------------------------------------*/
9 /* gettimeofday isn't POSIX */
10 /* #include "PosixSource.h" */
19 #ifdef solaris2_HOST_OS
20 // Solaris requires this to get access to the POSIX ctime_r()
21 #define _POSIX_PTHREAD_SEMANTICS
24 #ifdef solaris2_HOST_OS
25 #undef _POSIX_PTHREAD_SEMANTICS
33 #ifdef HAVE_GETTIMEOFDAY
46 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
50 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS)
52 #include <sys/types.h>
55 /* no C99 header stdint.h on OpenBSD? */
56 #if defined(openbsd_HOST_OS)
57 typedef unsigned long my_uintptr_t;
60 typedef uintptr_t my_uintptr_t;
68 /* -----------------------------------------------------------------------------
69 Result-checking malloc wrappers.
70 -------------------------------------------------------------------------- */
73 stgMallocBytes (int n, char *msg)
77 if ((space = (char *) malloc((size_t) n)) == NULL) {
78 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
79 MallocFailHook((W_) n, msg); /*msg*/
80 stg_exit(EXIT_INTERNAL_ERROR);
86 stgReallocBytes (void *p, int n, char *msg)
90 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
91 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
92 MallocFailHook((W_) n, msg); /*msg*/
93 stg_exit(EXIT_INTERNAL_ERROR);
99 stgCallocBytes (int n, int m, char *msg)
103 if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
104 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
105 MallocFailHook((W_) n*m, msg); /*msg*/
106 stg_exit(EXIT_INTERNAL_ERROR);
111 /* To simplify changing the underlying allocator used
112 * by stgMallocBytes(), provide stgFree() as well.
120 /* -----------------------------------------------------------------------------
123 Not sure if this belongs here.
124 -------------------------------------------------------------------------- */
129 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
131 #if defined(TICKY_TICKY)
132 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
139 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
140 OutOfHeapHook(0/*unknown request size*/,
141 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
143 #if defined(TICKY_TICKY)
144 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
147 stg_exit(EXIT_HEAPOVERFLOW);
150 /* -----------------------------------------------------------------------------
153 Used in addr2Integer because the C compiler on x86 chokes on
154 strlen, trying to inline it with not enough registers available.
155 -------------------------------------------------------------------------- */
157 nat stg_strlen(char *s)
166 /* -----------------------------------------------------------------------------
167 genSym stuff, used by GHC itself for its splitting unique supply.
169 ToDo: put this somewhere sensible.
170 ------------------------------------------------------------------------- */
172 static I_ __GenSymCounter = 0;
177 return(__GenSymCounter++);
180 resetGenSymZh(void) /* it's your funeral */
183 return(__GenSymCounter);
186 /* -----------------------------------------------------------------------------
187 Get the current time as a string. Used in profiling reports.
188 -------------------------------------------------------------------------- */
190 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
194 static time_t now = 0;
195 static char nowstr[26];
200 ctime_r(&now, nowstr);
202 strcpy(nowstr, ctime(&now));
204 memmove(nowstr+16,nowstr+19,7);
205 nowstr[21] = '\0'; // removes the \n
211 /* -----------------------------------------------------------------------------
212 * Reset a file handle to blocking mode. We do this for the standard
213 * file descriptors before exiting, because the shell doesn't always
215 * -------------------------------------------------------------------------- */
217 #if !defined(mingw32_HOST_OS)
219 resetNonBlockingFd(int fd)
223 /* clear the non-blocking flag on this file descriptor */
224 fd_flags = fcntl(fd, F_GETFL);
225 if (fd_flags & O_NONBLOCK) {
226 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
231 setNonBlockingFd(int fd)
235 /* clear the non-blocking flag on this file descriptor */
236 fd_flags = fcntl(fd, F_GETFL);
237 if (!(fd_flags & O_NONBLOCK)) {
238 fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
242 /* Stub defns -- async / non-blocking IO is not done
243 * via O_NONBLOCK and select() under Win32.
245 void resetNonBlockingFd(int fd STG_UNUSED) {}
246 void setNonBlockingFd(int fd STG_UNUSED) {}
250 static ullong startTime = 0;
252 /* used in a parallel setup */
256 # if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
259 if (getclock(TIMEOFDAY, &tv) != 0) {
261 fprintf(stderr, "Clock failed\n");
262 stg_exit(EXIT_FAILURE);
264 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
265 # elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
268 if (gettimeofday(&tv, NULL) != 0) {
270 fprintf(stderr, "Clock failed\n");
271 stg_exit(EXIT_FAILURE);
273 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
276 if ((t = time(NULL)) == (time_t) -1) {
278 fprintf(stderr, "Clock failed\n");
279 stg_exit(EXIT_FAILURE);
281 return t * LL(1000) - startTime;
286 /* -----------------------------------------------------------------------------
287 Print large numbers, with punctuation.
288 -------------------------------------------------------------------------- */
291 ullong_format_string(ullong x, char *s, rtsBool with_commas)
293 if (x < (ullong)1000)
294 sprintf(s, "%lu", (lnat)x);
295 else if (x < (ullong)1000000)
296 sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
297 (lnat)((x)/(ullong)1000),
298 (lnat)((x)%(ullong)1000));
299 else if (x < (ullong)1000000000)
300 sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu",
301 (lnat)((x)/(ullong)1000000),
302 (lnat)((x)/(ullong)1000%(ullong)1000),
303 (lnat)((x)%(ullong)1000));
305 sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
306 (lnat)((x)/(ullong)1000000000),
307 (lnat)((x)/(ullong)1000000%(ullong)1000),
308 (lnat)((x)/(ullong)1000%(ullong)1000),
309 (lnat)((x)%(ullong)1000));
314 // Can be used as a breakpoint to set on every heap check failure.
317 heapCheckFail( void )
323 * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
324 * pthreads (and possibly others). When linking with -lpthreads, we
325 * have to use pthread_kill to send blockable signals. So use that
326 * when we have a threaded rts. So System.Posix.Signals will call
327 * genericRaise(), rather than raise(3).
329 int genericRaise(int sig) {
330 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
331 return pthread_kill(pthread_self(), sig);
337 /* -----------------------------------------------------------------------------
338 Allocating executable memory
339 -------------------------------------------------------------------------- */
341 /* Heavily arch-specific, I'm afraid.. */
344 * Allocate len bytes which are readable, writable, and executable.
346 * ToDo: If this turns out to be a performance bottleneck, one could
347 * e.g. cache the last VirtualProtect/mprotect-ed region and do
348 * nothing in case of a cache hit.
351 stgMallocBytesRWX(int len)
353 void *addr = stgMallocBytes(len, "mallocBytesRWX");
354 #if defined(i386_HOST_ARCH) && defined(_WIN32)
355 /* This could be necessary for processors which distinguish between READ and
356 EXECUTE memory accesses, e.g. Itaniums. */
357 DWORD dwOldProtect = 0;
358 if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) {
359 barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
360 addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
362 #elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS)
363 /* malloced memory isn't executable by default on OpenBSD */
364 my_uintptr_t pageSize = sysconf(_SC_PAGESIZE);
365 my_uintptr_t mask = ~(pageSize - 1);
366 my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr ) & mask;
367 my_uintptr_t startOfLastPage = ((my_uintptr_t)addr + len - 1) & mask;
368 my_uintptr_t size = startOfLastPage - startOfFirstPage + pageSize;
369 if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) {
370 barf("mallocBytesRWX: failed to protect 0x%p\n", addr);