59300c4811c9a1640e53cad06d6f57761fa9599a
[ghc-hetmet.git] / ghc / rts / RtsStartup.c
1 /* -----------------------------------------------------------------------------
2  * $Id: RtsStartup.c,v 1.81 2004/08/13 13:10:32 simonmar Exp $
3  *
4  * (c) The GHC Team, 1998-2002
5  *
6  * Main function for a standalone Haskell program.
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #include "PosixSource.h"
11 #include "Rts.h"
12 #include "RtsAPI.h"
13 #include "RtsUtils.h"
14 #include "RtsFlags.h"  
15 #include "Storage.h"    /* initStorage, exitStorage */
16 #include "Schedule.h"   /* initScheduler */
17 #include "Stats.h"      /* initStats */
18 #include "Signals.h"
19 #include "Timer.h"      /* startTimer, stopTimer */
20 #include "Weak.h"
21 #include "Ticky.h"
22 #include "StgRun.h"
23 #include "Prelude.h"            /* fixupRTStoPreludeRefs */
24 #include "HsFFI.h"
25 #include "Linker.h"
26 #include "ThreadLabels.h"
27 #include "BlockAlloc.h"
28
29 #if defined(RTS_GTK_FRONTPANEL)
30 #include "FrontPanel.h"
31 #endif
32
33 #if defined(PROFILING) || defined(DEBUG)
34 # include "Profiling.h"
35 # include "ProfHeap.h"
36 # include "RetainerProfile.h"
37 #endif
38
39 #if defined(GRAN)
40 # include "GranSimRts.h"
41 #endif
42
43 #if defined(GRAN) || defined(PAR)
44 # include "ParallelRts.h"
45 #endif
46
47 #if defined(PAR)
48 # include "Parallel.h"
49 # include "LLC.h"
50 #endif
51
52 #if defined(mingw32_TARGET_OS)
53 #include "win32/AsyncIO.h"
54 #endif
55
56 #include <stdlib.h>
57
58 #ifdef HAVE_LOCALE_H
59 #include <locale.h>
60 #endif
61
62 #ifdef HAVE_TERMIOS_H
63 #include <termios.h>
64 #endif
65 #ifdef HAVE_SIGNAL_H
66 #include <signal.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 // Here we save the terminal settings on the standard file
73 // descriptors, if we need to change them (eg. to support NoBuffering
74 // input).
75 static void *saved_termios[3] = {NULL,NULL,NULL};
76
77 void*
78 __hscore_get_saved_termios(int fd)
79 {
80   return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ?
81     saved_termios[fd] : NULL;
82 }
83
84 void
85 __hscore_set_saved_termios(int fd, void* ts)
86 {
87   if (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) {
88     saved_termios[fd] = ts;
89   }
90 }
91
92 #if i386_TARGET_ARCH
93 static void x86_init_fpu ( void );
94 #endif
95
96 /* -----------------------------------------------------------------------------
97    Starting up the RTS
98    -------------------------------------------------------------------------- */
99
100 void
101 hs_init(int *argc, char **argv[])
102 {
103     hs_init_count++;
104     if (hs_init_count > 1) {
105         // second and subsequent inits are ignored
106         return;
107     }
108
109     /* The very first thing we do is grab the start time...just in case we're
110      * collecting timing statistics.
111      */
112     stat_startInit();
113
114 #ifdef PAR
115     /*
116      * The parallel system needs to be initialised and synchronised before
117      * the program is run.  
118      */ 
119     startupParallelSystem(argv);
120      
121     if (*argv[0] == '-') { /* Strip off mainPE flag argument */
122       argv++; 
123       argc--;                   
124     }
125
126     argv[1] = argv[0];   /* ignore the nPEs argument */
127     argv++; argc--;
128 #endif
129
130     /* Set the RTS flags to default values. */
131     initRtsFlagsDefaults();
132
133     /* Call the user hook to reset defaults, if present */
134     defaultsHook();
135
136     /* Parse the flags, separating the RTS flags from the programs args */
137     if (argc != NULL && argv != NULL) {
138         setupRtsFlags(argc, *argv, &rts_argc, rts_argv);
139         prog_argc = *argc;
140         prog_argv = *argv;
141     }
142
143 #if defined(PAR)
144     /* NB: this really must be done after processing the RTS flags */
145     IF_PAR_DEBUG(verbose,
146                  fprintf(stderr, "==== Synchronising system (%d PEs)\n", nPEs));
147     synchroniseSystem();             // calls initParallelSystem etc
148 #endif  /* PAR */
149
150     /* initialise scheduler data structures (needs to be done before
151      * initStorage()).
152      */
153     initScheduler();
154
155 #if defined(GRAN)
156     /* And start GranSim profiling if required: */
157     if (RtsFlags.GranFlags.GranSimStats.Full)
158       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
159 #elif defined(PAR)
160     /* And start GUM profiling if required: */
161     if (RtsFlags.ParFlags.ParStats.Full)
162       init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
163 #endif  /* PAR || GRAN */
164
165     /* initialize the storage manager */
166     initStorage();
167
168     /* initialise the stable pointer table */
169     initStablePtrTable();
170
171     /* initialise thread label table (tso->char*) */
172     initThreadLabelTable();
173
174 #if defined(PROFILING) || defined(DEBUG)
175     initProfiling1();
176 #endif
177
178     /* start the virtual timer 'subsystem'. */
179     startTimer(TICK_MILLISECS);
180
181     /* Initialise the stats department */
182     initStats();
183
184 #if defined(RTS_USER_SIGNALS)
185     /* Initialise the user signal handler set */
186     initUserSignals();
187     /* Set up handler to run on SIGINT, etc. */
188     initDefaultHandlers();
189 #endif
190  
191 #if defined(mingw32_TARGET_OS)
192     startupAsyncIO();
193 #endif
194
195 #ifdef RTS_GTK_FRONTPANEL
196     if (RtsFlags.GcFlags.frontpanel) {
197         initFrontPanel();
198     }
199 #endif
200
201 #ifdef HAVE_LOCALE_H
202     setlocale(LC_CTYPE,"");
203 #endif
204
205 #if i386_TARGET_ARCH
206 //    x86_init_fpu();
207 #endif
208
209     /* Record initialization times */
210     stat_endInit();
211 }
212
213 // Compatibility interface
214 void
215 startupHaskell(int argc, char *argv[], void (*init_root)(void))
216 {
217     hs_init(&argc, &argv);
218     hs_add_root(init_root);
219 }
220
221
222 /* -----------------------------------------------------------------------------
223    Getting/Setting the program's arguments.
224
225    These are used by System.Environment.
226    -------------------------------------------------------------------------- */
227
228 void
229 getProgArgv(int *argc, char **argv[])
230 {
231     if (argc) { *argc = prog_argc; }
232     if (argv) { *argv = prog_argv; }
233 }
234
235 void
236 setProgArgv(int argc, char *argv[])
237 {
238    /* Usually this is done by startupHaskell, so we don't need to call this. 
239       However, sometimes Hugs wants to change the arguments which Haskell
240       getArgs >>= ... will be fed.  So you can do that by calling here
241       _after_ calling startupHaskell.
242    */
243    prog_argc = argc;
244    prog_argv = argv;
245 }
246
247 /* -----------------------------------------------------------------------------
248    Per-module initialisation
249
250    This process traverses all the compiled modules in the program
251    starting with "Main", and performing per-module initialisation for
252    each one.
253
254    So far, two things happen at initialisation time:
255
256       - we register stable names for each foreign-exported function
257         in that module.  This prevents foreign-exported entities, and
258         things they depend on, from being garbage collected.
259
260       - we supply a unique integer to each statically declared cost
261         centre and cost centre stack in the program.
262
263    The code generator inserts a small function "__stginit_<module>" in each
264    module and calls the registration functions in each of the modules it
265    imports.
266
267    The init* functions are compiled in the same way as STG code,
268    i.e. without normal C call/return conventions.  Hence we must use
269    StgRun to call this stuff.
270    -------------------------------------------------------------------------- */
271
272 /* The init functions use an explicit stack... 
273  */
274 #define INIT_STACK_BLOCKS  4
275 static F_ *init_stack = NULL;
276
277 void
278 hs_add_root(void (*init_root)(void))
279 {
280     bdescr *bd;
281 #ifdef SMP
282     Capability cap;
283 #else
284 #define cap MainCapability
285 #endif
286     nat init_sp;
287
288     if (hs_init_count <= 0) {
289         barf("hs_add_root() must be called after hs_init()");
290     }
291
292     /* The initialisation stack grows downward, with sp pointing 
293        to the last occupied word */
294     init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W;
295     bd = allocGroup(INIT_STACK_BLOCKS);
296     init_stack = (F_ *)bd->start;
297     init_stack[--init_sp] = (F_)stg_init_finish;
298     if (init_root != NULL) {
299         init_stack[--init_sp] = (F_)init_root;
300     }
301     
302     cap.r.rSp = (P_)(init_stack + init_sp);
303     StgRun((StgFunPtr)stg_init, &cap.r);
304
305     freeGroup(bd);
306
307 #if defined(PROFILING) || defined(DEBUG)
308     // This must be done after module initialisation.
309     // ToDo: make this work in the presence of multiple hs_add_root()s.
310     initProfiling2();
311 #endif
312 }
313
314 /* -----------------------------------------------------------------------------
315    Shutting down the RTS
316    -------------------------------------------------------------------------- */
317
318 void
319 hs_exit(void)
320 {
321     if (hs_init_count <= 0) {
322         barf("too many hs_exit()s");
323     }
324     hs_init_count--;
325     if (hs_init_count > 0) {
326         // ignore until it's the last one
327         return;
328     }
329
330     /* start timing the shutdown */
331     stat_startExit();
332     
333 #if !defined(GRAN)
334     /* Finalize any remaining weak pointers */
335     finalizeWeakPointersNow();
336 #endif
337     
338     /* stop all running tasks */
339     exitScheduler();
340     
341 #if defined(GRAN)
342     /* end_gr_simulation prints global stats if requested -- HWL */
343     if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
344         end_gr_simulation();
345 #endif
346     
347     /* stop the ticker */
348     stopTimer();
349     
350     /* reset the standard file descriptors to blocking mode */
351     resetNonBlockingFd(0);
352     resetNonBlockingFd(1);
353     resetNonBlockingFd(2);
354
355 #if HAVE_TERMIOS_H
356     // Reset the terminal settings on the standard file descriptors,
357     // if we changed them.  See System.Posix.Internals.tcSetAttr for
358     // more details, including the reason we termporarily disable
359     // SIGTTOU here.
360     { 
361         int fd;
362         sigset_t sigset, old_sigset;
363         sigemptyset(&sigset);
364         sigaddset(&sigset, SIGTTOU);
365         sigprocmask(SIG_BLOCK, &sigset, &old_sigset);
366         for (fd = 0; fd <= 2; fd++) {
367             struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd);
368             if (ts != NULL) {
369                 tcsetattr(fd,TCSANOW,ts);
370             }
371         }
372         sigprocmask(SIG_SETMASK, &old_sigset, NULL);
373     }
374 #endif
375
376 #if defined(PAR)
377     /* controlled exit; good thread! */
378     shutdownParallelSystem(0);
379     
380     /* global statistics in parallel system */
381     PAR_TICKY_PAR_END();
382 #endif
383
384     /* stop timing the shutdown, we're about to print stats */
385     stat_endExit();
386     
387     /* clean up things from the storage manager's point of view.
388      * also outputs the stats (+RTS -s) info.
389      */
390     exitStorage();
391     
392 #ifdef RTS_GTK_FRONTPANEL
393     if (RtsFlags.GcFlags.frontpanel) {
394         stopFrontPanel();
395     }
396 #endif
397
398 #if defined(PROFILING) 
399     reportCCSProfiling();
400 #endif
401
402 #if defined(PROFILING) || defined(DEBUG)
403     endProfiling();
404 #endif
405
406 #ifdef PROFILING
407     // Originally, this was in report_ccs_profiling().  Now, retainer
408     // profiling might tack some extra stuff on to the end of this file
409     // during endProfiling().
410     fclose(prof_file);
411 #endif
412     
413 #if defined(TICKY_TICKY)
414     if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
415 #endif
416
417 #if defined(mingw32_TARGET_OS)
418     shutdownAsyncIO();
419 #endif
420 }
421
422 // Compatibility interfaces
423 void
424 shutdownHaskell(void)
425 {
426     hs_exit();
427 }
428
429 void
430 shutdownHaskellAndExit(int n)
431 {
432     if (hs_init_count == 1) {
433         OnExitHook();
434         hs_exit();
435 #if defined(PAR)
436         /* really exit (stg_exit() would call shutdownParallelSystem() again) */
437         exit(n);
438 #else
439         stg_exit(n);
440 #endif
441     }
442 }
443
444 /* 
445  * called from STG-land to exit the program
446  */
447
448 #ifdef PAR
449 static int exit_started=rtsFalse;
450 #endif
451
452 void  
453 stg_exit(int n)
454
455 #ifdef PAR
456   /* HACK: avoid a loop when exiting due to a stupid error */
457   if (exit_started) 
458     return;
459   exit_started=rtsTrue;
460
461   IF_PAR_DEBUG(verbose, fprintf(stderr,"==-- stg_exit %d on [%x]...", n, mytid));
462   shutdownParallelSystem(n);
463 #endif
464   exit(n);
465 }
466
467 /* -----------------------------------------------------------------------------
468    Initialise floating point unit on x86
469    -------------------------------------------------------------------------- */
470
471 #if i386_TARGET_ARCH
472 static void
473 x86_init_fpu ( void )
474 {
475   __volatile unsigned short int fpu_cw;
476
477   // Grab the control word
478   __asm __volatile ("fnstcw %0" : "=m" (fpu_cw));
479
480 #if 0
481   printf("fpu_cw: %x\n", fpu_cw);
482 #endif
483
484   // Set bits 8-9 to 10 (64-bit precision).
485   fpu_cw = (fpu_cw & 0xfcff) | 0x0200;
486
487   // Store the new control word back
488   __asm __volatile ("fldcw %0" : : "m" (fpu_cw));
489 }
490 #endif
491