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