1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.25 2002/05/18 05:28:14 ken 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
36 /* variable-argument error function. */
38 void barf(char *s, ...)
42 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
43 if (prog_argv != NULL && prog_argv[0] != NULL) {
44 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
46 fprintf(stderr, "fatal error: ");
48 vfprintf(stderr, s, ap);
49 fprintf(stderr, "\n");
51 stg_exit(EXIT_INTERNAL_ERROR);
55 void prog_belch(char *s, ...)
59 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
60 if (prog_argv != NULL && prog_argv[0] != NULL) {
61 fprintf(stderr, "%s: ", prog_argv[0]);
63 vfprintf(stderr, s, ap);
64 fprintf(stderr, "\n");
68 void belch(char *s, ...)
72 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
73 vfprintf(stderr, s, ap);
74 fprintf(stderr, "\n");
78 /* result-checking malloc wrappers. */
81 stgMallocBytes (int n, char *msg)
85 if ((space = (char *) malloc((size_t) n)) == NULL) {
86 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
87 MallocFailHook((W_) n, msg); /*msg*/
88 stg_exit(EXIT_INTERNAL_ERROR);
94 stgReallocBytes (void *p, int n, char *msg)
98 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
99 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
100 MallocFailHook((W_) n, msg); /*msg*/
101 stg_exit(EXIT_INTERNAL_ERROR);
107 stgMallocWords (int n, char *msg)
109 return(stgMallocBytes(n * sizeof(W_), msg));
113 stgReallocWords (void *p, int n, char *msg)
115 return(stgReallocBytes(p, n * sizeof(W_), msg));
119 stgCallocBytes (int n, int m, char *msg)
123 char* p = stgMallocBytes(sz, msg);
124 for (i = 0; i < sz; i++) p[i] = 0;
129 _stgAssert (char *filename, unsigned int linenum)
132 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
137 /* -----------------------------------------------------------------------------
140 Not sure if this belongs here.
141 -------------------------------------------------------------------------- */
146 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
148 #if defined(TICKY_TICKY)
149 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
156 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
157 OutOfHeapHook(0/*unknown request size*/,
158 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
160 #if defined(TICKY_TICKY)
161 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
164 stg_exit(EXIT_HEAPOVERFLOW);
167 /* -----------------------------------------------------------------------------
170 Used in addr2Integer because the C compiler on x86 chokes on
171 strlen, trying to inline it with not enough registers available.
172 -------------------------------------------------------------------------- */
174 nat stg_strlen(char *s)
183 /* -----------------------------------------------------------------------------
184 genSym stuff, used by GHC itself for its splitting unique supply.
186 ToDo: put this somewhere sensible.
187 ------------------------------------------------------------------------- */
189 I_ __GenSymCounter = 0;
194 return(__GenSymCounter++);
197 resetGenSymZh(void) /* it's your funeral */
200 return(__GenSymCounter);
203 /* -----------------------------------------------------------------------------
204 Get the current time as a string. Used in profiling reports.
205 -------------------------------------------------------------------------- */
207 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
211 static time_t now = 0;
212 static char nowstr[26];
216 strcpy(nowstr, ctime(&now));
217 strcpy(nowstr+16,nowstr+19);
224 /* -----------------------------------------------------------------------------
225 * Reset a file handle to blocking mode. We do this for the standard
226 * file descriptors before exiting, because the shell doesn't always
228 * -------------------------------------------------------------------------- */
230 #if !defined(mingw32_TARGET_OS)
232 resetNonBlockingFd(int fd)
236 /* clear the non-blocking flag on this file descriptor */
237 fd_flags = fcntl(fd, F_GETFL);
238 if (fd_flags & O_NONBLOCK) {
239 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
244 setNonBlockingFd(int fd)
248 /* clear the non-blocking flag on this file descriptor */
249 fd_flags = fcntl(fd, F_GETFL);
250 fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
253 /* Don't support non-blocking FDs (yet) on mingw */
254 void resetNonBlockingFd(int fd STG_UNUSED) {}
255 void setNonBlockingFd(int fd STG_UNUSED) {}
258 static ullong startTime = 0;
260 /* used in a parallel setup */
264 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH) && !defined(hppa1_1_TARGET_ARCH)
267 if (getclock(TIMEOFDAY, &tv) != 0) {
269 fprintf(stderr, "Clock failed\n");
270 stg_exit(EXIT_FAILURE);
272 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
273 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
276 if (gettimeofday(&tv, NULL) != 0) {
278 fprintf(stderr, "Clock failed\n");
279 stg_exit(EXIT_FAILURE);
281 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
284 if ((t = time(NULL)) == (time_t) -1) {
286 fprintf(stderr, "Clock failed\n");
287 stg_exit(EXIT_FAILURE);
289 return t * LL(1000) - startTime;
293 /* -----------------------------------------------------------------------------
294 Print large numbers, with punctuation.
295 -------------------------------------------------------------------------- */
298 ullong_format_string(ullong x, char *s, rtsBool with_commas)
300 if (x < (ullong)1000)
301 sprintf(s, "%d", (nat)x);
302 else if (x < (ullong)1000000)
303 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
304 (nat)((x)/(ullong)1000),
305 (nat)((x)%(ullong)1000));
306 else if (x < (ullong)1000000000)
307 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
308 (nat)((x)/(ullong)1000000),
309 (nat)((x)/(ullong)1000%(ullong)1000),
310 (nat)((x)%(ullong)1000));
312 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
313 (nat)((x)/(ullong)1000000000),
314 (nat)((x)/(ullong)1000000%(ullong)1000),
315 (nat)((x)/(ullong)1000%(ullong)1000),
316 (nat)((x)%(ullong)1000));