rts: Don't use strndup
[ghc.git] / rts / RtsStartup.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2002
4 *
5 * Main function for a standalone Haskell program.
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "Rts.h"
10 #include "RtsAPI.h"
11 #include "HsFFI.h"
12
13 #include "sm/Storage.h"
14 #include "RtsFlags.h"
15 #include "RtsUtils.h"
16 #include "Prelude.h"
17 #include "Printer.h" /* DEBUG_LoadSymbols */
18 #include "Schedule.h" /* initScheduler */
19 #include "Stats.h" /* initStats */
20 #include "STM.h" /* initSTM */
21 #include "RtsSignals.h"
22 #include "Weak.h"
23 #include "Ticky.h"
24 #include "StgRun.h"
25 #include "Prelude.h" /* fixupRTStoPreludeRefs */
26 #include "ThreadLabels.h"
27 #include "sm/BlockAlloc.h"
28 #include "Trace.h"
29 #include "Stable.h"
30 #include "StaticPtrTable.h"
31 #include "Hash.h"
32 #include "Profiling.h"
33 #include "Timer.h"
34 #include "Globals.h"
35 #include "FileLock.h"
36 #include "LinkerInternals.h"
37 #include "LibdwPool.h"
38
39 #if defined(PROFILING)
40 # include "ProfHeap.h"
41 # include "RetainerProfile.h"
42 #endif
43
44 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
45 #include "win32/AsyncIO.h"
46 #endif
47
48 #if !defined(mingw32_HOST_OS)
49 #include "posix/TTY.h"
50 #endif
51
52 #ifdef HAVE_UNISTD_H
53 #include <unistd.h>
54 #endif
55 #ifdef HAVE_LOCALE_H
56 #include <locale.h>
57 #endif
58
59 // Count of how many outstanding hs_init()s there have been.
60 static int hs_init_count = 0;
61
62 static void flushStdHandles(void);
63
64 /* -----------------------------------------------------------------------------
65 Initialise floating point unit on x86 (currently disabled; See Note
66 [x86 Floating point precision] in compiler/nativeGen/X86/Instr.hs)
67 -------------------------------------------------------------------------- */
68
69 #define X86_INIT_FPU 0
70
71 #if X86_INIT_FPU
72 static void
73 x86_init_fpu ( void )
74 {
75 __volatile unsigned short int fpu_cw;
76
77 // Grab the control word
78 __asm __volatile ("fnstcw %0" : "=m" (fpu_cw));
79
80 #if 0
81 printf("fpu_cw: %x\n", fpu_cw);
82 #endif
83
84 // Set bits 8-9 to 10 (64-bit precision).
85 fpu_cw = (fpu_cw & 0xfcff) | 0x0200;
86
87 // Store the new control word back
88 __asm __volatile ("fldcw %0" : : "m" (fpu_cw));
89 }
90 #endif
91
92 /* -----------------------------------------------------------------------------
93 Starting up the RTS
94 -------------------------------------------------------------------------- */
95
96 void
97 hs_init(int *argc, char **argv[])
98 {
99 hs_init_ghc(argc, argv, defaultRtsConfig);
100 }
101
102 void
103 hs_init_with_rtsopts(int *argc, char **argv[])
104 {
105 RtsConfig rts_opts = defaultRtsConfig; /* by value */
106 rts_opts.rts_opts_enabled = RtsOptsAll;
107 hs_init_ghc(argc, argv, rts_opts);
108 }
109
110 void
111 hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
112 {
113 hs_init_count++;
114 if (hs_init_count > 1) {
115 // second and subsequent inits are ignored
116 return;
117 }
118
119 setlocale(LC_CTYPE,"");
120
121 /* Initialise the stats department, phase 0 */
122 initStats0();
123
124 /* Initialize system timer before starting to collect stats */
125 initializeTimer();
126
127 /* Next we do is grab the start time...just in case we're
128 * collecting timing statistics.
129 */
130 stat_startInit();
131
132 /* Set the RTS flags to default values. */
133 initRtsFlagsDefaults();
134
135 /* Call the user hook to reset defaults, if present */
136 rts_config.defaultsHook();
137
138 /* Whether to GC CAFs */
139 if (rts_config.keep_cafs) {
140 setKeepCAFs();
141 }
142
143 /* Parse the flags, separating the RTS flags from the programs args */
144 if (argc == NULL || argv == NULL) {
145 // Use a default for argc & argv if either is not supplied
146 int my_argc = 1;
147 char *my_argv[] = { "<unknown>", NULL };
148 setFullProgArgv(my_argc,my_argv);
149 setupRtsFlags(&my_argc, my_argv, rts_config);
150 } else {
151 setFullProgArgv(*argc,*argv);
152 setupRtsFlags(argc, *argv, rts_config);
153
154 #ifdef DEBUG
155 /* load debugging symbols for current binary */
156 DEBUG_LoadSymbols((*argv)[0]);
157 #endif /* DEBUG */
158 }
159
160 /* Initialise the stats department, phase 1 */
161 initStats1();
162
163 /* initTracing must be after setupRtsFlags() */
164 #ifdef TRACING
165 initTracing();
166 #endif
167
168 /* Initialise libdw session pool */
169 libdwPoolInit();
170
171 /* initialise scheduler data structures (needs to be done before
172 * initStorage()).
173 */
174 initScheduler();
175
176 /* Trace some basic information about the process */
177 traceWallClockTime();
178 traceOSProcessInfo();
179
180 /* initialize the storage manager */
181 initStorage();
182
183 /* initialise the stable pointer table */
184 initStableTables();
185
186 /* Add some GC roots for things in the base package that the RTS
187 * knows about. We don't know whether these turn out to be CAFs
188 * or refer to CAFs, but we have to assume that they might.
189 */
190 getStablePtr((StgPtr)runIO_closure);
191 getStablePtr((StgPtr)runNonIO_closure);
192 getStablePtr((StgPtr)flushStdHandles_closure);
193
194 getStablePtr((StgPtr)runFinalizerBatch_closure);
195
196 getStablePtr((StgPtr)stackOverflow_closure);
197 getStablePtr((StgPtr)heapOverflow_closure);
198 getStablePtr((StgPtr)unpackCString_closure);
199 getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
200 getStablePtr((StgPtr)nonTermination_closure);
201 getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
202 getStablePtr((StgPtr)allocationLimitExceeded_closure);
203 getStablePtr((StgPtr)nestedAtomically_closure);
204
205 getStablePtr((StgPtr)runSparks_closure);
206 getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
207 getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
208 #ifndef mingw32_HOST_OS
209 getStablePtr((StgPtr)blockedOnBadFD_closure);
210 getStablePtr((StgPtr)runHandlersPtr_closure);
211 #endif
212
213 /* initialise the shared Typeable store */
214 initGlobalStore();
215
216 /* initialise file locking, if necessary */
217 initFileLocking();
218
219 #if defined(DEBUG)
220 /* initialise thread label table (tso->char*) */
221 initThreadLabelTable();
222 #endif
223
224 initProfiling();
225
226 /* start the virtual timer 'subsystem'. */
227 initTimer();
228 startTimer();
229
230 #if defined(RTS_USER_SIGNALS)
231 if (RtsFlags.MiscFlags.install_signal_handlers) {
232 /* Initialise the user signal handler set */
233 initUserSignals();
234 /* Set up handler to run on SIGINT, etc. */
235 initDefaultHandlers();
236 }
237 #endif
238
239 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
240 startupAsyncIO();
241 #endif
242
243 #if X86_INIT_FPU
244 x86_init_fpu();
245 #endif
246
247 startupHpc();
248
249 // ditto.
250 #if defined(THREADED_RTS)
251 ioManagerStart();
252 #endif
253
254 /* Record initialization times */
255 stat_endInit();
256 }
257
258 // Compatibility interface
259 void
260 startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
261 {
262 hs_init(&argc, &argv);
263 }
264
265
266 /* -----------------------------------------------------------------------------
267 hs_add_root: backwards compatibility. (see #3252)
268 -------------------------------------------------------------------------- */
269
270 void
271 hs_add_root(void (*init_root)(void) STG_UNUSED)
272 {
273 /* nothing */
274 }
275
276 /* ----------------------------------------------------------------------------
277 * Shutting down the RTS
278 *
279 * The wait_foreign parameter means:
280 * True ==> wait for any threads doing foreign calls now.
281 * False ==> threads doing foreign calls may return in the
282 * future, but will immediately block on a mutex.
283 * (capability->lock).
284 *
285 * If this RTS is a DLL that we're about to unload, then you want
286 * safe=True, otherwise the thread might return to code that has been
287 * unloaded. If this is a standalone program that is about to exit,
288 * then you can get away with safe=False, which is better because we
289 * won't hang on exit if there is a blocked foreign call outstanding.
290 *
291 ------------------------------------------------------------------------- */
292
293 static void
294 hs_exit_(rtsBool wait_foreign)
295 {
296 nat g, i;
297
298 if (hs_init_count <= 0) {
299 errorBelch("warning: too many hs_exit()s");
300 return;
301 }
302 hs_init_count--;
303 if (hs_init_count > 0) {
304 // ignore until it's the last one
305 return;
306 }
307
308 /* start timing the shutdown */
309 stat_startExit();
310
311 rtsConfig.onExitHook();
312
313 flushStdHandles();
314
315 // sanity check
316 #if defined(DEBUG)
317 checkFPUStack();
318 #endif
319
320 #if defined(THREADED_RTS)
321 ioManagerDie();
322 #endif
323
324 /* stop all running tasks */
325 exitScheduler(wait_foreign);
326
327 /* run C finalizers for all active weak pointers */
328 for (i = 0; i < n_capabilities; i++) {
329 runAllCFinalizers(capabilities[i]->weak_ptr_list_hd);
330 }
331 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
332 runAllCFinalizers(generations[g].weak_ptr_list);
333 }
334
335 #if defined(RTS_USER_SIGNALS)
336 if (RtsFlags.MiscFlags.install_signal_handlers) {
337 freeSignalHandlers();
338 }
339 #endif
340
341 /* stop the ticker */
342 stopTimer();
343 exitTimer(wait_foreign);
344
345 // set the terminal settings back to what they were
346 #if !defined(mingw32_HOST_OS)
347 resetTerminalSettings();
348 #endif
349
350 #if defined(RTS_USER_SIGNALS)
351 if (RtsFlags.MiscFlags.install_signal_handlers) {
352 // uninstall signal handlers
353 resetDefaultHandlers();
354 }
355 #endif
356
357 /* stop timing the shutdown, we're about to print stats */
358 stat_endExit();
359
360 /* shutdown the hpc support (if needed) */
361 exitHpc();
362
363 // clean up things from the storage manager's point of view.
364 // also outputs the stats (+RTS -s) info.
365 exitStorage();
366
367 /* free the tasks */
368 freeScheduler();
369
370 /* free shared Typeable store */
371 exitGlobalStore();
372
373 /* free linker data */
374 exitLinker();
375
376 /* free file locking tables, if necessary */
377 freeFileLocking();
378
379 /* free the Static Pointer Table */
380 exitStaticPtrTable();
381
382 /* free the stable pointer table */
383 exitStableTables();
384
385 #if defined(DEBUG)
386 /* free the thread label table */
387 freeThreadLabelTable();
388 #endif
389
390 #if defined(PROFILING)
391 reportCCSProfiling();
392 #endif
393
394 endProfiling();
395 freeProfiling();
396
397 #ifdef PROFILING
398 // Originally, this was in report_ccs_profiling(). Now, retainer
399 // profiling might tack some extra stuff on to the end of this file
400 // during endProfiling().
401 if (prof_file != NULL) fclose(prof_file);
402 #endif
403
404 #ifdef TRACING
405 endTracing();
406 freeTracing();
407 #endif
408
409 #if defined(TICKY_TICKY)
410 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
411
412 FILE *tf = RtsFlags.TickyFlags.tickyFile;
413 if (tf != NULL) fclose(tf);
414 #endif
415
416 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
417 shutdownAsyncIO(wait_foreign);
418 #endif
419
420 /* free hash table storage */
421 exitHashTable();
422
423 // Finally, free all our storage. However, we only free the heap
424 // memory if we have waited for foreign calls to complete;
425 // otherwise a foreign call in progress may still be referencing
426 // heap memory (e.g. by being passed a ByteArray#).
427 freeStorage(wait_foreign);
428
429 // Free the various argvs
430 freeRtsArgs();
431 }
432
433 // Flush stdout and stderr. We do this during shutdown so that it
434 // happens even when the RTS is being used as a library, without a
435 // main (#5594)
436 static void flushStdHandles(void)
437 {
438 Capability *cap;
439 cap = rts_lock();
440 rts_evalIO(&cap, flushStdHandles_closure, NULL);
441 rts_unlock(cap);
442 }
443
444 // The real hs_exit():
445 void
446 hs_exit(void)
447 {
448 hs_exit_(rtsTrue);
449 // be safe; this might be a DLL
450 }
451
452 // Compatibility interfaces
453 void
454 shutdownHaskell(void)
455 {
456 hs_exit();
457 }
458
459 void
460 shutdownHaskellAndExit(int n, int fastExit)
461 {
462 if (!fastExit) {
463 // even if hs_init_count > 1, we still want to shut down the RTS
464 // and exit immediately (see #5402)
465 hs_init_count = 1;
466
467 // we're about to exit(), no need to wait for foreign calls to return.
468 hs_exit_(rtsFalse);
469 }
470
471 stg_exit(n);
472 }
473
474 #ifndef mingw32_HOST_OS
475 static void exitBySignal(int sig) GNUC3_ATTRIBUTE(__noreturn__);
476
477 void
478 shutdownHaskellAndSignal(int sig, int fastExit)
479 {
480 if (!fastExit) {
481 hs_exit_(rtsFalse);
482 }
483
484 exitBySignal(sig);
485 }
486
487 void
488 exitBySignal(int sig)
489 {
490 // We're trying to kill ourselves with a given signal.
491 // That's easier said that done because:
492 // - signals can be ignored have handlers set for them
493 // - signals can be masked
494 // - signals default action can do things other than terminate:
495 // + can do nothing
496 // + can do weirder things: stop/continue the process
497
498 struct sigaction dfl;
499 sigset_t sigset;
500
501 // So first of all, we reset the signal to use the default action.
502 (void)sigemptyset(&dfl.sa_mask);
503 dfl.sa_flags = 0;
504 dfl.sa_handler = SIG_DFL;
505 (void)sigaction(sig, &dfl, NULL);
506
507 // Then we unblock the signal so we can deliver it to ourselves
508 sigemptyset(&sigset);
509 sigaddset(&sigset, sig);
510 sigprocmask(SIG_UNBLOCK, &sigset, NULL);
511
512 switch (sig) {
513 case SIGSTOP: case SIGTSTP: case SIGTTIN: case SIGTTOU: case SIGCONT:
514 // These signals stop (or continue) the process, so are no good for
515 // exiting.
516 exit(0xff);
517
518 default:
519 kill(getpid(),sig);
520 // But it's possible the signal is one where the default action is to
521 // ignore, in which case we'll still be alive... so just exit.
522 exit(0xff);
523 }
524 }
525 #endif
526
527 /*
528 * called from STG-land to exit the program
529 */
530
531 void (*exitFn)(int) = 0;
532
533 void
534 stg_exit(int n)
535 {
536 if (exitFn)
537 (*exitFn)(n);
538 exit(n);
539 }