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