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