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