[project @ 2003-07-21 14:33:19 by simonmar]
[ghc-hetmet.git] / ghc / rts / Main.c
1 /* -----------------------------------------------------------------------------
2  * $Id: Main.c,v 1.39 2003/07/10 08:02:29 simonpj Exp $
3  *
4  * (c) The GHC Team 1998-2000
5  *
6  * Main function for a standalone Haskell program.
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #define COMPILING_RTS_MAIN
11
12 #include "PosixSource.h"
13 #include "Rts.h"
14 #include "RtsAPI.h"
15 #include "SchedAPI.h"
16 #include "Schedule.h"
17 #include "RtsFlags.h"
18 #include "RtsUtils.h"
19 #include "Prelude.h"
20 #include <stdlib.h>
21
22 #ifdef DEBUG
23 # include "Printer.h"   /* for printing        */
24 #endif
25
26 #ifdef INTERPRETER
27 # include "Assembler.h"
28 #endif
29
30 #ifdef PAR
31 # include "Parallel.h"
32 # include "ParallelRts.h"
33 # include "LLC.h"
34 #endif
35
36 #if defined(GRAN) || defined(PAR)
37 # include "GranSimRts.h"
38 #endif
39
40 #ifdef HAVE_WINDOWS_H
41 # include <windows.h>
42 #endif
43
44 extern void __stginit_ZCMain(void);
45
46 /* Hack: we assume that we're building a batch-mode system unless 
47  * INTERPRETER is set
48  */
49 #ifndef INTERPRETER /* Hack */
50 int main(int argc, char *argv[])
51 {
52     int exit_status;
53     SchedulerStatus status;
54     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
55
56     startupHaskell(argc,argv,__stginit_ZCMain);
57
58     /* kick off the computation by creating the main thread with a pointer
59        to mainIO_closure representing the computation of the overall program;
60        then enter the scheduler with this thread and off we go;
61       
62        the same for GranSim (we have only one instance of this code)
63
64        in a parallel setup, where we have many instances of this code
65        running on different PEs, we should do this only for the main PE
66        (IAmMainThread is set in startupHaskell) 
67     */
68
69 #  if defined(PAR)
70
71 #   if defined(DEBUG)
72     { /* a wait loop to allow attachment of gdb to UNIX threads */
73       nat i, j, s;
74
75       for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
76         for (j=0; j<1000000; j++) 
77           s += j % 65536;
78     }
79     IF_PAR_DEBUG(verbose,
80                  belch("Passed wait loop"));
81 #   endif
82
83     if (IAmMainThread == rtsTrue) {
84       IF_PAR_DEBUG(verbose,
85                    fprintf(stderr, "==== [%x] Main Thread Started ...\n", mytid));
86
87       /* ToDo: Dump event for the main thread */
88       status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
89     } else {
90       /* Just to show we're alive */
91       IF_PAR_DEBUG(verbose,
92                    fprintf(stderr, "== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
93                            mytid));
94      
95       /* all non-main threads enter the scheduler without work */
96       taskStart();       
97       status = Success;  // declare victory (see shutdownParallelSystem)
98     }
99
100 #  elif defined(GRAN)
101
102     /* ToDo: Dump event for the main thread */
103     status = rts_mainLazyIO(mainIO_closure, NULL);
104
105 #  else /* !PAR && !GRAN */
106
107     /* ToDo: want to start with a larger stack size */
108     status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
109
110 #  endif /* !PAR && !GRAN */
111
112     /* check the status of the entire Haskell computation */
113     switch (status) {
114     case Killed:
115       prog_belch("main thread exited (uncaught exception)");
116       exit_status = EXIT_KILLED;
117       break;
118     case Interrupted:
119       prog_belch("interrupted");
120       exit_status = EXIT_INTERRUPTED;
121       break;
122     case Success:
123       exit_status = EXIT_SUCCESS;
124       break;
125 #if defined(PAR)
126     case NoStatus:
127       prog_belch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
128       exit_status = EXIT_KILLED;
129       break;
130 #endif 
131     default:
132       barf("main thread completed with invalid status");
133     }
134     shutdownHaskellAndExit(exit_status);
135     return 0; /* never reached, keep gcc -Wall happy */
136 }
137 # endif /* BATCH_MODE */