1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.3 1999/01/21 10:31:49 simonm Exp $
4 * General utility functions used in the RTS.
6 * ---------------------------------------------------------------------------*/
22 /* variable-argument error function. */
24 void barf(char *s, ...)
29 if (prog_argv != NULL && prog_argv[0] != NULL) {
30 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
32 fprintf(stderr, "fatal error: ");
34 vfprintf(stderr, s, ap);
35 fprintf(stderr, "\n");
36 stg_exit(EXIT_FAILURE);
39 void belch(char *s, ...)
44 vfprintf(stderr, s, ap);
45 fprintf(stderr, "\n");
48 /* result-checking malloc wrappers. */
51 stgMallocBytes (int n, char *msg)
55 if ((space = (char *) malloc((size_t) n)) == NULL) {
57 MallocFailHook((W_) n, msg); /*msg*/
58 stg_exit(EXIT_FAILURE);
64 stgReallocBytes (void *p, int n, char *msg)
68 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
70 MallocFailHook((W_) n, msg); /*msg*/
77 stgMallocWords (int n, char *msg)
79 return(stgMallocBytes(n * sizeof(W_), msg));
83 stgReallocWords (void *p, int n, char *msg)
85 return(stgReallocBytes(p, n * sizeof(W_), msg));
89 _stgAssert (char *filename, nat linenum)
92 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
96 StgStablePtr errorHandler = -1; /* -1 indicates no handler installed */
99 raiseError( StgStablePtr handler STG_UNUSED )
102 stg_exit(EXIT_FAILURE);
105 /* -----------------------------------------------------------------------------
108 Not sure if this belongs here.
109 -------------------------------------------------------------------------- */
112 stackOverflow(nat max_stack_size)
115 StackOverflowHook(max_stack_size * sizeof(W_)); /*msg*/
117 #if defined(TICKY_TICKY)
118 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
121 stg_exit(EXIT_FAILURE);
128 OutOfHeapHook(0/*unknown request size*/,
129 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
131 #if defined(TICKY_TICKY)
132 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
135 stg_exit(EXIT_FAILURE);
138 /* -----------------------------------------------------------------------------
141 Used in addr2Integer because the C compiler on x86 chokes on
142 strlen, trying to inline it with not enough registers available.
143 -------------------------------------------------------------------------- */
145 nat stg_strlen(char *s)
154 /* -----------------------------------------------------------------------------
155 genSym stuff, used by GHC itself for its splitting unique supply.
157 ToDo: put this somewhere sensible.
158 ------------------------------------------------------------------------- */
160 I_ __GenSymCounter = 0;
165 return(__GenSymCounter++);
168 resetGenSymZh(void) /* it's your funeral */
171 return(__GenSymCounter);
174 /* -----------------------------------------------------------------------------
175 Get the current time as a string. Used in profiling reports.
176 -------------------------------------------------------------------------- */
178 #if defined(PROFILING) || defined(DEBUG)
182 static time_t now = 0;
183 static char nowstr[26];
187 strcpy(nowstr, ctime(&now));
188 strcpy(nowstr+16,nowstr+19);
195 /* -----------------------------------------------------------------------------
196 Print large numbers, with punctuation.
197 -------------------------------------------------------------------------- */
200 ullong_format_string(ullong x, char *s, rtsBool with_commas)
202 if (x < (ullong)1000)
203 sprintf(s, "%d", (nat)x);
204 else if (x < (ullong)1000000)
205 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
206 (nat)((x)/(ullong)1000),
207 (nat)((x)%(ullong)1000));
208 else if (x < (ullong)1000000000)
209 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
210 (nat)((x)/(ullong)1000000),
211 (nat)((x)/(ullong)1000%(ullong)1000),
212 (nat)((x)%(ullong)1000));
214 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
215 (nat)((x)/(ullong)1000000000),
216 (nat)((x)/(ullong)1000000%(ullong)1000),
217 (nat)((x)/(ullong)1000%(ullong)1000),
218 (nat)((x)%(ullong)1000));