1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.27 2002/08/16 13:29:07 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
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 error function. */
40 void barf(char *s, ...)
44 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
45 if (prog_argv != NULL && prog_argv[0] != NULL) {
46 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
48 fprintf(stderr, "fatal error: ");
50 vfprintf(stderr, s, ap);
51 fprintf(stderr, "\n");
53 stg_exit(EXIT_INTERNAL_ERROR);
57 void prog_belch(char *s, ...)
61 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
62 if (prog_argv != NULL && prog_argv[0] != NULL) {
63 fprintf(stderr, "%s: ", prog_argv[0]);
65 vfprintf(stderr, s, ap);
66 fprintf(stderr, "\n");
70 void belch(char *s, ...)
74 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
75 vfprintf(stderr, s, ap);
76 fprintf(stderr, "\n");
80 /* result-checking malloc wrappers. */
83 stgMallocBytes (int n, char *msg)
87 if ((space = (char *) malloc((size_t) n)) == NULL) {
88 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
89 MallocFailHook((W_) n, msg); /*msg*/
90 stg_exit(EXIT_INTERNAL_ERROR);
96 stgReallocBytes (void *p, int n, char *msg)
100 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
101 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
102 MallocFailHook((W_) n, msg); /*msg*/
103 stg_exit(EXIT_INTERNAL_ERROR);
109 stgMallocWords (int n, char *msg)
111 return(stgMallocBytes(n * sizeof(W_), msg));
115 stgReallocWords (void *p, int n, char *msg)
117 return(stgReallocBytes(p, n * sizeof(W_), msg));
121 stgCallocBytes (int n, int m, char *msg)
125 char* p = stgMallocBytes(sz, msg);
126 for (i = 0; i < sz; i++) p[i] = 0;
131 _stgAssert (char *filename, unsigned int linenum)
134 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
139 /* -----------------------------------------------------------------------------
142 Not sure if this belongs here.
143 -------------------------------------------------------------------------- */
148 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
150 #if defined(TICKY_TICKY)
151 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
158 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
159 OutOfHeapHook(0/*unknown request size*/,
160 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
162 #if defined(TICKY_TICKY)
163 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
166 stg_exit(EXIT_HEAPOVERFLOW);
169 /* -----------------------------------------------------------------------------
172 Used in addr2Integer because the C compiler on x86 chokes on
173 strlen, trying to inline it with not enough registers available.
174 -------------------------------------------------------------------------- */
176 nat stg_strlen(char *s)
185 /* -----------------------------------------------------------------------------
186 genSym stuff, used by GHC itself for its splitting unique supply.
188 ToDo: put this somewhere sensible.
189 ------------------------------------------------------------------------- */
191 static I_ __GenSymCounter = 0;
196 return(__GenSymCounter++);
199 resetGenSymZh(void) /* it's your funeral */
202 return(__GenSymCounter);
205 /* -----------------------------------------------------------------------------
206 Get the current time as a string. Used in profiling reports.
207 -------------------------------------------------------------------------- */
209 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
213 static time_t now = 0;
214 static char nowstr[26];
218 strcpy(nowstr, ctime(&now));
219 strcpy(nowstr+16,nowstr+19);
226 /* -----------------------------------------------------------------------------
227 * Reset a file handle to blocking mode. We do this for the standard
228 * file descriptors before exiting, because the shell doesn't always
230 * -------------------------------------------------------------------------- */
232 #if !defined(mingw32_TARGET_OS)
234 resetNonBlockingFd(int fd)
238 /* clear the non-blocking flag on this file descriptor */
239 fd_flags = fcntl(fd, F_GETFL);
240 if (fd_flags & O_NONBLOCK) {
241 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
246 setNonBlockingFd(int fd)
250 /* clear the non-blocking flag on this file descriptor */
251 fd_flags = fcntl(fd, F_GETFL);
252 fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
255 /* Don't support non-blocking FDs (yet) on mingw */
256 void resetNonBlockingFd(int fd STG_UNUSED) {}
257 void setNonBlockingFd(int fd STG_UNUSED) {}
260 static ullong startTime = 0;
262 /* used in a parallel setup */
266 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH) && !defined(hppa1_1_TARGET_ARCH)
269 if (getclock(TIMEOFDAY, &tv) != 0) {
271 fprintf(stderr, "Clock failed\n");
272 stg_exit(EXIT_FAILURE);
274 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
275 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
278 if (gettimeofday(&tv, NULL) != 0) {
280 fprintf(stderr, "Clock failed\n");
281 stg_exit(EXIT_FAILURE);
283 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
286 if ((t = time(NULL)) == (time_t) -1) {
288 fprintf(stderr, "Clock failed\n");
289 stg_exit(EXIT_FAILURE);
291 return t * LL(1000) - startTime;
295 /* -----------------------------------------------------------------------------
296 Print large numbers, with punctuation.
297 -------------------------------------------------------------------------- */
300 ullong_format_string(ullong x, char *s, rtsBool with_commas)
302 if (x < (ullong)1000)
303 sprintf(s, "%d", (nat)x);
304 else if (x < (ullong)1000000)
305 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
306 (nat)((x)/(ullong)1000),
307 (nat)((x)%(ullong)1000));
308 else if (x < (ullong)1000000000)
309 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
310 (nat)((x)/(ullong)1000000),
311 (nat)((x)/(ullong)1000%(ullong)1000),
312 (nat)((x)%(ullong)1000));
314 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
315 (nat)((x)/(ullong)1000000000),
316 (nat)((x)/(ullong)1000000%(ullong)1000),
317 (nat)((x)/(ullong)1000%(ullong)1000),
318 (nat)((x)%(ullong)1000));