1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.21 2001/08/29 14:55:58 sewardj 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);
54 void prog_belch(char *s, ...)
58 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
59 if (prog_argv != NULL && prog_argv[0] != NULL) {
60 fprintf(stderr, "%s: ", prog_argv[0]);
62 vfprintf(stderr, s, ap);
63 fprintf(stderr, "\n");
66 void belch(char *s, ...)
70 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
71 vfprintf(stderr, s, ap);
72 fprintf(stderr, "\n");
75 /* result-checking malloc wrappers. */
78 stgMallocBytes (int n, char *msg)
82 if ((space = (char *) malloc((size_t) n)) == NULL) {
83 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
84 MallocFailHook((W_) n, msg); /*msg*/
85 stg_exit(EXIT_INTERNAL_ERROR);
91 stgReallocBytes (void *p, int n, char *msg)
95 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
96 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
97 MallocFailHook((W_) n, msg); /*msg*/
98 stg_exit(EXIT_INTERNAL_ERROR);
104 stgMallocWords (int n, char *msg)
106 return(stgMallocBytes(n * sizeof(W_), msg));
110 stgReallocWords (void *p, int n, char *msg)
112 return(stgReallocBytes(p, n * sizeof(W_), msg));
116 stgCallocBytes (int n, int m, char *msg)
118 return stgMallocBytes(n*m, msg);
122 _stgAssert (char *filename, unsigned int linenum)
125 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
130 /* -----------------------------------------------------------------------------
133 Not sure if this belongs here.
134 -------------------------------------------------------------------------- */
139 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
141 #if defined(TICKY_TICKY)
142 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
149 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
150 OutOfHeapHook(0/*unknown request size*/,
151 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
153 #if defined(TICKY_TICKY)
154 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
157 stg_exit(EXIT_HEAPOVERFLOW);
160 /* -----------------------------------------------------------------------------
163 Used in addr2Integer because the C compiler on x86 chokes on
164 strlen, trying to inline it with not enough registers available.
165 -------------------------------------------------------------------------- */
167 nat stg_strlen(char *s)
176 /* -----------------------------------------------------------------------------
177 genSym stuff, used by GHC itself for its splitting unique supply.
179 ToDo: put this somewhere sensible.
180 ------------------------------------------------------------------------- */
182 I_ __GenSymCounter = 0;
187 return(__GenSymCounter++);
190 resetGenSymZh(void) /* it's your funeral */
193 return(__GenSymCounter);
196 /* -----------------------------------------------------------------------------
197 Get the current time as a string. Used in profiling reports.
198 -------------------------------------------------------------------------- */
200 #if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
204 static time_t now = 0;
205 static char nowstr[26];
209 strcpy(nowstr, ctime(&now));
210 strcpy(nowstr+16,nowstr+19);
217 /* -----------------------------------------------------------------------------
218 * Reset a file handle to blocking mode. We do this for the standard
219 * file descriptors before exiting, because the shell doesn't always
221 * -------------------------------------------------------------------------- */
224 resetNonBlockingFd(int fd)
228 #if !defined(mingw32_TARGET_OS)
229 /* clear the non-blocking flag on this file descriptor */
230 fd_flags = fcntl(fd, F_GETFL);
231 if (fd_flags & O_NONBLOCK) {
232 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
237 static ullong startTime = 0;
239 /* used in a parallel setup */
243 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH) && !defined(hppa1_1_TARGET_ARCH)
246 if (getclock(TIMEOFDAY, &tv) != 0) {
248 fprintf(stderr, "Clock failed\n");
249 stg_exit(EXIT_FAILURE);
251 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
252 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
255 if (gettimeofday(&tv, NULL) != 0) {
257 fprintf(stderr, "Clock failed\n");
258 stg_exit(EXIT_FAILURE);
260 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
263 if ((t = time(NULL)) == (time_t) -1) {
265 fprintf(stderr, "Clock failed\n");
266 stg_exit(EXIT_FAILURE);
268 return t * LL(1000) - startTime;
272 /* -----------------------------------------------------------------------------
273 Print large numbers, with punctuation.
274 -------------------------------------------------------------------------- */
277 ullong_format_string(ullong x, char *s, rtsBool with_commas)
279 if (x < (ullong)1000)
280 sprintf(s, "%d", (nat)x);
281 else if (x < (ullong)1000000)
282 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
283 (nat)((x)/(ullong)1000),
284 (nat)((x)%(ullong)1000));
285 else if (x < (ullong)1000000000)
286 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
287 (nat)((x)/(ullong)1000000),
288 (nat)((x)/(ullong)1000%(ullong)1000),
289 (nat)((x)%(ullong)1000));
291 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
292 (nat)((x)/(ullong)1000000000),
293 (nat)((x)/(ullong)1000000%(ullong)1000),
294 (nat)((x)/(ullong)1000%(ullong)1000),
295 (nat)((x)%(ullong)1000));