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