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