1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.10 1999/11/09 10:46:26 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
6 * General utility functions used in the RTS.
8 * ---------------------------------------------------------------------------*/
28 /* variable-argument error function. */
30 void barf(char *s, ...)
34 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
35 if (prog_argv != NULL && prog_argv[0] != NULL) {
36 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
38 fprintf(stderr, "fatal error: ");
40 vfprintf(stderr, s, ap);
41 fprintf(stderr, "\n");
43 stg_exit(EXIT_FAILURE);
46 void belch(char *s, ...)
50 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
51 vfprintf(stderr, s, ap);
52 fprintf(stderr, "\n");
55 /* result-checking malloc wrappers. */
58 stgMallocBytes (int n, char *msg)
62 if ((space = (char *) malloc((size_t) n)) == NULL) {
63 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
64 MallocFailHook((W_) n, msg); /*msg*/
65 stg_exit(EXIT_FAILURE);
71 stgReallocBytes (void *p, int n, char *msg)
75 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
76 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
77 MallocFailHook((W_) n, msg); /*msg*/
84 stgMallocWords (int n, char *msg)
86 return(stgMallocBytes(n * sizeof(W_), msg));
90 stgReallocWords (void *p, int n, char *msg)
92 return(stgReallocBytes(p, n * sizeof(W_), msg));
96 _stgAssert (char *filename, nat linenum)
98 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
99 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
103 /* -----------------------------------------------------------------------------
106 Not sure if this belongs here.
107 -------------------------------------------------------------------------- */
112 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
114 #if defined(TICKY_TICKY)
115 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
122 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
123 OutOfHeapHook(0/*unknown request size*/,
124 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
126 #if defined(TICKY_TICKY)
127 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
130 stg_exit(EXIT_FAILURE);
133 /* -----------------------------------------------------------------------------
136 Used in addr2Integer because the C compiler on x86 chokes on
137 strlen, trying to inline it with not enough registers available.
138 -------------------------------------------------------------------------- */
140 nat stg_strlen(char *s)
149 /* -----------------------------------------------------------------------------
150 genSym stuff, used by GHC itself for its splitting unique supply.
152 ToDo: put this somewhere sensible.
153 ------------------------------------------------------------------------- */
155 I_ __GenSymCounter = 0;
160 return(__GenSymCounter++);
163 resetGenSymZh(void) /* it's your funeral */
166 return(__GenSymCounter);
169 /* -----------------------------------------------------------------------------
170 Get the current time as a string. Used in profiling reports.
171 -------------------------------------------------------------------------- */
173 #if defined(PROFILING) || defined(DEBUG)
177 static time_t now = 0;
178 static char nowstr[26];
182 strcpy(nowstr, ctime(&now));
183 strcpy(nowstr+16,nowstr+19);
190 /* -----------------------------------------------------------------------------
191 * Reset a file handle to blocking mode. We do this for the standard
192 * file descriptors before exiting, because the shell doesn't always
194 * -------------------------------------------------------------------------- */
197 resetNonBlockingFd(int fd)
201 #if !defined(_WIN32) || defined(__CYGWIN__) || defined(__CYGWIN32__)
202 /* clear the non-blocking flag on this file descriptor */
203 fd_flags = fcntl(fd, F_GETFL);
204 if (fd_flags & O_NONBLOCK) {
205 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
210 /* -----------------------------------------------------------------------------
211 Print large numbers, with punctuation.
212 -------------------------------------------------------------------------- */
215 ullong_format_string(ullong x, char *s, rtsBool with_commas)
217 if (x < (ullong)1000)
218 sprintf(s, "%d", (nat)x);
219 else if (x < (ullong)1000000)
220 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
221 (nat)((x)/(ullong)1000),
222 (nat)((x)%(ullong)1000));
223 else if (x < (ullong)1000000000)
224 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
225 (nat)((x)/(ullong)1000000),
226 (nat)((x)/(ullong)1000%(ullong)1000),
227 (nat)((x)%(ullong)1000));
229 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
230 (nat)((x)/(ullong)1000000000),
231 (nat)((x)/(ullong)1000000%(ullong)1000),
232 (nat)((x)/(ullong)1000%(ullong)1000),
233 (nat)((x)%(ullong)1000));