1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.11 2000/01/12 15:15:17 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 prog_belch(char *s, ...)
50 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
51 if (prog_argv != NULL && prog_argv[0] != NULL) {
52 fprintf(stderr, "%s: ", prog_argv[0]);
54 vfprintf(stderr, s, ap);
55 fprintf(stderr, "\n");
58 void belch(char *s, ...)
62 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
63 vfprintf(stderr, s, ap);
64 fprintf(stderr, "\n");
67 /* result-checking malloc wrappers. */
70 stgMallocBytes (int n, char *msg)
74 if ((space = (char *) malloc((size_t) n)) == NULL) {
75 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
76 MallocFailHook((W_) n, msg); /*msg*/
77 stg_exit(EXIT_FAILURE);
83 stgReallocBytes (void *p, int n, char *msg)
87 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
88 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
89 MallocFailHook((W_) n, msg); /*msg*/
96 stgMallocWords (int n, char *msg)
98 return(stgMallocBytes(n * sizeof(W_), msg));
102 stgReallocWords (void *p, int n, char *msg)
104 return(stgReallocBytes(p, n * sizeof(W_), msg));
108 _stgAssert (char *filename, nat linenum)
110 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
111 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
115 /* -----------------------------------------------------------------------------
118 Not sure if this belongs here.
119 -------------------------------------------------------------------------- */
124 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
126 #if defined(TICKY_TICKY)
127 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
134 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
135 OutOfHeapHook(0/*unknown request size*/,
136 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
138 #if defined(TICKY_TICKY)
139 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
142 stg_exit(EXIT_FAILURE);
145 /* -----------------------------------------------------------------------------
148 Used in addr2Integer because the C compiler on x86 chokes on
149 strlen, trying to inline it with not enough registers available.
150 -------------------------------------------------------------------------- */
152 nat stg_strlen(char *s)
161 /* -----------------------------------------------------------------------------
162 genSym stuff, used by GHC itself for its splitting unique supply.
164 ToDo: put this somewhere sensible.
165 ------------------------------------------------------------------------- */
167 I_ __GenSymCounter = 0;
172 return(__GenSymCounter++);
175 resetGenSymZh(void) /* it's your funeral */
178 return(__GenSymCounter);
181 /* -----------------------------------------------------------------------------
182 Get the current time as a string. Used in profiling reports.
183 -------------------------------------------------------------------------- */
185 #if defined(PROFILING) || defined(DEBUG)
189 static time_t now = 0;
190 static char nowstr[26];
194 strcpy(nowstr, ctime(&now));
195 strcpy(nowstr+16,nowstr+19);
202 /* -----------------------------------------------------------------------------
203 * Reset a file handle to blocking mode. We do this for the standard
204 * file descriptors before exiting, because the shell doesn't always
206 * -------------------------------------------------------------------------- */
209 resetNonBlockingFd(int fd)
213 #if !defined(_WIN32) || defined(__CYGWIN__) || defined(__CYGWIN32__)
214 /* clear the non-blocking flag on this file descriptor */
215 fd_flags = fcntl(fd, F_GETFL);
216 if (fd_flags & O_NONBLOCK) {
217 fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
222 /* -----------------------------------------------------------------------------
223 Print large numbers, with punctuation.
224 -------------------------------------------------------------------------- */
227 ullong_format_string(ullong x, char *s, rtsBool with_commas)
229 if (x < (ullong)1000)
230 sprintf(s, "%d", (nat)x);
231 else if (x < (ullong)1000000)
232 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
233 (nat)((x)/(ullong)1000),
234 (nat)((x)%(ullong)1000));
235 else if (x < (ullong)1000000000)
236 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
237 (nat)((x)/(ullong)1000000),
238 (nat)((x)/(ullong)1000%(ullong)1000),
239 (nat)((x)%(ullong)1000));
241 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
242 (nat)((x)/(ullong)1000000000),
243 (nat)((x)/(ullong)1000000%(ullong)1000),
244 (nat)((x)/(ullong)1000%(ullong)1000),
245 (nat)((x)%(ullong)1000));