Separate StablePtr and StableName tables (#7674)
[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 #ifndef mingw32_HOST_OS
211 getStablePtr((StgPtr)runHandlers_closure);
212 #endif
213
214 /* initialise the shared Typeable store */
215 initGlobalStore();
216
217 /* initialise file locking, if necessary */
218 initFileLocking();
219
220 #if defined(DEBUG)
221 /* initialise thread label table (tso->char*) */
222 initThreadLabelTable();
223 #endif
224
225 initProfiling1();
226
227 /* start the virtual timer 'subsystem'. */
228 initTimer();
229 startTimer();
230
231 #if defined(RTS_USER_SIGNALS)
232 if (RtsFlags.MiscFlags.install_signal_handlers) {
233 /* Initialise the user signal handler set */
234 initUserSignals();
235 /* Set up handler to run on SIGINT, etc. */
236 initDefaultHandlers();
237 }
238 #endif
239
240 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
241 startupAsyncIO();
242 #endif
243
244 #ifdef RTS_GTK_FRONTPANEL
245 if (RtsFlags.GcFlags.frontpanel) {
246 initFrontPanel();
247 }
248 #endif
249
250 #if X86_INIT_FPU
251 x86_init_fpu();
252 #endif
253
254 startupHpc();
255
256 // This must be done after module initialisation.
257 // ToDo: make this work in the presence of multiple hs_add_root()s.
258 initProfiling2();
259
260 // ditto.
261 #if defined(THREADED_RTS)
262 ioManagerStart();
263 #endif
264
265 /* Record initialization times */
266 stat_endInit();
267 }
268
269 // Compatibility interface
270 void
271 startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
272 {
273 hs_init(&argc, &argv);
274 }
275
276
277 /* -----------------------------------------------------------------------------
278 hs_add_root: backwards compatibility. (see #3252)
279 -------------------------------------------------------------------------- */
280
281 void
282 hs_add_root(void (*init_root)(void) STG_UNUSED)
283 {
284 /* nothing */
285 }
286
287 /* ----------------------------------------------------------------------------
288 * Shutting down the RTS
289 *
290 * The wait_foreign parameter means:
291 * True ==> wait for any threads doing foreign calls now.
292 * False ==> threads doing foreign calls may return in the
293 * future, but will immediately block on a mutex.
294 * (capability->lock).
295 *
296 * If this RTS is a DLL that we're about to unload, then you want
297 * safe=True, otherwise the thread might return to code that has been
298 * unloaded. If this is a standalone program that is about to exit,
299 * then you can get away with safe=False, which is better because we
300 * won't hang on exit if there is a blocked foreign call outstanding.
301 *
302 ------------------------------------------------------------------------- */
303
304 static void
305 hs_exit_(rtsBool wait_foreign)
306 {
307 if (hs_init_count <= 0) {
308 errorBelch("warning: too many hs_exit()s");
309 return;
310 }
311 hs_init_count--;
312 if (hs_init_count > 0) {
313 // ignore until it's the last one
314 return;
315 }
316
317 /* start timing the shutdown */
318 stat_startExit();
319
320 OnExitHook();
321
322 flushStdHandles();
323
324 // sanity check
325 #if defined(DEBUG)
326 checkFPUStack();
327 #endif
328
329 #if defined(THREADED_RTS)
330 ioManagerDie();
331 #endif
332
333 /* stop all running tasks */
334 exitScheduler(wait_foreign);
335
336 /* run C finalizers for all active weak pointers */
337 runAllCFinalizers(weak_ptr_list);
338
339 #if defined(RTS_USER_SIGNALS)
340 if (RtsFlags.MiscFlags.install_signal_handlers) {
341 freeSignalHandlers();
342 }
343 #endif
344
345 /* stop the ticker */
346 stopTimer();
347 exitTimer(wait_foreign);
348
349 // set the terminal settings back to what they were
350 #if !defined(mingw32_HOST_OS)
351 resetTerminalSettings();
352 #endif
353
354 // uninstall signal handlers
355 resetDefaultHandlers();
356
357 /* stop timing the shutdown, we're about to print stats */
358 stat_endExit();
359
360 /* shutdown the hpc support (if needed) */
361 exitHpc();
362
363 // clean up things from the storage manager's point of view.
364 // also outputs the stats (+RTS -s) info.
365 exitStorage();
366
367 /* free the tasks */
368 freeScheduler();
369
370 /* free shared Typeable store */
371 exitGlobalStore();
372
373 /* free linker data */
374 exitLinker();
375
376 /* free file locking tables, if necessary */
377 freeFileLocking();
378
379 /* free the stable pointer table */
380 exitStableTables();
381
382 #if defined(DEBUG)
383 /* free the thread label table */
384 freeThreadLabelTable();
385 #endif
386
387 #ifdef RTS_GTK_FRONTPANEL
388 if (RtsFlags.GcFlags.frontpanel) {
389 stopFrontPanel();
390 }
391 #endif
392
393 #if defined(PROFILING)
394 reportCCSProfiling();
395 #endif
396
397 endProfiling();
398 freeProfiling();
399
400 #ifdef PROFILING
401 // Originally, this was in report_ccs_profiling(). Now, retainer
402 // profiling might tack some extra stuff on to the end of this file
403 // during endProfiling().
404 if (prof_file != NULL) fclose(prof_file);
405 #endif
406
407 #ifdef TRACING
408 endTracing();
409 freeTracing();
410 #endif
411
412 #if defined(TICKY_TICKY)
413 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
414 #endif
415
416 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
417 shutdownAsyncIO(wait_foreign);
418 #endif
419
420 /* free hash table storage */
421 exitHashTable();
422
423 // Finally, free all our storage. However, we only free the heap
424 // memory if we have waited for foreign calls to complete;
425 // otherwise a foreign call in progress may still be referencing
426 // heap memory (e.g. by being passed a ByteArray#).
427 freeStorage(wait_foreign);
428
429 // Free the various argvs
430 freeRtsArgs();
431 }
432
433 // Flush stdout and stderr. We do this during shutdown so that it
434 // happens even when the RTS is being used as a library, without a
435 // main (#5594)
436 static void flushStdHandles(void)
437 {
438 Capability *cap;
439 cap = rts_lock();
440 rts_evalIO(&cap, flushStdHandles_closure, NULL);
441 rts_unlock(cap);
442 }
443
444 // The real hs_exit():
445 void
446 hs_exit(void)
447 {
448 hs_exit_(rtsTrue);
449 // be safe; this might be a DLL
450 }
451
452 // Compatibility interfaces
453 void
454 shutdownHaskell(void)
455 {
456 hs_exit();
457 }
458
459 void
460 shutdownHaskellAndExit(int n)
461 {
462 // even if hs_init_count > 1, we still want to shut down the RTS
463 // and exit immediately (see #5402)
464 hs_init_count = 1;
465
466 // we're about to exit(), no need to wait for foreign calls to return.
467 hs_exit_(rtsFalse);
468
469 stg_exit(n);
470 }
471
472 #ifndef mingw32_HOST_OS
473 void
474 shutdownHaskellAndSignal(int sig)
475 {
476 hs_exit_(rtsFalse);
477 kill(getpid(),sig);
478 }
479 #endif
480
481 /*
482 * called from STG-land to exit the program
483 */
484
485 void (*exitFn)(int) = 0;
486
487 void
488 stg_exit(int n)
489 {
490 if (exitFn)
491 (*exitFn)(n);
492 exit(n);
493 }