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