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