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