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