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