Commit fa00cc50 authored by Duncan Coutts's avatar Duncan Coutts

Keep C main separate from rts lib and link it in for standalone progs

Previously the object code for the C main function lived in the rts
lib, however this is a problem when the rts is built as a shared lib.
With Windows DLLs it always causes problems while on ELF systems it's a
problem when the user decides to use their own C main function rather
than a Haskell Main.main. So instead we now put main in it's own tiny
little static lib libHSrtsmain.a which we install next to the rts libs.
Whenever ghc links a program (without -no-hs-main) then it also links
in -lHSrtsmain. For consistency we always do it this way now rather
than trying to do it differently for static vs shared libraries.
parent 3d411991
......@@ -1379,6 +1379,13 @@ linkBinary dflags o_files dep_packages = do
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
......@@ -1445,6 +1452,7 @@ linkBinary dflags o_files dep_packages = do
++ 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 */
/* -----------------------------------------------------------------------------
*
* (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 */
/* -----------------------------------------------------------------------------
*
* (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 */
......@@ -19,7 +19,8 @@ rts_dist_HC = $(GHC_STAGE1)
# 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
......@@ -36,6 +37,7 @@ else
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)
......@@ -253,11 +255,11 @@ endif
# 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)
......@@ -398,6 +400,12 @@ DYNWRAPPER_PROG = rts/dyn-wrapper$(exeext)
$(DYNWRAPPER_PROG): $(DYNWRAPPER_SRC)
$(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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment