1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.29 2002/12/11 15:36:48 simonmar Exp $
4 * (c) The GHC Team, 1998-2002
6 * General utility functions used in the RTS.
8 * ---------------------------------------------------------------------------*/
10 /* gettimeofday isn't POSIX */
11 /* #include "PosixSource.h" */
30 #ifdef HAVE_GETTIMEOFDAY
38 /* variable-argument internal error function. */
45 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
46 if (prog_argv != NULL && prog_argv[0] != NULL) {
47 fprintf(stderr, "%s: internal error: ", prog_argv[0]);
49 fprintf(stderr, "internal error: ");
51 vfprintf(stderr, s, ap);
52 fprintf(stderr, "\n");
53 fprintf(stderr, " Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n or http://www.sourceforge.net/projects/ghc/\n");
55 stg_exit(EXIT_INTERNAL_ERROR);
60 prog_belch(char *s, ...)
64 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
65 if (prog_argv != NULL && prog_argv[0] != NULL) {
66 fprintf(stderr, "%s: ", prog_argv[0]);
68 vfprintf(stderr, s, ap);
69 fprintf(stderr, "\n");
78 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
79 vfprintf(stderr, s, ap);
80 fprintf(stderr, "\n");
84 /* result-checking malloc wrappers. */
87 stgMallocBytes (int n, char *msg)
91 if ((space = (char *) malloc((size_t) n)) == NULL) {
92 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
93 MallocFailHook((W_) n, msg); /*msg*/
94 stg_exit(EXIT_INTERNAL_ERROR);
100 stgReallocBytes (void *p, int n, char *msg)
104 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
105 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
106 MallocFailHook((W_) n, msg); /*msg*/
107 stg_exit(EXIT_INTERNAL_ERROR);
113 stgMallocWords (int n, char *msg)
115 return(stgMallocBytes(n * sizeof(W_), msg));
119 stgReallocWords (void *p, int n, char *msg)
121 return(stgReallocBytes(p, n * sizeof(W_), msg));
125 stgCallocBytes (int n, int m, char *msg)
129 char* p = stgMallocBytes(sz, msg);
130 for (i = 0; i < sz; i++) p[i] = 0;
135 _stgAssert (char *filename, unsigned int linenum)
138 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
143 /* -----------------------------------------------------------------------------
146 Not sure if this belongs here.
147 -------------------------------------------------------------------------- */
152 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
154 #if defined(TICKY_TICKY)
155 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
162 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
163 OutOfHeapHook(0/*unknown request size*/,
164 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
166 #if defined(TICKY_TICKY)
167 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
170 stg_exit(EXIT_HEAPOVERFLOW);
173 /* -----------------------------------------------------------------------------
176 Used in addr2Integer because the C compiler on x86 chokes on
177 strlen, trying to inline it with not enough registers available.
178 -------------------------------------------------------------------------- */
180 nat stg_strlen(char *s)
189 /* -----------------------------------------------------------------------------
190 genSym stuff, used by GHC itself for its splitting unique supply.
192 ToDo: put this somewhere sensible.
193 ------------------------------------------------------------------------- */
195 static I_ __GenSymCounter = 0;
200 return(__GenSymCounter++);
203 resetGenSymZh(void) /* it's your funeral */
206 return(__GenSymCounter);
209 /* -----------------------------------------------------------------------------
210 Get the current time as a string. Used in profiling reports.
211 -------------------------------------------------------------------------- */
213 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
217 static time_t now = 0;
218 static char nowstr[26];
222 strcpy(nowstr, ctime(&now));
223 strcpy(nowstr+16,nowstr+19);
230 /* -----------------------------------------------------------------------------
231 * Reset a file handle to blocking mode. We do this for the standard
232 * file descriptors before exiting, because the shell doesn't always
234 * -------------------------------------------------------------------------- */
236 #if !defined(mingw32_TARGET_OS)
238 resetNonBlockingFd(int fd)
242 /* clear the non-blocking flag on this file descriptor */
243 fd_flags = fcntl(fd, F_GETFL);
244 if (fd_flags & O_NONBLOCK) {
245 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
250 setNonBlockingFd(int fd)
254 /* clear the non-blocking flag on this file descriptor */
255 fd_flags = fcntl(fd, F_GETFL);
256 fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
259 /* Don't support non-blocking FDs (yet) on mingw */
260 void resetNonBlockingFd(int fd STG_UNUSED) {}
261 void setNonBlockingFd(int fd STG_UNUSED) {}
264 static ullong startTime = 0;
266 /* used in a parallel setup */
270 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH) && !defined(hppa1_1_TARGET_ARCH)
273 if (getclock(TIMEOFDAY, &tv) != 0) {
275 fprintf(stderr, "Clock failed\n");
276 stg_exit(EXIT_FAILURE);
278 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
279 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
282 if (gettimeofday(&tv, NULL) != 0) {
284 fprintf(stderr, "Clock failed\n");
285 stg_exit(EXIT_FAILURE);
287 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
290 if ((t = time(NULL)) == (time_t) -1) {
292 fprintf(stderr, "Clock failed\n");
293 stg_exit(EXIT_FAILURE);
295 return t * LL(1000) - startTime;
299 /* -----------------------------------------------------------------------------
300 Print large numbers, with punctuation.
301 -------------------------------------------------------------------------- */
304 ullong_format_string(ullong x, char *s, rtsBool with_commas)
306 if (x < (ullong)1000)
307 sprintf(s, "%lu", (lnat)x);
308 else if (x < (ullong)1000000)
309 sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
310 (lnat)((x)/(ullong)1000),
311 (lnat)((x)%(ullong)1000));
312 else if (x < (ullong)1000000000)
313 sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu",
314 (lnat)((x)/(ullong)1000000),
315 (lnat)((x)/(ullong)1000%(ullong)1000),
316 (lnat)((x)%(ullong)1000));
318 sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
319 (lnat)((x)/(ullong)1000000000),
320 (lnat)((x)/(ullong)1000000%(ullong)1000),
321 (lnat)((x)/(ullong)1000%(ullong)1000),
322 (lnat)((x)%(ullong)1000));
327 // Can be used as a breakpoint to set on every heap check failure.
330 heapCheckFail( void )