Revert "Enable new warning for fragile/incorrect CPP #if usage"
[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/heap overflow
135 -------------------------------------------------------------------------- */
136
137 void
138 reportStackOverflow(StgTSO* tso)
139 {
140 rtsConfig.stackOverflowHook(tso->tot_stack_size * sizeof(W_));
141
142 #if defined(TICKY_TICKY)
143 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
144 #endif
145 }
146
147 void
148 reportHeapOverflow(void)
149 {
150 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
151 rtsConfig.outOfHeapHook(0/*unknown request size*/,
152 (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
153 }
154
155 /* -----------------------------------------------------------------------------
156 Get the current time as a string. Used in profiling reports.
157 -------------------------------------------------------------------------- */
158
159 char *
160 time_str(void)
161 {
162 static time_t now = 0;
163 static char nowstr[26];
164
165 if (now == 0) {
166 time(&now);
167 #if HAVE_CTIME_R
168 ctime_r(&now, nowstr);
169 #else
170 strcpy(nowstr, ctime(&now));
171 #endif
172 memmove(nowstr+16,nowstr+19,7);
173 nowstr[21] = '\0'; // removes the \n
174 }
175 return nowstr;
176 }
177
178 /* -----------------------------------------------------------------------------
179 Print large numbers, with punctuation.
180 -------------------------------------------------------------------------- */
181
182 char *
183 showStgWord64(StgWord64 x, char *s, bool with_commas)
184 {
185 if (with_commas) {
186 if (x < (StgWord64)1e3)
187 sprintf(s, "%" FMT_Word64, (StgWord64)x);
188 else if (x < (StgWord64)1e6)
189 sprintf(s, "%" FMT_Word64 ",%03" FMT_Word64,
190 (StgWord64)(x / 1000),
191 (StgWord64)(x % 1000));
192 else if (x < (StgWord64)1e9)
193 sprintf(s, "%" FMT_Word64
194 ",%03" FMT_Word64
195 ",%03" FMT_Word64,
196 (StgWord64)(x / 1e6),
197 (StgWord64)((x / 1000) % 1000),
198 (StgWord64)(x % 1000));
199 else if (x < (StgWord64)1e12)
200 sprintf(s, "%" FMT_Word64
201 ",%03" FMT_Word64
202 ",%03" FMT_Word64
203 ",%03" FMT_Word64,
204 (StgWord64)(x / (StgWord64)1e9),
205 (StgWord64)((x / (StgWord64)1e6) % 1000),
206 (StgWord64)((x / (StgWord64)1e3) % 1000),
207 (StgWord64)(x % 1000));
208 else if (x < (StgWord64)1e15)
209 sprintf(s, "%" FMT_Word64
210 ",%03" FMT_Word64
211 ",%03" FMT_Word64
212 ",%03" FMT_Word64
213 ",%03" FMT_Word64,
214 (StgWord64)(x / (StgWord64)1e12),
215 (StgWord64)((x / (StgWord64)1e9) % 1000),
216 (StgWord64)((x / (StgWord64)1e6) % 1000),
217 (StgWord64)((x / (StgWord64)1e3) % 1000),
218 (StgWord64)(x % 1000));
219 else if (x < (StgWord64)1e18)
220 sprintf(s, "%" FMT_Word64
221 ",%03" FMT_Word64
222 ",%03" FMT_Word64
223 ",%03" FMT_Word64
224 ",%03" FMT_Word64
225 ",%03" FMT_Word64,
226 (StgWord64)(x / (StgWord64)1e15),
227 (StgWord64)((x / (StgWord64)1e12) % 1000),
228 (StgWord64)((x / (StgWord64)1e9) % 1000),
229 (StgWord64)((x / (StgWord64)1e6) % 1000),
230 (StgWord64)((x / (StgWord64)1e3) % 1000),
231 (StgWord64)(x % 1000));
232 else
233 sprintf(s, "%" FMT_Word64
234 ",%03" FMT_Word64
235 ",%03" FMT_Word64
236 ",%03" FMT_Word64
237 ",%03" FMT_Word64
238 ",%03" FMT_Word64
239 ",%03" FMT_Word64,
240 (StgWord64)(x / (StgWord64)1e18),
241 (StgWord64)((x / (StgWord64)1e15) % 1000),
242 (StgWord64)((x / (StgWord64)1e12) % 1000),
243 (StgWord64)((x / (StgWord64)1e9) % 1000),
244 (StgWord64)((x / (StgWord64)1e6) % 1000),
245 (StgWord64)((x / (StgWord64)1e3) % 1000),
246 (StgWord64)(x % 1000));
247 }
248 else {
249 sprintf(s, "%" FMT_Word64, x);
250 }
251 return s;
252 }
253
254
255 // Can be used as a breakpoint to set on every heap check failure.
256 #ifdef DEBUG
257 void
258 heapCheckFail( void )
259 {
260 }
261 #endif
262
263 /*
264 * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
265 * pthreads (and possibly others). When linking with -lpthreads, we
266 * have to use pthread_kill to send blockable signals. So use that
267 * when we have a threaded rts. So System.Posix.Signals will call
268 * genericRaise(), rather than raise(3).
269 */
270 int genericRaise(int sig) {
271 #if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS))
272 return pthread_kill(pthread_self(), sig);
273 #else
274 return raise(sig);
275 #endif
276 }
277
278 static void mkRtsInfoPair(char *key, char *val) {
279 /* XXX should check for "s, \s etc in key and val */
280 printf(" ,(\"%s\", \"%s\")\n", key, val);
281 }
282
283 /* This little bit of magic allows us to say TOSTRING(SYM) and get
284 * "5" if SYM is 5 */
285 #define TOSTRING2(x) #x
286 #define TOSTRING(x) TOSTRING2(x)
287
288 void printRtsInfo(void) {
289 /* The first entry is just a hack to make it easy to get the
290 * commas right */
291 printf(" [(\"GHC RTS\", \"YES\")\n");
292 mkRtsInfoPair("GHC version", ProjectVersion);
293 mkRtsInfoPair("RTS way", RtsWay);
294 mkRtsInfoPair("Build platform", BuildPlatform);
295 mkRtsInfoPair("Build architecture", BuildArch);
296 mkRtsInfoPair("Build OS", BuildOS);
297 mkRtsInfoPair("Build vendor", BuildVendor);
298 mkRtsInfoPair("Host platform", HostPlatform);
299 mkRtsInfoPair("Host architecture", HostArch);
300 mkRtsInfoPair("Host OS", HostOS);
301 mkRtsInfoPair("Host vendor", HostVendor);
302 mkRtsInfoPair("Target platform", TargetPlatform);
303 mkRtsInfoPair("Target architecture", TargetArch);
304 mkRtsInfoPair("Target OS", TargetOS);
305 mkRtsInfoPair("Target vendor", TargetVendor);
306 mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS));
307 mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
308 mkRtsInfoPair("Tables next to code", GhcEnableTablesNextToCode);
309 printf(" ]\n");
310 }
311
312 // Provides a way for Haskell programs to tell whether they're being
313 // profiled or not. GHCi uses it (see #2197).
314 int rts_isProfiled(void)
315 {
316 #ifdef PROFILING
317 return 1;
318 #else
319 return 0;
320 #endif
321 }
322
323 // Provides a way for Haskell programs to tell whether they're
324 // dynamically-linked or not.
325 int rts_isDynamic(void)
326 {
327 #ifdef DYNAMIC
328 return 1;
329 #else
330 return 0;
331 #endif
332 }
333
334 // Used for detecting a non-empty FPU stack on x86 (see #4914)
335 void checkFPUStack(void)
336 {
337 #ifdef i386_HOST_ARCH
338 static unsigned char buf[108];
339 asm("FSAVE %0":"=m" (buf));
340
341 if(buf[8]!=255 || buf[9]!=255) {
342 errorBelch("NONEMPTY FPU Stack, TAG = %x %x\n",buf[8],buf[9]);
343 abort();
344 }
345 #endif
346 }