1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * General utility functions used in the RTS.
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
21 /* HACK: On Mac OS X 10.4 (at least), time.h doesn't declare ctime_r with
22 * _POSIX_C_SOURCE. If this is the case, we declare it ourselves.
24 #if HAVE_CTIME_R && !HAVE_DECL_CTIME_R
25 extern char *ctime_r(const time_t *, char *);
32 #ifdef HAVE_GETTIMEOFDAY
45 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
54 /* -----------------------------------------------------------------------------
55 Result-checking malloc wrappers.
56 -------------------------------------------------------------------------- */
59 stgMallocBytes (int n, char *msg)
65 if ((space = (char *) malloc(n2)) == NULL) {
66 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
67 MallocFailHook((W_) n, msg); /*msg*/
68 stg_exit(EXIT_INTERNAL_ERROR);
74 stgReallocBytes (void *p, int n, char *msg)
80 if ((space = (char *) realloc(p, (size_t) n2)) == NULL) {
81 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
82 MallocFailHook((W_) n, msg); /*msg*/
83 stg_exit(EXIT_INTERNAL_ERROR);
89 stgCallocBytes (int n, int m, char *msg)
93 if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
94 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
95 MallocFailHook((W_) n*m, msg); /*msg*/
96 stg_exit(EXIT_INTERNAL_ERROR);
101 /* To simplify changing the underlying allocator used
102 * by stgMallocBytes(), provide stgFree() as well.
110 /* -----------------------------------------------------------------------------
113 Not sure if this belongs here.
114 -------------------------------------------------------------------------- */
119 StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
121 #if defined(TICKY_TICKY)
122 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
131 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
132 OutOfHeapHook(0/*unknown request size*/,
133 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
135 heap_overflow = rtsTrue;
139 /* -----------------------------------------------------------------------------
140 genSym stuff, used by GHC itself for its splitting unique supply.
142 ToDo: put this somewhere sensible.
143 ------------------------------------------------------------------------- */
145 static HsInt __GenSymCounter = 0;
150 return(__GenSymCounter++);
153 resetGenSymZh(void) /* it's your funeral */
156 return(__GenSymCounter);
159 /* -----------------------------------------------------------------------------
160 Get the current time as a string. Used in profiling reports.
161 -------------------------------------------------------------------------- */
166 static time_t now = 0;
167 static char nowstr[26];
172 ctime_r(&now, nowstr);
174 strcpy(nowstr, ctime(&now));
176 memmove(nowstr+16,nowstr+19,7);
177 nowstr[21] = '\0'; // removes the \n
182 /* -----------------------------------------------------------------------------
183 Print large numbers, with punctuation.
184 -------------------------------------------------------------------------- */
187 showStgWord64(StgWord64 x, char *s, rtsBool with_commas)
190 if (x < (StgWord64)1e3)
191 sprintf(s, "%" FMT_Word64, (StgWord64)x);
192 else if (x < (StgWord64)1e6)
193 sprintf(s, "%" FMT_Word64 ",%03" FMT_Word64,
194 (StgWord64)(x / 1000),
195 (StgWord64)(x % 1000));
196 else if (x < (StgWord64)1e9)
197 sprintf(s, "%" FMT_Word64
200 (StgWord64)(x / 1e6),
201 (StgWord64)((x / 1000) % 1000),
202 (StgWord64)(x % 1000));
203 else if (x < (StgWord64)1e12)
204 sprintf(s, "%" FMT_Word64
208 (StgWord64)(x / (StgWord64)1e9),
209 (StgWord64)((x / (StgWord64)1e6) % 1000),
210 (StgWord64)((x / (StgWord64)1e3) % 1000),
211 (StgWord64)(x % 1000));
212 else if (x < (StgWord64)1e15)
213 sprintf(s, "%" FMT_Word64
218 (StgWord64)(x / (StgWord64)1e12),
219 (StgWord64)((x / (StgWord64)1e9) % 1000),
220 (StgWord64)((x / (StgWord64)1e6) % 1000),
221 (StgWord64)((x / (StgWord64)1e3) % 1000),
222 (StgWord64)(x % 1000));
223 else if (x < (StgWord64)1e18)
224 sprintf(s, "%" FMT_Word64
230 (StgWord64)(x / (StgWord64)1e15),
231 (StgWord64)((x / (StgWord64)1e12) % 1000),
232 (StgWord64)((x / (StgWord64)1e9) % 1000),
233 (StgWord64)((x / (StgWord64)1e6) % 1000),
234 (StgWord64)((x / (StgWord64)1e3) % 1000),
235 (StgWord64)(x % 1000));
237 sprintf(s, "%" FMT_Word64
244 (StgWord64)(x / (StgWord64)1e18),
245 (StgWord64)((x / (StgWord64)1e15) % 1000),
246 (StgWord64)((x / (StgWord64)1e12) % 1000),
247 (StgWord64)((x / (StgWord64)1e9) % 1000),
248 (StgWord64)((x / (StgWord64)1e6) % 1000),
249 (StgWord64)((x / (StgWord64)1e3) % 1000),
250 (StgWord64)(x % 1000));
253 sprintf(s, "%" FMT_Word64, x);
259 // Can be used as a breakpoint to set on every heap check failure.
262 heapCheckFail( void )
268 * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
269 * pthreads (and possibly others). When linking with -lpthreads, we
270 * have to use pthread_kill to send blockable signals. So use that
271 * when we have a threaded rts. So System.Posix.Signals will call
272 * genericRaise(), rather than raise(3).
274 int genericRaise(int sig) {
275 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS))
276 return pthread_kill(pthread_self(), sig);
282 static void mkRtsInfoPair(char *key, char *val) {
283 /* XXX should check for "s, \s etc in key and val */
284 printf(" ,(\"%s\", \"%s\")\n", key, val);
287 /* This little bit of magic allows us to say TOSTRING(SYM) and get
289 #define TOSTRING2(x) #x
290 #define TOSTRING(x) TOSTRING2(x)
292 void printRtsInfo(void) {
293 /* The first entry is just a hack to make it easy to get the
295 printf(" [(\"GHC RTS\", \"YES\")\n");
296 mkRtsInfoPair("GHC version", ProjectVersion);
297 mkRtsInfoPair("RTS way", RtsWay);
298 mkRtsInfoPair("Build platform", BuildPlatform);
299 mkRtsInfoPair("Build architecture", BuildArch);
300 mkRtsInfoPair("Build OS", BuildOS);
301 mkRtsInfoPair("Build vendor", BuildVendor);
302 mkRtsInfoPair("Host platform", HostPlatform);
303 mkRtsInfoPair("Host architecture", HostArch);
304 mkRtsInfoPair("Host OS", HostOS);
305 mkRtsInfoPair("Host vendor", HostVendor);
306 mkRtsInfoPair("Target platform", TargetPlatform);
307 mkRtsInfoPair("Target architecture", TargetArch);
308 mkRtsInfoPair("Target OS", TargetOS);
309 mkRtsInfoPair("Target vendor", TargetVendor);
310 mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS));
311 mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
312 mkRtsInfoPair("Tables next to code", GhcEnableTablesNextToCode);
316 // Provides a way for Haskell programs to tell whether they're being
317 // profiled or not. GHCi uses it (see #2197).
318 int rts_isProfiled(void)