1 /* -----------------------------------------------------------------------------
2 * $Id: RtsUtils.c,v 1.2 1998/12/02 13:28:41 simonm Exp $
4 * General utility functions used in the RTS.
6 * ---------------------------------------------------------------------------*/
21 /* variable-argument error function. */
23 void barf(char *s, ...)
28 if (prog_argv != NULL && prog_argv[0] != NULL) {
29 fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
31 fprintf(stderr, "fatal error: ");
33 vfprintf(stderr, s, ap);
34 fprintf(stderr, "\n");
35 stg_exit(EXIT_FAILURE);
38 void belch(char *s, ...)
43 vfprintf(stderr, s, ap);
44 fprintf(stderr, "\n");
47 /* result-checking malloc wrappers. */
50 stgMallocBytes (int n, char *msg)
54 if ((space = (char *) malloc((size_t) n)) == NULL) {
56 MallocFailHook((W_) n, msg); /*msg*/
57 stg_exit(EXIT_FAILURE);
63 stgReallocBytes (void *p, int n, char *msg)
67 if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
69 MallocFailHook((W_) n, msg); /*msg*/
76 stgMallocWords (int n, char *msg)
78 return(stgMallocBytes(n * sizeof(W_), msg));
82 stgReallocWords (void *p, int n, char *msg)
84 return(stgReallocBytes(p, n * sizeof(W_), msg));
88 _stgAssert (char *filename, nat linenum)
91 fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
95 StgStablePtr errorHandler = -1; /* -1 indicates no handler installed */
98 raiseError( StgStablePtr handler STG_UNUSED )
101 stg_exit(EXIT_FAILURE);
104 /* -----------------------------------------------------------------------------
107 Not sure if this belongs here.
108 -------------------------------------------------------------------------- */
111 stackOverflow(nat max_stack_size)
114 StackOverflowHook(max_stack_size * sizeof(W_)); /*msg*/
116 #if defined(TICKY_TICKY)
117 if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
120 stg_exit(EXIT_FAILURE);
127 OutOfHeapHook(0/*unknown request size*/,
128 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
130 #if defined(TICKY_TICKY)
131 if (Rtsflags.TickyFlags.showTickyStats) PrintTickyInfo();
134 stg_exit(EXIT_FAILURE);
137 /* -----------------------------------------------------------------------------
140 Used in addr2Integer because the C compiler on x86 chokes on
141 strlen, trying to inline it with not enough registers available.
142 -------------------------------------------------------------------------- */
144 nat stg_strlen(char *s)
153 /* -----------------------------------------------------------------------------
154 genSym stuff, used by GHC itself for its splitting unique supply.
156 ToDo: put this somewhere sensible.
157 ------------------------------------------------------------------------- */
159 I_ __GenSymCounter = 0;
164 return(__GenSymCounter++);
167 resetGenSymZh(void) /* it's your funeral */
170 return(__GenSymCounter);
173 /* -----------------------------------------------------------------------------
174 Get the current time as a string. Used in profiling reports.
175 -------------------------------------------------------------------------- */
177 #if defined(PROFILING) || defined(DEBUG)
181 static time_t now = 0;
182 static char nowstr[26];
186 strcpy(nowstr, ctime(&now));
187 strcpy(nowstr+16,nowstr+19);
194 /* -----------------------------------------------------------------------------
195 Print large numbers, with punctuation.
196 -------------------------------------------------------------------------- */
199 ullong_format_string(ullong x, char *s, rtsBool with_commas)
201 if (x < (ullong)1000)
202 sprintf(s, "%d", (nat)x);
203 else if (x < (ullong)1000000)
204 sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
205 (nat)((x)/(ullong)1000),
206 (nat)((x)%(ullong)1000));
207 else if (x < (ullong)1000000000)
208 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld",
209 (nat)((x)/(ullong)1000000),
210 (nat)((x)/(ullong)1000%(ullong)1000),
211 (nat)((x)%(ullong)1000));
213 sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
214 (nat)((x)/(ullong)1000000000),
215 (nat)((x)/(ullong)1000000%(ullong)1000),
216 (nat)((x)/(ullong)1000%(ullong)1000),
217 (nat)((x)%(ullong)1000));