Fix parallel make for libffi.
[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 // #include "PosixSource.h"
11
12 #include "Rts.h"
13 #include "RtsAPI.h"
14 #include "RtsUtils.h"
15 #include "RtsFlags.h"
16 #include "OSThreads.h"
17 #include "Schedule.h" /* initScheduler */
18 #include "Stats.h" /* initStats */
19 #include "STM.h" /* initSTM */
20 #include "Signals.h"
21 #include "RtsSignals.h"
22 #include "ThrIOManager.h"
23 #include "Timer.h" /* startTimer, stopTimer */
24 #include "Weak.h"
25 #include "Ticky.h"
26 #include "StgRun.h"
27 #include "Prelude.h" /* fixupRTStoPreludeRefs */
28 #include "HsFFI.h"
29 #include "Linker.h"
30 #include "ThreadLabels.h"
31 #include "BlockAlloc.h"
32 #include "Trace.h"
33 #include "RtsGlobals.h"
34 #include "Stable.h"
35 #include "Hpc.h"
36 #include "FileLock.h"
37 #include "EventLog.h"
38
39 #if defined(RTS_GTK_FRONTPANEL)
40 #include "FrontPanel.h"
41 #endif
42
43 # include "Profiling.h"
44
45 #if defined(PROFILING)
46 # include "ProfHeap.h"
47 # include "RetainerProfile.h"
48 #endif
49
50 #if defined(GRAN)
51 # include "GranSimRts.h"
52 #endif
53
54 #if defined(GRAN) || defined(PAR)
55 # include "ParallelRts.h"
56 #endif
57
58 #if defined(PAR)
59 # include "Parallel.h"
60 # include "LLC.h"
61 #endif
62
63 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
64 #include "win32/AsyncIO.h"
65 #endif
66
67 #include <stdlib.h>
68
69 #ifdef HAVE_TERMIOS_H
70 #include <termios.h>
71 #endif
72 #ifdef HAVE_SIGNAL_H
73 #include <signal.h>
74 #endif
75 #ifdef HAVE_UNISTD_H
76 #include <unistd.h>
77 #endif
78
79 #if USE_PAPI
80 #include "Papi.h"
81 #endif
82
83 // Count of how many outstanding hs_init()s there have been.
84 static int hs_init_count = 0;
85
86 // Here we save the terminal settings on the standard file
87 // descriptors, if we need to change them (eg. to support NoBuffering
88 // input).
89 static void *saved_termios[3] = {NULL,NULL,NULL};
90
91 void*
92 __hscore_get_saved_termios(int fd)
93 {
94 return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ?
95 saved_termios[fd] : NULL;
96 }
97
98 void
99 __hscore_set_saved_termios(int fd, void* ts)
100 {
101 if (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) {
102 saved_termios[fd] = ts;
103 }
104 }
105
106 /* -----------------------------------------------------------------------------
107 Initialise floating point unit on x86 (currently disabled. why?)
108 (see comment in ghc/compiler/nativeGen/MachInstrs.lhs).
109 -------------------------------------------------------------------------- */
110
111 #define X86_INIT_FPU 0
112
113 #if X86_INIT_FPU
114 static void
115 x86_init_fpu ( void )
116 {
117 __volatile unsigned short int fpu_cw;
118
119 // Grab the control word
120 __asm __volatile ("fnstcw %0" : "=m" (fpu_cw));
121
122 #if 0
123 printf("fpu_cw: %x\n", fpu_cw);
124 #endif
125
126 // Set bits 8-9 to 10 (64-bit precision).
127 fpu_cw = (fpu_cw & 0xfcff) | 0x0200;
128
129 // Store the new control word back
130 __asm __volatile ("fldcw %0" : : "m" (fpu_cw));
131 }
132 #endif
133
134 /* -----------------------------------------------------------------------------
135 Starting up the RTS
136 -------------------------------------------------------------------------- */
137
138 void
139 hs_init(int *argc, char **argv[])
140 {
141 hs_init_count++;
142 if (hs_init_count > 1) {
143 // second and subsequent inits are ignored
144 return;
145 }
146
147 /* Initialise the stats department, phase 0 */
148 initStats0();
149
150 /* Next we do is grab the start time...just in case we're
151 * collecting timing statistics.
152 */
153 stat_startInit();
154
155 #if defined(DEBUG)
156 /* Start off by initialising the allocator debugging so we can
157 * use it anywhere */
158 initAllocator();
159 #endif
160
161 #ifdef PAR
162 /*
163 * The parallel system needs to be initialised and synchronised before
164 * the program is run.
165 */
166 startupParallelSystem(argv);
167
168 if (*argv[0] == '-') { /* Strip off mainPE flag argument */
169 argv++;
170 argc--;
171 }
172
173 argv[1] = argv[0]; /* ignore the nPEs argument */
174 argv++; argc--;
175 #endif
176
177 /* Set the RTS flags to default values. */
178
179 initRtsFlagsDefaults();
180
181 /* Call the user hook to reset defaults, if present */
182 defaultsHook();
183
184 /* Parse the flags, separating the RTS flags from the programs args */
185 if (argc != NULL && argv != NULL) {
186 setFullProgArgv(*argc,*argv);
187 setupRtsFlags(argc, *argv, &rts_argc, rts_argv);
188 setProgArgv(*argc,*argv);
189 }
190
191 /* Initialise the stats department, phase 1 */
192 initStats1();
193
194 #ifdef USE_PAPI
195 papi_init();
196 #endif
197
198 /* initTracing must be after setupRtsFlags() */
199 #ifdef DEBUG
200 initTracing();
201 #endif
202
203 #if defined(PAR)
204 /* NB: this really must be done after processing the RTS flags */
205 IF_PAR_DEBUG(verbose,
206 debugBelch("==== Synchronising system (%d PEs)\n", nPEs));
207 synchroniseSystem(); // calls initParallelSystem etc
208 #endif /* PAR */
209
210 /* initialise scheduler data structures (needs to be done before
211 * initStorage()).
212 */
213 initScheduler();
214
215 #if defined(GRAN)
216 /* And start GranSim profiling if required: */
217 if (RtsFlags.GranFlags.GranSimStats.Full)
218 init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
219 #elif defined(PAR)
220 /* And start GUM profiling if required: */
221 if (RtsFlags.ParFlags.ParStats.Full)
222 init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
223 #endif /* PAR || GRAN */
224
225 /* initialize the storage manager */
226 initStorage();
227
228 /* initialise the stable pointer table */
229 initStablePtrTable();
230
231 /* Add some GC roots for things in the base package that the RTS
232 * knows about. We don't know whether these turn out to be CAFs
233 * or refer to CAFs, but we have to assume that they might.
234 */
235 getStablePtr((StgPtr)base_GHCziTopHandler_runIO_closure);
236 getStablePtr((StgPtr)base_GHCziTopHandler_runNonIO_closure);
237 getStablePtr((StgPtr)stackOverflow_closure);
238 getStablePtr((StgPtr)heapOverflow_closure);
239 getStablePtr((StgPtr)runFinalizerBatch_closure);
240 getStablePtr((StgPtr)unpackCString_closure);
241 getStablePtr((StgPtr)blockedOnDeadMVar_closure);
242 getStablePtr((StgPtr)nonTermination_closure);
243 getStablePtr((StgPtr)blockedIndefinitely_closure);
244
245 /* initialise the shared Typeable store */
246 initGlobalStore();
247
248 /* initialise file locking, if necessary */
249 #if !defined(mingw32_HOST_OS)
250 initFileLocking();
251 #endif
252
253 #if defined(DEBUG)
254 /* initialise thread label table (tso->char*) */
255 initThreadLabelTable();
256 #endif
257
258 initProfiling1();
259
260 #ifdef EVENTLOG
261 if (RtsFlags.EventLogFlags.doEventLogging) {
262 initEventLogging();
263 }
264 #endif
265
266 /* start the virtual timer 'subsystem'. */
267 initTimer();
268 startTimer();
269
270 #if defined(RTS_USER_SIGNALS)
271 if (RtsFlags.MiscFlags.install_signal_handlers) {
272 /* Initialise the user signal handler set */
273 initUserSignals();
274 /* Set up handler to run on SIGINT, etc. */
275 initDefaultHandlers();
276 }
277 #endif
278
279 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
280 startupAsyncIO();
281 #endif
282
283 #ifdef RTS_GTK_FRONTPANEL
284 if (RtsFlags.GcFlags.frontpanel) {
285 initFrontPanel();
286 }
287 #endif
288
289 #if X86_INIT_FPU
290 x86_init_fpu();
291 #endif
292
293 /* Record initialization times */
294 stat_endInit();
295 }
296
297 // Compatibility interface
298 void
299 startupHaskell(int argc, char *argv[], void (*init_root)(void))
300 {
301 hs_init(&argc, &argv);
302 if(init_root)
303 hs_add_root(init_root);
304 }
305
306
307 /* -----------------------------------------------------------------------------
308 Per-module initialisation
309
310 This process traverses all the compiled modules in the program
311 starting with "Main", and performing per-module initialisation for
312 each one.
313
314 So far, two things happen at initialisation time:
315
316 - we register stable names for each foreign-exported function
317 in that module. This prevents foreign-exported entities, and
318 things they depend on, from being garbage collected.
319
320 - we supply a unique integer to each statically declared cost
321 centre and cost centre stack in the program.
322
323 The code generator inserts a small function "__stginit_<module>" in each
324 module and calls the registration functions in each of the modules it
325 imports.
326
327 The init* functions are compiled in the same way as STG code,
328 i.e. without normal C call/return conventions. Hence we must use
329 StgRun to call this stuff.
330 -------------------------------------------------------------------------- */
331
332 /* The init functions use an explicit stack...
333 */
334 #define INIT_STACK_BLOCKS 4
335 static F_ *init_stack = NULL;
336
337 void
338 hs_add_root(void (*init_root)(void))
339 {
340 bdescr *bd;
341 nat init_sp;
342 Capability *cap;
343
344 cap = rts_lock();
345
346 if (hs_init_count <= 0) {
347 barf("hs_add_root() must be called after hs_init()");
348 }
349
350 /* The initialisation stack grows downward, with sp pointing
351 to the last occupied word */
352 init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W;
353 bd = allocGroup_lock(INIT_STACK_BLOCKS);
354 init_stack = (F_ *)bd->start;
355 init_stack[--init_sp] = (F_)stg_init_finish;
356 if (init_root != NULL) {
357 init_stack[--init_sp] = (F_)init_root;
358 }
359
360 cap->r.rSp = (P_)(init_stack + init_sp);
361 StgRun((StgFunPtr)stg_init, &cap->r);
362
363 freeGroup_lock(bd);
364
365 startupHpc();
366
367 // This must be done after module initialisation.
368 // ToDo: make this work in the presence of multiple hs_add_root()s.
369 initProfiling2();
370
371 rts_unlock(cap);
372
373 // ditto.
374 #if defined(THREADED_RTS)
375 ioManagerStart();
376 #endif
377 }
378
379 /* ----------------------------------------------------------------------------
380 * Shutting down the RTS
381 *
382 * The wait_foreign parameter means:
383 * True ==> wait for any threads doing foreign calls now.
384 * False ==> threads doing foreign calls may return in the
385 * future, but will immediately block on a mutex.
386 * (capability->lock).
387 *
388 * If this RTS is a DLL that we're about to unload, then you want
389 * safe=True, otherwise the thread might return to code that has been
390 * unloaded. If this is a standalone program that is about to exit,
391 * then you can get away with safe=False, which is better because we
392 * won't hang on exit if there is a blocked foreign call outstanding.
393 *
394 ------------------------------------------------------------------------- */
395
396 static void
397 hs_exit_(rtsBool wait_foreign)
398 {
399 if (hs_init_count <= 0) {
400 errorBelch("warning: too many hs_exit()s");
401 return;
402 }
403 hs_init_count--;
404 if (hs_init_count > 0) {
405 // ignore until it's the last one
406 return;
407 }
408
409 /* start timing the shutdown */
410 stat_startExit();
411
412 OnExitHook();
413
414 #if defined(THREADED_RTS)
415 ioManagerDie();
416 #endif
417
418 /* stop all running tasks */
419 exitScheduler(wait_foreign);
420
421 /* run C finalizers for all active weak pointers */
422 runAllCFinalizers(weak_ptr_list);
423
424 #if defined(RTS_USER_SIGNALS)
425 if (RtsFlags.MiscFlags.install_signal_handlers) {
426 freeSignalHandlers();
427 }
428 #endif
429
430 #if defined(GRAN)
431 /* end_gr_simulation prints global stats if requested -- HWL */
432 if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
433 end_gr_simulation();
434 #endif
435
436 /* stop the ticker */
437 stopTimer();
438 exitTimer();
439
440 /* reset the standard file descriptors to blocking mode */
441 resetNonBlockingFd(0);
442 resetNonBlockingFd(1);
443 resetNonBlockingFd(2);
444
445 #if HAVE_TERMIOS_H
446 // Reset the terminal settings on the standard file descriptors,
447 // if we changed them. See System.Posix.Internals.tcSetAttr for
448 // more details, including the reason we termporarily disable
449 // SIGTTOU here.
450 {
451 int fd;
452 sigset_t sigset, old_sigset;
453 sigemptyset(&sigset);
454 sigaddset(&sigset, SIGTTOU);
455 sigprocmask(SIG_BLOCK, &sigset, &old_sigset);
456 for (fd = 0; fd <= 2; fd++) {
457 struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd);
458 if (ts != NULL) {
459 tcsetattr(fd,TCSANOW,ts);
460 }
461 }
462 sigprocmask(SIG_SETMASK, &old_sigset, NULL);
463 }
464 #endif
465
466 #if defined(PAR)
467 /* controlled exit; good thread! */
468 shutdownParallelSystem(0);
469
470 /* global statistics in parallel system */
471 PAR_TICKY_PAR_END();
472 #endif
473
474 // uninstall signal handlers
475 resetDefaultHandlers();
476
477 /* stop timing the shutdown, we're about to print stats */
478 stat_endExit();
479
480 /* shutdown the hpc support (if needed) */
481 exitHpc();
482
483 // clean up things from the storage manager's point of view.
484 // also outputs the stats (+RTS -s) info.
485 exitStorage();
486
487 /* free the tasks */
488 freeScheduler();
489
490 /* free shared Typeable store */
491 exitGlobalStore();
492
493 /* free file locking tables, if necessary */
494 #if !defined(mingw32_HOST_OS)
495 freeFileLocking();
496 #endif
497
498 /* free the stable pointer table */
499 exitStablePtrTable();
500
501 #if defined(DEBUG)
502 /* free the thread label table */
503 freeThreadLabelTable();
504 #endif
505
506 #ifdef RTS_GTK_FRONTPANEL
507 if (RtsFlags.GcFlags.frontpanel) {
508 stopFrontPanel();
509 }
510 #endif
511
512 #if defined(PROFILING)
513 reportCCSProfiling();
514 #endif
515
516 endProfiling();
517 freeProfiling1();
518
519 #ifdef PROFILING
520 // Originally, this was in report_ccs_profiling(). Now, retainer
521 // profiling might tack some extra stuff on to the end of this file
522 // during endProfiling().
523 if (prof_file != NULL) fclose(prof_file);
524 #endif
525
526 #ifdef EVENTLOG
527 if (RtsFlags.EventLogFlags.doEventLogging) {
528 endEventLogging();
529 freeEventLogging();
530 }
531 #endif
532
533 #if defined(TICKY_TICKY)
534 if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
535 #endif
536
537 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
538 shutdownAsyncIO(wait_foreign);
539 #endif
540
541 /* free hash table storage */
542 exitHashTable();
543
544 // Finally, free all our storage
545 freeStorage();
546
547 #if defined(DEBUG)
548 /* and shut down the allocator debugging */
549 shutdownAllocator();
550 #endif
551
552 }
553
554 // The real hs_exit():
555 void
556 hs_exit(void)
557 {
558 hs_exit_(rtsTrue);
559 // be safe; this might be a DLL
560 }
561
562 // Compatibility interfaces
563 void
564 shutdownHaskell(void)
565 {
566 hs_exit();
567 }
568
569 void
570 shutdownHaskellAndExit(int n)
571 {
572 // we're about to exit(), no need to wait for foreign calls to return.
573 hs_exit_(rtsFalse);
574
575 if (hs_init_count == 0) {
576 #if defined(PAR)
577 /* really exit (stg_exit() would call shutdownParallelSystem() again) */
578 exit(n);
579 #else
580 stg_exit(n);
581 #endif
582 }
583 }
584
585 #ifndef mingw32_HOST_OS
586 void
587 shutdownHaskellAndSignal(int sig)
588 {
589 hs_exit_(rtsFalse);
590 kill(getpid(),sig);
591 }
592 #endif
593
594 /*
595 * called from STG-land to exit the program
596 */
597
598 #ifdef PAR
599 static int exit_started=rtsFalse;
600 #endif
601
602 void (*exitFn)(int) = 0;
603
604 void
605 stg_exit(int n)
606 {
607 #ifdef PAR
608 /* HACK: avoid a loop when exiting due to a stupid error */
609 if (exit_started)
610 return;
611 exit_started=rtsTrue;
612
613 IF_PAR_DEBUG(verbose, debugBelch("==-- stg_exit %d on [%x]...", n, mytid));
614 shutdownParallelSystem(n);
615 #endif
616 if (exitFn)
617 (*exitFn)(n);
618 exit(n);
619 }