1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 1998-2000
5 * Main function for a standalone Haskell program.
7 * ---------------------------------------------------------------------------*/
9 #define COMPILING_RTS_MAIN
11 #include "PosixSource.h"
20 #if defined(mingw32_HOST_OS)
21 #include "win32/seh_excn.h"
26 # include "Printer.h" /* for printing */
30 # include "Parallel.h"
31 # include "ParallelRts.h"
35 #if defined(GRAN) || defined(PAR)
36 # include "GranSimRts.h"
43 extern void __stginit_ZCMain(void);
45 /* Annoying global vars for passing parameters to real_main() below
46 * This is to get around problem with Windows SEH, see hs_main(). */
48 static char **progargv;
49 static void (*progmain_init)(void); /* This will be __stginit_ZCMain */
50 static StgClosure *progmain_closure; /* This will be ZCMain_main_closure */
52 /* Hack: we assume that we're building a batch-mode system unless
55 #ifndef INTERPRETER /* Hack */
56 static void real_main(void)
59 SchedulerStatus status;
60 /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
62 startupHaskell(progargc,progargv,progmain_init);
64 /* kick off the computation by creating the main thread with a pointer
65 to mainIO_closure representing the computation of the overall program;
66 then enter the scheduler with this thread and off we go;
68 the same for GranSim (we have only one instance of this code)
70 in a parallel setup, where we have many instances of this code
71 running on different PEs, we should do this only for the main PE
72 (IAmMainThread is set in startupHaskell)
78 { /* a wait loop to allow attachment of gdb to UNIX threads */
81 for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
82 for (j=0; j<1000000; j++)
86 belch("Passed wait loop"));
89 if (IAmMainThread == rtsTrue) {
91 debugBelch("==== [%x] Main Thread Started ...\n", mytid));
93 /* ToDo: Dump event for the main thread */
94 status = rts_mainLazyIO(progmain_closure, NULL);
96 /* Just to show we're alive */
98 debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
101 /* all non-main threads enter the scheduler without work */
103 status = Success; // declare victory (see shutdownParallelSystem)
108 /* ToDo: Dump event for the main thread */
109 status = rts_mainLazyIO(progmain_closure, NULL);
111 # else /* !PAR && !GRAN */
113 /* ToDo: want to start with a larger stack size */
115 Capability *cap = rts_lock();
116 cap = rts_evalLazyIO(cap,progmain_closure, NULL);
117 status = rts_getSchedStatus(cap);
118 taskTimeStamp(myTask());
122 # endif /* !PAR && !GRAN */
124 /* check the status of the entire Haskell computation */
127 errorBelch("main thread exited (uncaught exception)");
128 exit_status = EXIT_KILLED;
131 errorBelch("interrupted");
132 exit_status = EXIT_INTERRUPTED;
135 exit_status = EXIT_HEAPOVERFLOW;
138 exit_status = EXIT_SUCCESS;
142 errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
143 exit_status = EXIT_KILLED;
147 barf("main thread completed with invalid status");
149 shutdownHaskellAndExit(exit_status);
152 /* The rts entry point from a compiled program using a Haskell main function.
153 * This gets called from a tiny main function which gets linked into each
154 * compiled Haskell program that uses a Haskell main function.
156 * We expect the caller to pass __stginit_ZCMain for main_init and
157 * ZCMain_main_closure for main_closure. The reason we cannot refer to
158 * these symbols directly is because we're inside the rts and we do not know
159 * for sure that we'll be using a Haskell main function.
161 int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure)
163 /* We do this dance with argc and argv as otherwise the SEH exception
164 stuff (the BEGIN/END CATCH below) on Windows gets confused */
167 progmain_init = main_init;
168 progmain_closure = main_closure;
170 #if defined(mingw32_HOST_OS)
174 #if defined(mingw32_HOST_OS)
177 return 0; /* not reached, but keeps gcc -Wall happy */
179 # endif /* BATCH_MODE */