Enable two-step allocator on FreeBSD
[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 #if defined(mingw32_HOST_OS)
183 //Retry larger buffer sizes on error up to about the NTFS length limit.
184 wchar_t* pathBuf;
185 char *my_argv[2] = { NULL, NULL };
186 for(DWORD maxLength = MAX_PATH; maxLength <= 33280; maxLength *= 2)
187 {
188 pathBuf = (wchar_t*) stgMallocBytes(sizeof(wchar_t) * maxLength,
189 "hs_init_ghc: GetModuleFileName");
190 DWORD pathLength = GetModuleFileNameW(NULL, pathBuf, maxLength);
191 if(GetLastError() == ERROR_INSUFFICIENT_BUFFER || pathLength == 0) {
192 stgFree(pathBuf);
193 pathBuf = NULL;
194 } else {
195 break;
196 }
197 }
198 if(pathBuf == NULL) {
199 my_argv[0] = "<unknown>";
200 } else {
201 my_argv[0] = lpcwstrToUTF8(pathBuf);
202 stgFree(pathBuf);
203 }
204
205
206 #else
207 char *my_argv[] = { "<unknown>", NULL };
208 #endif
209 setFullProgArgv(my_argc,my_argv);
210 setupRtsFlags(&my_argc, my_argv, rts_config);
211 } else {
212 setFullProgArgv(*argc,*argv);
213 setupRtsFlags(argc, *argv, rts_config);
214
215 #if defined(DEBUG)
216 /* load debugging symbols for current binary */
217 DEBUG_LoadSymbols((*argv)[0]);
218 #endif /* DEBUG */
219 }
220
221 /* Initialise the stats department, phase 1 */
222 initStats1();
223
224 /* initTracing must be after setupRtsFlags() */
225 #if defined(TRACING)
226 initTracing();
227 #endif
228
229 /* Initialise libdw session pool */
230 libdwPoolInit();
231
232 /* initialise scheduler data structures (needs to be done before
233 * initStorage()).
234 */
235 initScheduler();
236
237 /* Trace some basic information about the process */
238 traceWallClockTime();
239 traceOSProcessInfo();
240 flushTrace();
241
242 /* initialize the storage manager */
243 initStorage();
244
245 /* initialise the stable pointer table */
246 initStableTables();
247
248 /* Add some GC roots for things in the base package that the RTS
249 * knows about. We don't know whether these turn out to be CAFs
250 * or refer to CAFs, but we have to assume that they might.
251 *
252 * Because these stable pointers will retain any CAF references in
253 * these closures `Id`s of these can be safely marked as non-CAFFY
254 * in the compiler.
255 */
256 getStablePtr((StgPtr)runIO_closure);
257 getStablePtr((StgPtr)runNonIO_closure);
258 getStablePtr((StgPtr)flushStdHandles_closure);
259
260 getStablePtr((StgPtr)runFinalizerBatch_closure);
261
262 getStablePtr((StgPtr)stackOverflow_closure);
263 getStablePtr((StgPtr)heapOverflow_closure);
264 getStablePtr((StgPtr)unpackCString_closure);
265 getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
266 getStablePtr((StgPtr)nonTermination_closure);
267 getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
268 getStablePtr((StgPtr)allocationLimitExceeded_closure);
269 getStablePtr((StgPtr)cannotCompactFunction_closure);
270 getStablePtr((StgPtr)cannotCompactPinned_closure);
271 getStablePtr((StgPtr)cannotCompactMutable_closure);
272 getStablePtr((StgPtr)nestedAtomically_closure);
273 getStablePtr((StgPtr)absentSumFieldError_closure);
274 // `Id` for this closure is marked as non-CAFFY,
275 // see Note [aBSENT_SUM_FIELD_ERROR_ID] in MkCore.
276
277 getStablePtr((StgPtr)runSparks_closure);
278 getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
279 getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
280 #if !defined(mingw32_HOST_OS)
281 getStablePtr((StgPtr)blockedOnBadFD_closure);
282 getStablePtr((StgPtr)runHandlersPtr_closure);
283 #endif
284
285 // Initialize the top-level handler system
286 initTopHandler();
287
288 /* initialise the shared Typeable store */
289 initGlobalStore();
290
291 /* initialise file locking, if necessary */
292 initFileLocking();
293
294 #if defined(DEBUG)
295 /* initialise thread label table (tso->char*) */
296 initThreadLabelTable();
297 #endif
298
299 initProfiling();
300
301 /* start the virtual timer 'subsystem'. */
302 initTimer();
303 startTimer();
304
305 #if defined(RTS_USER_SIGNALS)
306 if (RtsFlags.MiscFlags.install_signal_handlers) {
307 /* Initialise the user signal handler set */
308 initUserSignals();
309 /* Set up handler to run on SIGINT, etc. */
310 initDefaultHandlers();
311 }
312 #endif
313
314 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
315 startupAsyncIO();
316 #endif
317
318 x86_init_fpu();
319
320 startupHpc();
321
322 // ditto.
323 #if defined(THREADED_RTS)
324 ioManagerStart();
325 #endif
326
327 /* Record initialization times */
328 stat_endInit();
329 }
330
331 // Compatibility interface
332 void
333 startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
334 {
335 hs_init(&argc, &argv);
336 }
337
338 /* ----------------------------------------------------------------------------
339 * Shutting down the RTS
340 *
341 * The wait_foreign parameter means:
342 * True ==> wait for any threads doing foreign calls now.
343 * False ==> threads doing foreign calls may return in the
344 * future, but will immediately block on a mutex.
345 * (capability->lock).
346 *
347 * If this RTS is a DLL that we're about to unload, then you want
348 * safe=True, otherwise the thread might return to code that has been
349 * unloaded. If this is a standalone program that is about to exit,
350 * then you can get away with safe=False, which is better because we
351 * won't hang on exit if there is a blocked foreign call outstanding.
352 *
353 ------------------------------------------------------------------------- */
354
355 static void
356 hs_exit_(bool wait_foreign)
357 {
358 uint32_t g, i;
359
360 if (hs_init_count <= 0) {
361 errorBelch("warning: too many hs_exit()s");
362 return;
363 }
364 hs_init_count--;
365 if (hs_init_count > 0) {
366 // ignore until it's the last one
367 return;
368 }
369 rts_shutdown = true;
370
371 /* start timing the shutdown */
372 stat_startExit();
373
374 rtsConfig.onExitHook();
375
376 flushStdHandles();
377
378 // sanity check
379 #if defined(DEBUG)
380 checkFPUStack();
381 #endif
382
383 #if defined(THREADED_RTS)
384 ioManagerDie();
385 #endif
386
387 /* stop all running tasks */
388 exitScheduler(wait_foreign);
389
390 /* run C finalizers for all active weak pointers */
391 for (i = 0; i < n_capabilities; i++) {
392 runAllCFinalizers(capabilities[i]->weak_ptr_list_hd);
393 }
394 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
395 runAllCFinalizers(generations[g].weak_ptr_list);
396 }
397
398 #if defined(RTS_USER_SIGNALS)
399 if (RtsFlags.MiscFlags.install_signal_handlers) {
400 freeSignalHandlers();
401 }
402 #endif
403
404 /* stop the ticker */
405 stopTimer();
406 /*
407 * it is quite important that we wait here as some timer implementations
408 * (e.g. pthread) may fire even after we exit, which may segfault as we've
409 * already freed the capabilities.
410 */
411 exitTimer(true);
412
413 // set the terminal settings back to what they were
414 #if !defined(mingw32_HOST_OS)
415 resetTerminalSettings();
416 #endif
417
418 #if defined(RTS_USER_SIGNALS)
419 if (RtsFlags.MiscFlags.install_signal_handlers) {
420 // uninstall signal handlers
421 resetDefaultHandlers();
422 }
423 #endif
424
425 /* stop timing the shutdown, we're about to print stats */
426 stat_endExit();
427
428 /* shutdown the hpc support (if needed) */
429 exitHpc();
430
431 // clean up things from the storage manager's point of view.
432 // also outputs the stats (+RTS -s) info.
433 exitStorage();
434
435 /* free the tasks */
436 freeScheduler();
437
438 /* free shared Typeable store */
439 exitGlobalStore();
440
441 /* free linker data */
442 exitLinker();
443
444 /* free file locking tables, if necessary */
445 freeFileLocking();
446
447 /* free the Static Pointer Table */
448 exitStaticPtrTable();
449
450 /* remove the top-level handler */
451 exitTopHandler();
452
453 /* free the stable pointer table */
454 exitStableTables();
455
456 #if defined(DEBUG)
457 /* free the thread label table */
458 freeThreadLabelTable();
459 #endif
460
461 #if defined(PROFILING)
462 reportCCSProfiling();
463 #endif
464
465 endProfiling();
466 freeProfiling();
467
468 #if defined(PROFILING)
469 // Originally, this was in report_ccs_profiling(). Now, retainer
470 // profiling might tack some extra stuff on to the end of this file
471 // during endProfiling().
472 if (prof_file != NULL) fclose(prof_file);
473 #endif
474
475 #if defined(TRACING)
476 endTracing();
477 freeTracing();
478 #endif
479
480 #if defined(TICKY_TICKY)
481 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
482
483 FILE *tf = RtsFlags.TickyFlags.tickyFile;
484 if (tf != NULL) fclose(tf);
485 #endif
486
487 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
488 shutdownAsyncIO(wait_foreign);
489 #endif
490
491 /* free hash table storage */
492 exitHashTable();
493
494 // Finally, free all our storage. However, we only free the heap
495 // memory if we have waited for foreign calls to complete;
496 // otherwise a foreign call in progress may still be referencing
497 // heap memory (e.g. by being passed a ByteArray#).
498 freeStorage(wait_foreign);
499
500 // Free the various argvs
501 freeRtsArgs();
502
503 // Free threading resources
504 freeThreadingResources();
505 }
506
507 // Flush stdout and stderr. We do this during shutdown so that it
508 // happens even when the RTS is being used as a library, without a
509 // main (#5594)
510 static void flushStdHandles(void)
511 {
512 Capability *cap;
513 cap = rts_lock();
514 rts_evalIO(&cap, flushStdHandles_closure, NULL);
515 rts_unlock(cap);
516 }
517
518 // The real hs_exit():
519 void
520 hs_exit(void)
521 {
522 hs_exit_(true);
523 // be safe; this might be a DLL
524 }
525
526 void
527 hs_exit_nowait(void)
528 {
529 hs_exit_(false);
530 // do not wait for outstanding foreign calls to return; if they return in
531 // the future, they will block indefinitely.
532 }
533
534 // Compatibility interfaces
535 void
536 shutdownHaskell(void)
537 {
538 hs_exit();
539 }
540
541 void
542 shutdownHaskellAndExit(int n, int fastExit)
543 {
544 if (!fastExit) {
545 // we're about to exit(), no need to wait for foreign calls to return.
546 hs_exit_(false);
547 }
548
549 stg_exit(n);
550 }
551
552 #if !defined(mingw32_HOST_OS)
553 static void exitBySignal(int sig) GNUC3_ATTRIBUTE(__noreturn__);
554
555 void
556 shutdownHaskellAndSignal(int sig, int fastExit)
557 {
558 if (!fastExit) {
559 hs_exit_(false);
560 }
561
562 exitBySignal(sig);
563 }
564
565 void
566 exitBySignal(int sig)
567 {
568 // We're trying to kill ourselves with a given signal.
569 // That's easier said that done because:
570 // - signals can be ignored have handlers set for them
571 // - signals can be masked
572 // - signals default action can do things other than terminate:
573 // + can do nothing
574 // + can do weirder things: stop/continue the process
575
576 struct sigaction dfl;
577 sigset_t sigset;
578
579 // So first of all, we reset the signal to use the default action.
580 (void)sigemptyset(&dfl.sa_mask);
581 dfl.sa_flags = 0;
582 dfl.sa_handler = SIG_DFL;
583 (void)sigaction(sig, &dfl, NULL);
584
585 // Then we unblock the signal so we can deliver it to ourselves
586 sigemptyset(&sigset);
587 sigaddset(&sigset, sig);
588 sigprocmask(SIG_UNBLOCK, &sigset, NULL);
589
590 switch (sig) {
591 case SIGSTOP: case SIGTSTP: case SIGTTIN: case SIGTTOU: case SIGCONT:
592 // These signals stop (or continue) the process, so are no good for
593 // exiting.
594 exit(0xff);
595
596 default:
597 kill(getpid(),sig);
598 // But it's possible the signal is one where the default action is to
599 // ignore, in which case we'll still be alive... so just exit.
600 exit(0xff);
601 }
602 }
603 #endif
604
605 /*
606 * called from STG-land to exit the program
607 */
608
609 void (*exitFn)(int) = 0;
610
611 void
612 stg_exit(int n)
613 {
614 if (exitFn)
615 (*exitFn)(n);
616 exit(n);
617 }