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