1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.13 2000/01/13 14:34:04 hwloidl Exp $
4 * (c) The GHC Team, 1998-1999
6 * General utility functions used in the RTS.
8 * ---------------------------------------------------------------------------*/
27 #ifdef HAVE_GETTIMEOFDAY
33 /* variable-argument error function. */
35 void barf(char *s, ...)
39 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
40 if (prog_argv != NULL && prog_argv[0] != NULL) {
41 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
43 fprintf(stderr, "fatal error: ");
45 vfprintf(stderr, s, ap);
46 fprintf(stderr, "\n");
48 stg_exit(EXIT_INTERNAL_ERROR);
51 void prog_belch(char *s, ...)
55 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
56 if (prog_argv != NULL && prog_argv[0] != NULL) {
57 fprintf(stderr, "%s: ", prog_argv[0]);
59 vfprintf(stderr, s, ap);
60 fprintf(stderr, "\n");
63 void belch(char *s, ...)
67 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
68 vfprintf(stderr, s, ap);
69 fprintf(stderr, "\n");
72 /* result-checking malloc wrappers. */
75 stgMallocBytes (int n, char *msg)
79 if ((space = (char *) malloc((size_t) n)) == NULL) {
80 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
81 MallocFailHook((W_) n, msg); /*msg*/
82 stg_exit(EXIT_INTERNAL_ERROR);
88 stgReallocBytes (void *p, int n, char *msg)
92 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
93 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
94 MallocFailHook((W_) n, msg); /*msg*/
95 stg_exit(EXIT_INTERNAL_ERROR);
101 stgMallocWords (int n, char *msg)
103 return(stgMallocBytes(n * sizeof(W_), msg));
107 stgReallocWords (void *p, int n, char *msg)
109 return(stgReallocBytes(p, n * sizeof(W_), msg));
113 _stgAssert (char *filename, nat linenum)
115 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
116 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
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 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];
199 strcpy(nowstr, ctime(&now));
200 strcpy(nowstr+16,nowstr+19);
207 /* -----------------------------------------------------------------------------
208 * Reset a file handle to blocking mode. We do this for the standard
209 * file descriptors before exiting, because the shell doesn't always
211 * -------------------------------------------------------------------------- */
214 resetNonBlockingFd(int fd)
218 #if !defined(_WIN32) || defined(__CYGWIN__) || defined(__CYGWIN32__)
219 /* clear the non-blocking flag on this file descriptor */
220 fd_flags = fcntl(fd, F_GETFL);
221 if (fd_flags & O_NONBLOCK) {
222 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
228 static ullong startTime = 0;
230 /* used in a parallel setup */
234 # if defined(HAVE_GETCLOCK) && !defined(alpha_TARGET_ARCH)
237 if (getclock(TIMEOFDAY, &tv) != 0) {
239 fprintf(stderr, "Clock failed\n");
240 stg_exit(EXIT_FAILURE);
242 return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
243 # elif HAVE_GETTIMEOFDAY && !defined(alpha_TARGET_ARCH)
246 if (gettimeofday(&tv, NULL) != 0) {
248 fprintf(stderr, "Clock failed\n");
249 stg_exit(EXIT_FAILURE);
251 return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
254 if ((t = time(NULL)) == (time_t) -1) {
256 fprintf(stderr, "Clock failed\n");
257 stg_exit(EXIT_FAILURE);
259 return t * LL(1000) - startTime;
265 /* -----------------------------------------------------------------------------
266 Print large numbers, with punctuation.
267 -------------------------------------------------------------------------- */
270 ullong_format_string(ullong x, char *s, rtsBool with_commas)
272 if (x < (ullong)1000)
273 sprintf(s, "%d", (nat)x);
274 else if (x < (ullong)1000000)
275 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
276 (nat)((x)/(ullong)1000),
277 (nat)((x)%(ullong)1000));
278 else if (x < (ullong)1000000000)
279 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
280 (nat)((x)/(ullong)1000000),
281 (nat)((x)/(ullong)1000%(ullong)1000),
282 (nat)((x)%(ullong)1000));
284 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
285 (nat)((x)/(ullong)1000000000),
286 (nat)((x)/(ullong)1000000%(ullong)1000),
287 (nat)((x)/(ullong)1000%(ullong)1000),
288 (nat)((x)%(ullong)1000));