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