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