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