CmmLayoutStack: Add unwind information on stack fixups
[ghc.git] / rts / RtsUtils.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2004
4 *
5 * General utility functions used in the RTS.
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11 #include "RtsAPI.h"
12
13 #include "RtsUtils.h"
14 #include "Ticky.h"
15 #include "Schedule.h"
16 #include "RtsFlags.h"
17
18 #ifdef HAVE_TIME_H
19 #include <time.h>
20 #endif
21
22 /* HACK: On Mac OS X 10.4 (at least), time.h doesn't declare ctime_r with
23 * _POSIX_C_SOURCE. If this is the case, we declare it ourselves.
24 */
25 #if HAVE_CTIME_R && !HAVE_DECL_CTIME_R
26 extern char *ctime_r(const time_t *, char *);
27 #endif
28
29 #ifdef HAVE_FCNTL_H
30 #include <fcntl.h>
31 #endif
32
33 #ifdef HAVE_GETTIMEOFDAY
34 #include <sys/time.h>
35 #endif
36
37 #include <stdlib.h>
38 #include <string.h>
39 #include <stdarg.h>
40 #include <stdio.h>
41
42 #ifdef HAVE_SIGNAL_H
43 #include <signal.h>
44 #endif
45
46 #if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
47 #include <pthread.h>
48 #endif
49
50
51 #if defined(_WIN32)
52 #include <windows.h>
53 #endif
54
55 /* -----------------------------------------------------------------------------
56 Result-checking malloc wrappers.
57 -------------------------------------------------------------------------- */
58
59 void *
60 stgMallocBytes (size_t n, char *msg)
61 {
62 void *space;
63
64 if ((space = malloc(n)) == NULL) {
65 /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99):
66 *
67 * "Upon successful completion with size not equal to 0, malloc() shall
68 * return a pointer to the allocated space. If size is 0, either a null
69 * pointer or a unique pointer that can be successfully passed to free()
70 * shall be returned. Otherwise, it shall return a null pointer and set
71 * errno to indicate the error."
72 *
73 * Consequently, a NULL pointer being returned by `malloc()` for a 0-size
74 * allocation is *not* to be considered an error.
75 */
76 if (n == 0) return NULL;
77
78 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
79 rtsConfig.mallocFailHook((W_) n, msg); /*msg*/
80 stg_exit(EXIT_INTERNAL_ERROR);
81 }
82 IF_DEBUG(sanity, memset(space, 0xbb, n));
83 return space;
84 }
85
86 void *
87 stgReallocBytes (void *p, size_t n, char *msg)
88 {
89 void *space;
90
91 if ((space = realloc(p, n)) == NULL) {
92 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
93 rtsConfig.mallocFailHook((W_) n, msg); /*msg*/
94 stg_exit(EXIT_INTERNAL_ERROR);
95 }
96 return space;
97 }
98
99 void *
100 stgCallocBytes (size_t n, size_t m, char *msg)
101 {
102 void *space;
103
104 if ((space = calloc(n, m)) == NULL) {
105 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
106 rtsConfig.mallocFailHook((W_) n*m, msg); /*msg*/
107 stg_exit(EXIT_INTERNAL_ERROR);
108 }
109 return space;
110 }
111
112 /* borrowed from the MUSL libc project */
113 char *stgStrndup(const char *s, size_t n)
114 {
115 size_t l = strnlen(s, n);
116 char *d = stgMallocBytes(l+1, "stgStrndup");
117 if (!d) return NULL;
118 memcpy(d, s, l);
119 d[l] = 0;
120 return d;
121 }
122
123
124 /* To simplify changing the underlying allocator used
125 * by stgMallocBytes(), provide stgFree() as well.
126 */
127 void
128 stgFree(void* p)
129 {
130 free(p);
131 }
132
133 /* -----------------------------------------------------------------------------
134 Stack overflow
135
136 Not sure if this belongs here.
137 -------------------------------------------------------------------------- */
138
139 void
140 stackOverflow(StgTSO* tso)
141 {
142 rtsConfig.stackOverflowHook(tso->tot_stack_size * sizeof(W_));
143
144 #if defined(TICKY_TICKY)
145 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
146 #endif
147 }
148
149 void
150 heapOverflow(void)
151 {
152 if (!heap_overflow)
153 {
154 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
155 rtsConfig.outOfHeapHook(0/*unknown request size*/,
156 (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
157
158 heap_overflow = true;
159 }
160 }
161
162 /* -----------------------------------------------------------------------------
163 Get the current time as a string. Used in profiling reports.
164 -------------------------------------------------------------------------- */
165
166 char *
167 time_str(void)
168 {
169 static time_t now = 0;
170 static char nowstr[26];
171
172 if (now == 0) {
173 time(&now);
174 #if HAVE_CTIME_R
175 ctime_r(&now, nowstr);
176 #else
177 strcpy(nowstr, ctime(&now));
178 #endif
179 memmove(nowstr+16,nowstr+19,7);
180 nowstr[21] = '\0'; // removes the \n
181 }
182 return nowstr;
183 }
184
185 /* -----------------------------------------------------------------------------
186 Print large numbers, with punctuation.
187 -------------------------------------------------------------------------- */
188
189 char *
190 showStgWord64(StgWord64 x, char *s, bool with_commas)
191 {
192 if (with_commas) {
193 if (x < (StgWord64)1e3)
194 sprintf(s, "%" FMT_Word64, (StgWord64)x);
195 else if (x < (StgWord64)1e6)
196 sprintf(s, "%" FMT_Word64 ",%03" FMT_Word64,
197 (StgWord64)(x / 1000),
198 (StgWord64)(x % 1000));
199 else if (x < (StgWord64)1e9)
200 sprintf(s, "%" FMT_Word64
201 ",%03" FMT_Word64
202 ",%03" FMT_Word64,
203 (StgWord64)(x / 1e6),
204 (StgWord64)((x / 1000) % 1000),
205 (StgWord64)(x % 1000));
206 else if (x < (StgWord64)1e12)
207 sprintf(s, "%" FMT_Word64
208 ",%03" FMT_Word64
209 ",%03" FMT_Word64
210 ",%03" FMT_Word64,
211 (StgWord64)(x / (StgWord64)1e9),
212 (StgWord64)((x / (StgWord64)1e6) % 1000),
213 (StgWord64)((x / (StgWord64)1e3) % 1000),
214 (StgWord64)(x % 1000));
215 else if (x < (StgWord64)1e15)
216 sprintf(s, "%" FMT_Word64
217 ",%03" FMT_Word64
218 ",%03" FMT_Word64
219 ",%03" FMT_Word64
220 ",%03" FMT_Word64,
221 (StgWord64)(x / (StgWord64)1e12),
222 (StgWord64)((x / (StgWord64)1e9) % 1000),
223 (StgWord64)((x / (StgWord64)1e6) % 1000),
224 (StgWord64)((x / (StgWord64)1e3) % 1000),
225 (StgWord64)(x % 1000));
226 else if (x < (StgWord64)1e18)
227 sprintf(s, "%" FMT_Word64
228 ",%03" FMT_Word64
229 ",%03" FMT_Word64
230 ",%03" FMT_Word64
231 ",%03" FMT_Word64
232 ",%03" FMT_Word64,
233 (StgWord64)(x / (StgWord64)1e15),
234 (StgWord64)((x / (StgWord64)1e12) % 1000),
235 (StgWord64)((x / (StgWord64)1e9) % 1000),
236 (StgWord64)((x / (StgWord64)1e6) % 1000),
237 (StgWord64)((x / (StgWord64)1e3) % 1000),
238 (StgWord64)(x % 1000));
239 else
240 sprintf(s, "%" FMT_Word64
241 ",%03" FMT_Word64
242 ",%03" FMT_Word64
243 ",%03" FMT_Word64
244 ",%03" FMT_Word64
245 ",%03" FMT_Word64
246 ",%03" FMT_Word64,
247 (StgWord64)(x / (StgWord64)1e18),
248 (StgWord64)((x / (StgWord64)1e15) % 1000),
249 (StgWord64)((x / (StgWord64)1e12) % 1000),
250 (StgWord64)((x / (StgWord64)1e9) % 1000),
251 (StgWord64)((x / (StgWord64)1e6) % 1000),
252 (StgWord64)((x / (StgWord64)1e3) % 1000),
253 (StgWord64)(x % 1000));
254 }
255 else {
256 sprintf(s, "%" FMT_Word64, x);
257 }
258 return s;
259 }
260
261
262 // Can be used as a breakpoint to set on every heap check failure.
263 #ifdef DEBUG
264 void
265 heapCheckFail( void )
266 {
267 }
268 #endif
269
270 /*
271 * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
272 * pthreads (and possibly others). When linking with -lpthreads, we
273 * have to use pthread_kill to send blockable signals. So use that
274 * when we have a threaded rts. So System.Posix.Signals will call
275 * genericRaise(), rather than raise(3).
276 */
277 int genericRaise(int sig) {
278 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS))
279 return pthread_kill(pthread_self(), sig);
280 #else
281 return raise(sig);
282 #endif
283 }
284
285 static void mkRtsInfoPair(char *key, char *val) {
286 /* XXX should check for "s, \s etc in key and val */
287 printf(" ,(\"%s\", \"%s\")\n", key, val);
288 }
289
290 /* This little bit of magic allows us to say TOSTRING(SYM) and get
291 * "5" if SYM is 5 */
292 #define TOSTRING2(x) #x
293 #define TOSTRING(x) TOSTRING2(x)
294
295 void printRtsInfo(void) {
296 /* The first entry is just a hack to make it easy to get the
297 * commas right */
298 printf(" [(\"GHC RTS\", \"YES\")\n");
299 mkRtsInfoPair("GHC version", ProjectVersion);
300 mkRtsInfoPair("RTS way", RtsWay);
301 mkRtsInfoPair("Build platform", BuildPlatform);
302 mkRtsInfoPair("Build architecture", BuildArch);
303 mkRtsInfoPair("Build OS", BuildOS);
304 mkRtsInfoPair("Build vendor", BuildVendor);
305 mkRtsInfoPair("Host platform", HostPlatform);
306 mkRtsInfoPair("Host architecture", HostArch);
307 mkRtsInfoPair("Host OS", HostOS);
308 mkRtsInfoPair("Host vendor", HostVendor);
309 mkRtsInfoPair("Target platform", TargetPlatform);
310 mkRtsInfoPair("Target architecture", TargetArch);
311 mkRtsInfoPair("Target OS", TargetOS);
312 mkRtsInfoPair("Target vendor", TargetVendor);
313 mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS));
314 mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
315 mkRtsInfoPair("Tables next to code", GhcEnableTablesNextToCode);
316 printf(" ]\n");
317 }
318
319 // Provides a way for Haskell programs to tell whether they're being
320 // profiled or not. GHCi uses it (see #2197).
321 int rts_isProfiled(void)
322 {
323 #ifdef PROFILING
324 return 1;
325 #else
326 return 0;
327 #endif
328 }
329
330 // Provides a way for Haskell programs to tell whether they're
331 // dynamically-linked or not.
332 int rts_isDynamic(void)
333 {
334 #ifdef DYNAMIC
335 return 1;
336 #else
337 return 0;
338 #endif
339 }
340
341 // Used for detecting a non-empty FPU stack on x86 (see #4914)
342 void checkFPUStack(void)
343 {
344 #ifdef i386_HOST_ARCH
345 static unsigned char buf[108];
346 asm("FSAVE %0":"=m" (buf));
347
348 if(buf[8]!=255 || buf[9]!=255) {
349 errorBelch("NONEMPTY FPU Stack, TAG = %x %x\n",buf[8],buf[9]);
350 abort();
351 }
352 #endif
353 }
354