Prefer #if defined to #ifdef
[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 #if defined(HAVE_UNISTD_H)
57 #include <unistd.h>
58 #endif
59 #if defined(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 #if defined(__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 #if defined(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 #if defined(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 #if !defined(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 * Shutting down the RTS
306 *
307 * The wait_foreign parameter means:
308 * True ==> wait for any threads doing foreign calls now.
309 * False ==> threads doing foreign calls may return in the
310 * future, but will immediately block on a mutex.
311 * (capability->lock).
312 *
313 * If this RTS is a DLL that we're about to unload, then you want
314 * safe=True, otherwise the thread might return to code that has been
315 * unloaded. If this is a standalone program that is about to exit,
316 * then you can get away with safe=False, which is better because we
317 * won't hang on exit if there is a blocked foreign call outstanding.
318 *
319 ------------------------------------------------------------------------- */
320
321 static void
322 hs_exit_(bool wait_foreign)
323 {
324 uint32_t g, i;
325
326 if (hs_init_count <= 0) {
327 errorBelch("warning: too many hs_exit()s");
328 return;
329 }
330 hs_init_count--;
331 if (hs_init_count > 0) {
332 // ignore until it's the last one
333 return;
334 }
335 rts_shutdown = true;
336
337 /* start timing the shutdown */
338 stat_startExit();
339
340 rtsConfig.onExitHook();
341
342 flushStdHandles();
343
344 // sanity check
345 #if defined(DEBUG)
346 checkFPUStack();
347 #endif
348
349 #if defined(THREADED_RTS)
350 ioManagerDie();
351 #endif
352
353 /* stop all running tasks */
354 exitScheduler(wait_foreign);
355
356 /* run C finalizers for all active weak pointers */
357 for (i = 0; i < n_capabilities; i++) {
358 runAllCFinalizers(capabilities[i]->weak_ptr_list_hd);
359 }
360 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
361 runAllCFinalizers(generations[g].weak_ptr_list);
362 }
363
364 #if defined(RTS_USER_SIGNALS)
365 if (RtsFlags.MiscFlags.install_signal_handlers) {
366 freeSignalHandlers();
367 }
368 #endif
369
370 /* stop the ticker */
371 stopTimer();
372 /*
373 * it is quite important that we wait here as some timer implementations
374 * (e.g. pthread) may fire even after we exit, which may segfault as we've
375 * already freed the capabilities.
376 */
377 exitTimer(true);
378
379 // set the terminal settings back to what they were
380 #if !defined(mingw32_HOST_OS)
381 resetTerminalSettings();
382 #endif
383
384 #if defined(RTS_USER_SIGNALS)
385 if (RtsFlags.MiscFlags.install_signal_handlers) {
386 // uninstall signal handlers
387 resetDefaultHandlers();
388 }
389 #endif
390
391 /* stop timing the shutdown, we're about to print stats */
392 stat_endExit();
393
394 /* shutdown the hpc support (if needed) */
395 exitHpc();
396
397 // clean up things from the storage manager's point of view.
398 // also outputs the stats (+RTS -s) info.
399 exitStorage();
400
401 /* free the tasks */
402 freeScheduler();
403
404 /* free shared Typeable store */
405 exitGlobalStore();
406
407 /* free linker data */
408 exitLinker();
409
410 /* free file locking tables, if necessary */
411 freeFileLocking();
412
413 /* free the Static Pointer Table */
414 exitStaticPtrTable();
415
416 /* remove the top-level handler */
417 exitTopHandler();
418
419 /* free the stable pointer table */
420 exitStableTables();
421
422 #if defined(DEBUG)
423 /* free the thread label table */
424 freeThreadLabelTable();
425 #endif
426
427 #if defined(PROFILING)
428 reportCCSProfiling();
429 #endif
430
431 endProfiling();
432 freeProfiling();
433
434 #if defined(PROFILING)
435 // Originally, this was in report_ccs_profiling(). Now, retainer
436 // profiling might tack some extra stuff on to the end of this file
437 // during endProfiling().
438 if (prof_file != NULL) fclose(prof_file);
439 #endif
440
441 #if defined(TRACING)
442 endTracing();
443 freeTracing();
444 #endif
445
446 #if defined(TICKY_TICKY)
447 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
448
449 FILE *tf = RtsFlags.TickyFlags.tickyFile;
450 if (tf != NULL) fclose(tf);
451 #endif
452
453 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
454 shutdownAsyncIO(wait_foreign);
455 #endif
456
457 /* free hash table storage */
458 exitHashTable();
459
460 // Finally, free all our storage. However, we only free the heap
461 // memory if we have waited for foreign calls to complete;
462 // otherwise a foreign call in progress may still be referencing
463 // heap memory (e.g. by being passed a ByteArray#).
464 freeStorage(wait_foreign);
465
466 // Free the various argvs
467 freeRtsArgs();
468
469 // Free threading resources
470 freeThreadingResources();
471 }
472
473 // Flush stdout and stderr. We do this during shutdown so that it
474 // happens even when the RTS is being used as a library, without a
475 // main (#5594)
476 static void flushStdHandles(void)
477 {
478 Capability *cap;
479 cap = rts_lock();
480 rts_evalIO(&cap, flushStdHandles_closure, NULL);
481 rts_unlock(cap);
482 }
483
484 // The real hs_exit():
485 void
486 hs_exit(void)
487 {
488 hs_exit_(true);
489 // be safe; this might be a DLL
490 }
491
492 void
493 hs_exit_nowait(void)
494 {
495 hs_exit_(false);
496 // do not wait for outstanding foreign calls to return; if they return in
497 // the future, they will block indefinitely.
498 }
499
500 // Compatibility interfaces
501 void
502 shutdownHaskell(void)
503 {
504 hs_exit();
505 }
506
507 void
508 shutdownHaskellAndExit(int n, int fastExit)
509 {
510 if (!fastExit) {
511 // we're about to exit(), no need to wait for foreign calls to return.
512 hs_exit_(false);
513 }
514
515 stg_exit(n);
516 }
517
518 #if !defined(mingw32_HOST_OS)
519 static void exitBySignal(int sig) GNUC3_ATTRIBUTE(__noreturn__);
520
521 void
522 shutdownHaskellAndSignal(int sig, int fastExit)
523 {
524 if (!fastExit) {
525 hs_exit_(false);
526 }
527
528 exitBySignal(sig);
529 }
530
531 void
532 exitBySignal(int sig)
533 {
534 // We're trying to kill ourselves with a given signal.
535 // That's easier said that done because:
536 // - signals can be ignored have handlers set for them
537 // - signals can be masked
538 // - signals default action can do things other than terminate:
539 // + can do nothing
540 // + can do weirder things: stop/continue the process
541
542 struct sigaction dfl;
543 sigset_t sigset;
544
545 // So first of all, we reset the signal to use the default action.
546 (void)sigemptyset(&dfl.sa_mask);
547 dfl.sa_flags = 0;
548 dfl.sa_handler = SIG_DFL;
549 (void)sigaction(sig, &dfl, NULL);
550
551 // Then we unblock the signal so we can deliver it to ourselves
552 sigemptyset(&sigset);
553 sigaddset(&sigset, sig);
554 sigprocmask(SIG_UNBLOCK, &sigset, NULL);
555
556 switch (sig) {
557 case SIGSTOP: case SIGTSTP: case SIGTTIN: case SIGTTOU: case SIGCONT:
558 // These signals stop (or continue) the process, so are no good for
559 // exiting.
560 exit(0xff);
561
562 default:
563 kill(getpid(),sig);
564 // But it's possible the signal is one where the default action is to
565 // ignore, in which case we'll still be alive... so just exit.
566 exit(0xff);
567 }
568 }
569 #endif
570
571 /*
572 * called from STG-land to exit the program
573 */
574
575 void (*exitFn)(int) = 0;
576
577 void
578 stg_exit(int n)
579 {
580 if (exitFn)
581 (*exitFn)(n);
582 exit(n);
583 }