Some build system refactoring
[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 "Schedule.h" /* initScheduler */
23 #include "Stats.h" /* initStats */
24 #include "STM.h" /* initSTM */
25 #include "RtsSignals.h"
26 #include "Weak.h"
27 #include "Ticky.h"
28 #include "StgRun.h"
29 #include "Prelude.h" /* fixupRTStoPreludeRefs */
30 #include "ThreadLabels.h"
31 #include "sm/BlockAlloc.h"
32 #include "Trace.h"
33 #include "Stable.h"
34 #include "Hash.h"
35 #include "Profiling.h"
36 #include "Timer.h"
37 #include "Globals.h"
38 #include "FileLock.h"
39 void exitLinker( void ); // there is no Linker.h file to include
40
41 #if defined(RTS_GTK_FRONTPANEL)
42 #include "FrontPanel.h"
43 #endif
44
45 #if defined(PROFILING)
46 # include "ProfHeap.h"
47 # include "RetainerProfile.h"
48 #endif
49
50 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
51 #include "win32/AsyncIO.h"
52 #endif
53
54 #if !defined(mingw32_HOST_OS)
55 #include "posix/TTY.h"
56 #endif
57
58 #ifdef HAVE_UNISTD_H
59 #include <unistd.h>
60 #endif
61 #ifdef HAVE_LOCALE_H
62 #include <locale.h>
63 #endif
64
65 #if USE_PAPI
66 #include "Papi.h"
67 #endif
68
69 // Count of how many outstanding hs_init()s there have been.
70 static int hs_init_count = 0;
71
72 static void flushStdHandles(void);
73
74 const RtsConfig defaultRtsConfig = {
75 .rts_opts_enabled = RtsOptsSafeOnly,
76 .rts_opts = NULL
77 };
78
79 /* -----------------------------------------------------------------------------
80 Initialise floating point unit on x86 (currently disabled; See Note
81 [x86 Floating point precision] in compiler/nativeGen/X86/Instr.hs)
82 -------------------------------------------------------------------------- */
83
84 #define X86_INIT_FPU 0
85
86 #if X86_INIT_FPU
87 static void
88 x86_init_fpu ( void )
89 {
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 }
105 #endif
106
107 /* -----------------------------------------------------------------------------
108 Starting up the RTS
109 -------------------------------------------------------------------------- */
110
111 void
112 hs_init(int *argc, char **argv[])
113 {
114 hs_init_ghc(argc, argv, defaultRtsConfig);
115 }
116
117 void
118 hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
119 {
120 hs_init_count++;
121 if (hs_init_count > 1) {
122 // second and subsequent inits are ignored
123 return;
124 }
125
126 setlocale(LC_CTYPE,"");
127
128 /* Initialise the stats department, phase 0 */
129 initStats0();
130
131 /* Initialize system timer before starting to collect stats */
132 initializeTimer();
133
134 /* Next we do is grab the start time...just in case we're
135 * collecting timing statistics.
136 */
137 stat_startInit();
138
139 /* Set the RTS flags to default values. */
140
141 initRtsFlagsDefaults();
142
143 /* Call the user hook to reset defaults, if present */
144 defaultsHook();
145
146 /* Parse the flags, separating the RTS flags from the programs args */
147 if (argc == NULL || argv == NULL) {
148 // Use a default for argc & argv if either is not supplied
149 int my_argc = 1;
150 char *my_argv[] = { "<unknown>", NULL };
151 setFullProgArgv(my_argc,my_argv);
152 setupRtsFlags(&my_argc, my_argv,
153 rts_config.rts_opts_enabled, rts_config.rts_opts);
154 } else {
155 setFullProgArgv(*argc,*argv);
156 setupRtsFlags(argc, *argv,
157 rts_config.rts_opts_enabled, rts_config.rts_opts);
158 }
159
160 /* Initialise the stats department, phase 1 */
161 initStats1();
162
163 #ifdef USE_PAPI
164 papi_init();
165 #endif
166
167 /* initTracing must be after setupRtsFlags() */
168 #ifdef TRACING
169 initTracing();
170 #endif
171 /* Trace the startup event
172 */
173 traceEventStartup();
174
175 /* initialise scheduler data structures (needs to be done before
176 * initStorage()).
177 */
178 initScheduler();
179
180 /* Trace some basic information about the process */
181 traceWallClockTime();
182 traceOSProcessInfo();
183
184 /* initialize the storage manager */
185 initStorage();
186
187 /* initialise the stable pointer table */
188 initStableTables();
189
190 /* Add some GC roots for things in the base package that the RTS
191 * knows about. We don't know whether these turn out to be CAFs
192 * or refer to CAFs, but we have to assume that they might.
193 */
194 getStablePtr((StgPtr)runIO_closure);
195 getStablePtr((StgPtr)runNonIO_closure);
196 getStablePtr((StgPtr)flushStdHandles_closure);
197
198 getStablePtr((StgPtr)runFinalizerBatch_closure);
199
200 getStablePtr((StgPtr)stackOverflow_closure);
201 getStablePtr((StgPtr)heapOverflow_closure);
202 getStablePtr((StgPtr)unpackCString_closure);
203 getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
204 getStablePtr((StgPtr)nonTermination_closure);
205 getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
206 getStablePtr((StgPtr)nestedAtomically_closure);
207
208 getStablePtr((StgPtr)runSparks_closure);
209 getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
210 getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
211 #ifndef mingw32_HOST_OS
212 getStablePtr((StgPtr)runHandlers_closure);
213 #endif
214
215 /* initialise the shared Typeable store */
216 initGlobalStore();
217
218 /* initialise file locking, if necessary */
219 initFileLocking();
220
221 #if defined(DEBUG)
222 /* initialise thread label table (tso->char*) */
223 initThreadLabelTable();
224 #endif
225
226 initProfiling1();
227
228 /* start the virtual timer 'subsystem'. */
229 initTimer();
230 startTimer();
231
232 #if defined(RTS_USER_SIGNALS)
233 if (RtsFlags.MiscFlags.install_signal_handlers) {
234 /* Initialise the user signal handler set */
235 initUserSignals();
236 /* Set up handler to run on SIGINT, etc. */
237 initDefaultHandlers();
238 }
239 #endif
240
241 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
242 startupAsyncIO();
243 #endif
244
245 #ifdef RTS_GTK_FRONTPANEL
246 if (RtsFlags.GcFlags.frontpanel) {
247 initFrontPanel();
248 }
249 #endif
250
251 #if X86_INIT_FPU
252 x86_init_fpu();
253 #endif
254
255 startupHpc();
256
257 // This must be done after module initialisation.
258 // ToDo: make this work in the presence of multiple hs_add_root()s.
259 initProfiling2();
260
261 // ditto.
262 #if defined(THREADED_RTS)
263 ioManagerStart();
264 #endif
265
266 /* Record initialization times */
267 stat_endInit();
268 }
269
270 // Compatibility interface
271 void
272 startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
273 {
274 hs_init(&argc, &argv);
275 }
276
277
278 /* -----------------------------------------------------------------------------
279 hs_add_root: backwards compatibility. (see #3252)
280 -------------------------------------------------------------------------- */
281
282 void
283 hs_add_root(void (*init_root)(void) STG_UNUSED)
284 {
285 /* nothing */
286 }
287
288 /* ----------------------------------------------------------------------------
289 * Shutting down the RTS
290 *
291 * The wait_foreign parameter means:
292 * True ==> wait for any threads doing foreign calls now.
293 * False ==> threads doing foreign calls may return in the
294 * future, but will immediately block on a mutex.
295 * (capability->lock).
296 *
297 * If this RTS is a DLL that we're about to unload, then you want
298 * safe=True, otherwise the thread might return to code that has been
299 * unloaded. If this is a standalone program that is about to exit,
300 * then you can get away with safe=False, which is better because we
301 * won't hang on exit if there is a blocked foreign call outstanding.
302 *
303 ------------------------------------------------------------------------- */
304
305 static void
306 hs_exit_(rtsBool wait_foreign)
307 {
308 if (hs_init_count <= 0) {
309 errorBelch("warning: too many hs_exit()s");
310 return;
311 }
312 hs_init_count--;
313 if (hs_init_count > 0) {
314 // ignore until it's the last one
315 return;
316 }
317
318 /* start timing the shutdown */
319 stat_startExit();
320
321 OnExitHook();
322
323 flushStdHandles();
324
325 // sanity check
326 #if defined(DEBUG)
327 checkFPUStack();
328 #endif
329
330 #if defined(THREADED_RTS)
331 ioManagerDie();
332 #endif
333
334 /* stop all running tasks */
335 exitScheduler(wait_foreign);
336
337 /* run C finalizers for all active weak pointers */
338 runAllCFinalizers(weak_ptr_list);
339
340 #if defined(RTS_USER_SIGNALS)
341 if (RtsFlags.MiscFlags.install_signal_handlers) {
342 freeSignalHandlers();
343 }
344 #endif
345
346 /* stop the ticker */
347 stopTimer();
348 exitTimer(wait_foreign);
349
350 // set the terminal settings back to what they were
351 #if !defined(mingw32_HOST_OS)
352 resetTerminalSettings();
353 #endif
354
355 // uninstall signal handlers
356 resetDefaultHandlers();
357
358 /* stop timing the shutdown, we're about to print stats */
359 stat_endExit();
360
361 /* shutdown the hpc support (if needed) */
362 exitHpc();
363
364 // clean up things from the storage manager's point of view.
365 // also outputs the stats (+RTS -s) info.
366 exitStorage();
367
368 /* free the tasks */
369 freeScheduler();
370
371 /* free shared Typeable store */
372 exitGlobalStore();
373
374 /* free linker data */
375 exitLinker();
376
377 /* free file locking tables, if necessary */
378 freeFileLocking();
379
380 /* free the stable pointer table */
381 exitStableTables();
382
383 #if defined(DEBUG)
384 /* free the thread label table */
385 freeThreadLabelTable();
386 #endif
387
388 #ifdef RTS_GTK_FRONTPANEL
389 if (RtsFlags.GcFlags.frontpanel) {
390 stopFrontPanel();
391 }
392 #endif
393
394 #if defined(PROFILING)
395 reportCCSProfiling();
396 #endif
397
398 endProfiling();
399 freeProfiling();
400
401 #ifdef PROFILING
402 // Originally, this was in report_ccs_profiling(). Now, retainer
403 // profiling might tack some extra stuff on to the end of this file
404 // during endProfiling().
405 if (prof_file != NULL) fclose(prof_file);
406 #endif
407
408 #ifdef TRACING
409 endTracing();
410 freeTracing();
411 #endif
412
413 #if defined(TICKY_TICKY)
414 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
415 #endif
416
417 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
418 shutdownAsyncIO(wait_foreign);
419 #endif
420
421 /* free hash table storage */
422 exitHashTable();
423
424 // Finally, free all our storage. However, we only free the heap
425 // memory if we have waited for foreign calls to complete;
426 // otherwise a foreign call in progress may still be referencing
427 // heap memory (e.g. by being passed a ByteArray#).
428 freeStorage(wait_foreign);
429
430 // Free the various argvs
431 freeRtsArgs();
432 }
433
434 // Flush stdout and stderr. We do this during shutdown so that it
435 // happens even when the RTS is being used as a library, without a
436 // main (#5594)
437 static void flushStdHandles(void)
438 {
439 Capability *cap;
440 cap = rts_lock();
441 rts_evalIO(&cap, flushStdHandles_closure, NULL);
442 rts_unlock(cap);
443 }
444
445 // The real hs_exit():
446 void
447 hs_exit(void)
448 {
449 hs_exit_(rtsTrue);
450 // be safe; this might be a DLL
451 }
452
453 // Compatibility interfaces
454 void
455 shutdownHaskell(void)
456 {
457 hs_exit();
458 }
459
460 void
461 shutdownHaskellAndExit(int n)
462 {
463 // even if hs_init_count > 1, we still want to shut down the RTS
464 // and exit immediately (see #5402)
465 hs_init_count = 1;
466
467 // we're about to exit(), no need to wait for foreign calls to return.
468 hs_exit_(rtsFalse);
469
470 stg_exit(n);
471 }
472
473 #ifndef mingw32_HOST_OS
474 void
475 shutdownHaskellAndSignal(int sig)
476 {
477 hs_exit_(rtsFalse);
478 kill(getpid(),sig);
479 }
480 #endif
481
482 /*
483 * called from STG-land to exit the program
484 */
485
486 void (*exitFn)(int) = 0;
487
488 void
489 stg_exit(int n)
490 {
491 if (exitFn)
492 (*exitFn)(n);
493 exit(n);
494 }