let lib_paths = libraryPaths dflags
let lib_path_opts = map ("-L"++) lib_paths
+ -- The C "main" function is not in the rts but in a separate static
+ -- library libHSrtsmain.a that sits next to the rts lib files. Assuming
+ -- we're using a Haskell main function then we need to link it in.
+ let no_hs_main = dopt Opt_NoHsMain dflags
+ let main_lib | no_hs_main = []
+ | otherwise = [ "-lHSrtsmain" ]
+
pkg_link_opts <- getPackageLinkOpts dflags dep_packages
#ifdef darwin_TARGET_OS
++ framework_opts
#endif
++ pkg_lib_path_opts
+ ++ main_lib
++ pkg_link_opts
#ifdef darwin_TARGET_OS
++ pkg_framework_path_opts
/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team 1998-2000
+ * (c) The GHC Team 2009
*
- * Main function for a standalone Haskell program.
+ * The C main() function for a standalone Haskell program.
+ *
+ * Note that this is not part of the RTS. It calls into the RTS to get things
+ * going. It is compiled to a separate Main.o which is linked into every
+ * standalone Haskell program that uses a Haskell Main.main function
+ * (as opposed to a mixed Haskell C program using a C main function).
*
* ---------------------------------------------------------------------------*/
-#define COMPILING_RTS_MAIN
-
-#include "PosixSource.h"
#include "Rts.h"
-#include "RtsAPI.h"
-#include "SchedAPI.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Prelude.h"
-#include "Task.h"
-#if defined(mingw32_HOST_OS)
-#include "win32/seh_excn.h"
-#endif
-#include <stdlib.h>
-
-#ifdef DEBUG
-# include "Printer.h" /* for printing */
-#endif
-
-#ifdef PAR
-# include "Parallel.h"
-# include "ParallelRts.h"
-# include "LLC.h"
-#endif
+#include "RtsMain.h"
-#if defined(GRAN) || defined(PAR)
-# include "GranSimRts.h"
-#endif
-
-#ifdef HAVE_WINDOWS_H
-# include <windows.h>
-#endif
-
-extern void __stginit_ZCMain(void);
-
-static int progargc;
-static char **progargv;
-
-/* Hack: we assume that we're building a batch-mode system unless
- * INTERPRETER is set
+/* The symbol for the Haskell Main module's init function. It is safe to refer
+ * to it here because this Main.o object file will only be linked in if we are
+ * linking a Haskell program that uses a Haskell Main.main function.
*/
-#ifndef INTERPRETER /* Hack */
-static void real_main(void)
-{
- int exit_status;
- SchedulerStatus status;
- /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
-
- startupHaskell(progargc,progargv,__stginit_ZCMain);
-
- /* kick off the computation by creating the main thread with a pointer
- to mainIO_closure representing the computation of the overall program;
- then enter the scheduler with this thread and off we go;
-
- the same for GranSim (we have only one instance of this code)
-
- in a parallel setup, where we have many instances of this code
- running on different PEs, we should do this only for the main PE
- (IAmMainThread is set in startupHaskell)
- */
-
-# if defined(PAR)
-
-# if defined(DEBUG)
- { /* a wait loop to allow attachment of gdb to UNIX threads */
- nat i, j, s;
-
- for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
- for (j=0; j<1000000; j++)
- s += j % 65536;
- }
- IF_PAR_DEBUG(verbose,
- belch("Passed wait loop"));
-# endif
-
- if (IAmMainThread == rtsTrue) {
- IF_PAR_DEBUG(verbose,
- debugBelch("==== [%x] Main Thread Started ...\n", mytid));
-
- /* ToDo: Dump event for the main thread */
- status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
- } else {
- /* Just to show we're alive */
- IF_PAR_DEBUG(verbose,
- debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
- mytid));
-
- /* all non-main threads enter the scheduler without work */
- taskStart();
- status = Success; // declare victory (see shutdownParallelSystem)
- }
-
-# elif defined(GRAN)
-
- /* ToDo: Dump event for the main thread */
- status = rts_mainLazyIO(mainIO_closure, NULL);
-
-# else /* !PAR && !GRAN */
-
- /* ToDo: want to start with a larger stack size */
- {
- Capability *cap = rts_lock();
- cap = rts_evalLazyIO(cap,(HaskellObj)(void *)mainIO_closure, NULL);
- status = rts_getSchedStatus(cap);
- taskTimeStamp(myTask());
- rts_unlock(cap);
- }
+extern void __stginit_ZCMain(void);
-# endif /* !PAR && !GRAN */
+/* Similarly, we can refer to the ZCMain_main_closure here */
+extern StgClosure ZCMain_main_closure;
- /* check the status of the entire Haskell computation */
- switch (status) {
- case Killed:
- errorBelch("main thread exited (uncaught exception)");
- exit_status = EXIT_KILLED;
- break;
- case Interrupted:
- errorBelch("interrupted");
- exit_status = EXIT_INTERRUPTED;
- break;
- case HeapExhausted:
- exit_status = EXIT_HEAPOVERFLOW;
- break;
- case Success:
- exit_status = EXIT_SUCCESS;
- break;
-#if defined(PAR)
- case NoStatus:
- errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
- exit_status = EXIT_KILLED;
- break;
-#endif
- default:
- barf("main thread completed with invalid status");
- }
- shutdownHaskellAndExit(exit_status);
-}
int main(int argc, char *argv[])
{
- /* We do this dance with argc and argv as otherwise the SEH exception
- stuff (the BEGIN/END CATCH below) on Windows gets confused */
- progargc = argc;
- progargv = argv;
-
-#if defined(mingw32_HOST_OS)
- BEGIN_CATCH
-#endif
- real_main();
-#if defined(mingw32_HOST_OS)
- END_CATCH
-#endif
- return 0; /* not reached, but keeps gcc -Wall happy */
+ return hs_main(argc, argv, &__stginit_ZCMain, &ZCMain_main_closure);
}
-# endif /* BATCH_MODE */
--- /dev/null
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 1998-2000
+ *
+ * Main function for a standalone Haskell program.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#define COMPILING_RTS_MAIN
+
+#include "PosixSource.h"
+#include "Rts.h"
+#include "RtsAPI.h"
+#include "SchedAPI.h"
+#include "RtsFlags.h"
+#include "RtsUtils.h"
+#include "RtsMain.h"
+#include "Prelude.h"
+#include "Task.h"
+#if defined(mingw32_HOST_OS)
+#include "win32/seh_excn.h"
+#endif
+#include <stdlib.h>
+
+#ifdef DEBUG
+# include "Printer.h" /* for printing */
+#endif
+
+#ifdef PAR
+# include "Parallel.h"
+# include "ParallelRts.h"
+# include "LLC.h"
+#endif
+
+#if defined(GRAN) || defined(PAR)
+# include "GranSimRts.h"
+#endif
+
+#ifdef HAVE_WINDOWS_H
+# include <windows.h>
+#endif
+
+extern void __stginit_ZCMain(void);
+
+/* Annoying global vars for passing parameters to real_main() below
+ * This is to get around problem with Windows SEH, see hs_main(). */
+static int progargc;
+static char **progargv;
+static void (*progmain_init)(void); /* This will be __stginit_ZCMain */
+static StgClosure *progmain_closure; /* This will be ZCMain_main_closure */
+
+/* Hack: we assume that we're building a batch-mode system unless
+ * INTERPRETER is set
+ */
+#ifndef INTERPRETER /* Hack */
+static void real_main(void)
+{
+ int exit_status;
+ SchedulerStatus status;
+ /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
+
+ startupHaskell(progargc,progargv,progmain_init);
+
+ /* kick off the computation by creating the main thread with a pointer
+ to mainIO_closure representing the computation of the overall program;
+ then enter the scheduler with this thread and off we go;
+
+ the same for GranSim (we have only one instance of this code)
+
+ in a parallel setup, where we have many instances of this code
+ running on different PEs, we should do this only for the main PE
+ (IAmMainThread is set in startupHaskell)
+ */
+
+# if defined(PAR)
+
+# if defined(DEBUG)
+ { /* a wait loop to allow attachment of gdb to UNIX threads */
+ nat i, j, s;
+
+ for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
+ for (j=0; j<1000000; j++)
+ s += j % 65536;
+ }
+ IF_PAR_DEBUG(verbose,
+ belch("Passed wait loop"));
+# endif
+
+ if (IAmMainThread == rtsTrue) {
+ IF_PAR_DEBUG(verbose,
+ debugBelch("==== [%x] Main Thread Started ...\n", mytid));
+
+ /* ToDo: Dump event for the main thread */
+ status = rts_mainLazyIO(progmain_closure, NULL);
+ } else {
+ /* Just to show we're alive */
+ IF_PAR_DEBUG(verbose,
+ debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
+ mytid));
+
+ /* all non-main threads enter the scheduler without work */
+ taskStart();
+ status = Success; // declare victory (see shutdownParallelSystem)
+ }
+
+# elif defined(GRAN)
+
+ /* ToDo: Dump event for the main thread */
+ status = rts_mainLazyIO(progmain_closure, NULL);
+
+# else /* !PAR && !GRAN */
+
+ /* ToDo: want to start with a larger stack size */
+ {
+ Capability *cap = rts_lock();
+ cap = rts_evalLazyIO(cap,progmain_closure, NULL);
+ status = rts_getSchedStatus(cap);
+ taskTimeStamp(myTask());
+ rts_unlock(cap);
+ }
+
+# endif /* !PAR && !GRAN */
+
+ /* check the status of the entire Haskell computation */
+ switch (status) {
+ case Killed:
+ errorBelch("main thread exited (uncaught exception)");
+ exit_status = EXIT_KILLED;
+ break;
+ case Interrupted:
+ errorBelch("interrupted");
+ exit_status = EXIT_INTERRUPTED;
+ break;
+ case HeapExhausted:
+ exit_status = EXIT_HEAPOVERFLOW;
+ break;
+ case Success:
+ exit_status = EXIT_SUCCESS;
+ break;
+#if defined(PAR)
+ case NoStatus:
+ errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
+ exit_status = EXIT_KILLED;
+ break;
+#endif
+ default:
+ barf("main thread completed with invalid status");
+ }
+ shutdownHaskellAndExit(exit_status);
+}
+
+/* The rts entry point from a compiled program using a Haskell main function.
+ * This gets called from a tiny main function which gets linked into each
+ * compiled Haskell program that uses a Haskell main function.
+ *
+ * We expect the caller to pass __stginit_ZCMain for main_init and
+ * ZCMain_main_closure for main_closure. The reason we cannot refer to
+ * these symbols directly is because we're inside the rts and we do not know
+ * for sure that we'll be using a Haskell main function.
+ */
+int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure)
+{
+ /* We do this dance with argc and argv as otherwise the SEH exception
+ stuff (the BEGIN/END CATCH below) on Windows gets confused */
+ progargc = argc;
+ progargv = argv;
+ progmain_init = main_init;
+ progmain_closure = main_closure;
+
+#if defined(mingw32_HOST_OS)
+ BEGIN_CATCH
+#endif
+ real_main();
+#if defined(mingw32_HOST_OS)
+ END_CATCH
+#endif
+ return 0; /* not reached, but keeps gcc -Wall happy */
+}
+# endif /* BATCH_MODE */
--- /dev/null
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2009
+ *
+ * Entry point for standalone Haskell programs.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTSMAIN_H
+#define RTSMAIN_H
+
+/* -----------------------------------------------------------------------------
+ * The entry point for Haskell programs that use a Haskell main function
+ * -------------------------------------------------------------------------- */
+
+extern int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure);
+
+#endif /* RTSMAIN_H */
# merge GhcLibWays and GhcRTSWays but strip out duplicates
rts_WAYS = $(GhcLibWays) $(filter-out $(GhcLibWays),$(GhcRTSWays))
-ALL_RTS_LIBS = $(foreach way,$(rts_WAYS),rts/dist/build/libHSrts$($(way)_libsuf))
+ALL_RTS_LIBS = $(foreach way,$(rts_WAYS),rts/dist/build/libHSrts$($(way)_libsuf)) \
+ rts/dist/build/libHSrtsmain.a
all_rts : $(ALL_RTS_LIBS)
# The per-dir options
ALL_DIRS += posix
endif
+EXCLUDED_SRCS += rts/Main.c
EXCLUDED_SRCS += rts/parallel/SysMan.c
EXCLUDED_SRCS += rts/dyn-wrapper.c
EXCLUDED_SRCS += $(wildcard rts/Vis*.c)
# XXX DQ is now the same on all platforms, so get rid of it
DQ = \"
-# If Main.c is built with optimisation then the SEH exception stuff on
+# If RtsMain.c is built with optimisation then the SEH exception stuff on
# Windows gets confused.
# This has to be in HC rather than CC opts, as otherwise there's a
# -optc-O2 that comes after it.
-Main_HC_OPTS += -optc-O0
+RtsMain_HC_OPTS += -optc-O0
RtsMessages_CC_OPTS += -DProjectVersion=$(DQ)$(ProjectVersion)$(DQ)
RtsUtils_CC_OPTS += -DProjectVersion=$(DQ)$(ProjectVersion)$(DQ)
$(HC) -cpp -optc-include -optcdyn-wrapper-patchable-behaviour.h $(INPLACE_EXTRA_FLAGS) $< -o $@
# -----------------------------------------------------------------------------
+# build the static lib containing the C main symbol
+
+rts/dist/build/libHSrtsmain.a : rts/dist/build/Main.o
+ $(AR) $(EXTRA_AR_ARGS) $@ $<
+
+# -----------------------------------------------------------------------------
# The RTS package config
# If -DDEBUG is in effect, adjust package conf accordingly..
projects / ghc-hetmet.git / commitdiff