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