1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.6 1999/02/05 16:02:51 simonm 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, ...)
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");
38 stg_exit(EXIT_FAILURE);
41 void belch(char *s, ...)
46 vfprintf(stderr, s, ap);
47 fprintf(stderr, "\n");
50 /* result-checking malloc wrappers. */
53 stgMallocBytes (int n, char *msg)
57 if ((space = (char *) malloc((size_t) n)) == NULL) {
59 MallocFailHook((W_) n, msg); /*msg*/
60 stg_exit(EXIT_FAILURE);
66 stgReallocBytes (void *p, int n, char *msg)
70 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
72 MallocFailHook((W_) n, msg); /*msg*/
79 stgMallocWords (int n, char *msg)
81 return(stgMallocBytes(n * sizeof(W_), msg));
85 stgReallocWords (void *p, int n, char *msg)
87 return(stgReallocBytes(p, n * sizeof(W_), msg));
91 _stgAssert (char *filename, nat linenum)
94 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
98 StgStablePtr errorHandler = -1; /* -1 indicates no handler installed */
101 raiseError( StgStablePtr handler STG_UNUSED )
104 stg_exit(EXIT_FAILURE);
107 /* -----------------------------------------------------------------------------
110 Not sure if this belongs here.
111 -------------------------------------------------------------------------- */
114 stackOverflow(nat max_stack_size)
117 StackOverflowHook(max_stack_size * sizeof(W_)); /*msg*/
119 #if defined(TICKY_TICKY)
120 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
123 stg_exit(EXIT_FAILURE);
130 OutOfHeapHook(0/*unknown request size*/,
131 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
133 #if defined(TICKY_TICKY)
134 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
137 stg_exit(EXIT_FAILURE);
140 /* -----------------------------------------------------------------------------
143 Used in addr2Integer because the C compiler on x86 chokes on
144 strlen, trying to inline it with not enough registers available.
145 -------------------------------------------------------------------------- */
147 nat stg_strlen(char *s)
156 /* -----------------------------------------------------------------------------
157 genSym stuff, used by GHC itself for its splitting unique supply.
159 ToDo: put this somewhere sensible.
160 ------------------------------------------------------------------------- */
162 I_ __GenSymCounter = 0;
167 return(__GenSymCounter++);
170 resetGenSymZh(void) /* it's your funeral */
173 return(__GenSymCounter);
176 /* -----------------------------------------------------------------------------
177 Get the current time as a string. Used in profiling reports.
178 -------------------------------------------------------------------------- */
180 #if defined(PROFILING) || defined(DEBUG)
184 static time_t now = 0;
185 static char nowstr[26];
189 strcpy(nowstr, ctime(&now));
190 strcpy(nowstr+16,nowstr+19);
197 /* -----------------------------------------------------------------------------
198 Print large numbers, with punctuation.
199 -------------------------------------------------------------------------- */
202 ullong_format_string(ullong x, char *s, rtsBool with_commas)
204 if (x < (ullong)1000)
205 sprintf(s, "%d", (nat)x);
206 else if (x < (ullong)1000000)
207 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
208 (nat)((x)/(ullong)1000),
209 (nat)((x)%(ullong)1000));
210 else if (x < (ullong)1000000000)
211 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
212 (nat)((x)/(ullong)1000000),
213 (nat)((x)/(ullong)1000%(ullong)1000),
214 (nat)((x)%(ullong)1000));
216 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
217 (nat)((x)/(ullong)1000000000),
218 (nat)((x)/(ullong)1000000%(ullong)1000),
219 (nat)((x)/(ullong)1000%(ullong)1000),
220 (nat)((x)%(ullong)1000));