1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.9 1999/08/25 16:11:51 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
6 * General utility functions used in the RTS.
8 * ---------------------------------------------------------------------------*/
24 /* variable-argument error function. */
26 void barf(char *s, ...)
30 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
31 if (prog_argv != NULL && prog_argv[0] != NULL) {
32 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
34 fprintf(stderr, "fatal error: ");
36 vfprintf(stderr, s, ap);
37 fprintf(stderr, "\n");
39 stg_exit(EXIT_FAILURE);
42 void belch(char *s, ...)
46 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
47 vfprintf(stderr, s, ap);
48 fprintf(stderr, "\n");
51 /* result-checking malloc wrappers. */
54 stgMallocBytes (int n, char *msg)
58 if ((space = (char *) malloc((size_t) n)) == NULL) {
59 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
60 MallocFailHook((W_) n, msg); /*msg*/
61 stg_exit(EXIT_FAILURE);
67 stgReallocBytes (void *p, int n, char *msg)
71 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
72 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
73 MallocFailHook((W_) n, msg); /*msg*/
80 stgMallocWords (int n, char *msg)
82 return(stgMallocBytes(n * sizeof(W_), msg));
86 stgReallocWords (void *p, int n, char *msg)
88 return(stgReallocBytes(p, n * sizeof(W_), msg));
92 _stgAssert (char *filename, nat linenum)
94 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
95 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
99 /* -----------------------------------------------------------------------------
102 Not sure if this belongs here.
103 -------------------------------------------------------------------------- */
108 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
110 #if defined(TICKY_TICKY)
111 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
118 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
119 OutOfHeapHook(0/*unknown request size*/,
120 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
122 #if defined(TICKY_TICKY)
123 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
126 stg_exit(EXIT_FAILURE);
129 /* -----------------------------------------------------------------------------
132 Used in addr2Integer because the C compiler on x86 chokes on
133 strlen, trying to inline it with not enough registers available.
134 -------------------------------------------------------------------------- */
136 nat stg_strlen(char *s)
145 /* -----------------------------------------------------------------------------
146 genSym stuff, used by GHC itself for its splitting unique supply.
148 ToDo: put this somewhere sensible.
149 ------------------------------------------------------------------------- */
151 I_ __GenSymCounter = 0;
156 return(__GenSymCounter++);
159 resetGenSymZh(void) /* it's your funeral */
162 return(__GenSymCounter);
165 /* -----------------------------------------------------------------------------
166 Get the current time as a string. Used in profiling reports.
167 -------------------------------------------------------------------------- */
169 #if defined(PROFILING) || defined(DEBUG)
173 static time_t now = 0;
174 static char nowstr[26];
178 strcpy(nowstr, ctime(&now));
179 strcpy(nowstr+16,nowstr+19);
186 /* -----------------------------------------------------------------------------
187 Print large numbers, with punctuation.
188 -------------------------------------------------------------------------- */
191 ullong_format_string(ullong x, char *s, rtsBool with_commas)
193 if (x < (ullong)1000)
194 sprintf(s, "%d", (nat)x);
195 else if (x < (ullong)1000000)
196 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
197 (nat)((x)/(ullong)1000),
198 (nat)((x)%(ullong)1000));
199 else if (x < (ullong)1000000000)
200 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
201 (nat)((x)/(ullong)1000000),
202 (nat)((x)/(ullong)1000%(ullong)1000),
203 (nat)((x)%(ullong)1000));
205 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
206 (nat)((x)/(ullong)1000000000),
207 (nat)((x)/(ullong)1000000%(ullong)1000),
208 (nat)((x)/(ullong)1000%(ullong)1000),
209 (nat)((x)%(ullong)1000));