From 1df28a805b465a28b61f4cfe4db28f247a183206 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Tue, 15 Nov 2011 15:43:28 +0000 Subject: Generate the C main() function when linking a binary (fixes #5373) Rather than have main() be statically compiled as part of the RTS, we now generate it into the tiny C file that we compile when linking a binary. The main motivation is that we want to pass the settings for the -rtsotps and -with-rtsopts flags into the RTS, rather than relying on fragile linking semantics to override the defaults, which don't work with DLLs on Windows (#5373). In order to do this, we need to extend the API for initialising the RTS, so now we have: void hs_init_ghc (int *argc, char **argv[], // program arguments RtsConfig rts_config); // RTS configuration hs_init_ghc() can optionally be used instead of hs_init(), and allows passing in configuration options for the RTS. RtsConfig is a struct, which currently has two fields: typedef struct { RtsOptsEnabledEnum rts_opts_enabled; const char *rts_opts; } RtsConfig; but might have more in the future. There is a default value for the struct, defaultRtsConfig, the idea being that you start with this and override individual fields as necessary. In fact, main() was in a separate static library, libHSrtsmain.a. That's now gone. --- rts/Main.c | 24 ------------------------ rts/RtsFlags.c | 26 ++++++++++++++------------ rts/RtsFlags.h | 4 +++- rts/RtsMain.c | 19 +++++++++++-------- rts/RtsMain.h | 19 ------------------- rts/RtsStartup.c | 14 +++++++++++++- rts/ghc.mk | 13 +------------ rts/hooks/RtsOpts.c | 14 -------------- 8 files changed, 42 insertions(+), 91 deletions(-) delete mode 100644 rts/Main.c delete mode 100644 rts/RtsMain.h delete mode 100644 rts/hooks/RtsOpts.c (limited to 'rts') diff --git a/rts/Main.c b/rts/Main.c deleted file mode 100644 index c7a559fc14..0000000000 --- a/rts/Main.c +++ /dev/null @@ -1,24 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team 2009 - * - * 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). - * - * ---------------------------------------------------------------------------*/ - -#include "PosixSource.h" -#include "Rts.h" -#include "RtsMain.h" - -/* Similarly, we can refer to the ZCMain_main_closure here */ -extern StgClosure ZCMain_main_closure; - -int main(int argc, char *argv[]) -{ - return hs_main(argc, argv, &ZCMain_main_closure); -} diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index d2b4945c19..d8bcf1c915 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -10,7 +10,6 @@ #include "PosixSource.h" #include "Rts.h" -#include "RtsOpts.h" #include "RtsUtils.h" #include "Profiling.h" #include "RtsFlags.h" @@ -396,9 +395,10 @@ strequal(const char *a, const char * b) return(strcmp(a, b) == 0); } -static void splitRtsFlags(char *s) +static void splitRtsFlags(const char *s) { - char *c1, *c2; + const char *c1, *c2; + char *t; c1 = s; do { @@ -408,10 +408,10 @@ static void splitRtsFlags(char *s) if (c1 == c2) { break; } - s = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()"); - strncpy(s, c1, c2-c1); - s[c2-c1] = '\0'; - rts_argv[rts_argc++] = s; + t = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()"); + strncpy(t, c1, c2-c1); + t[c2-c1] = '\0'; + rts_argv[rts_argc++] = t; c1 = c2; } while (*c1 != '\0'); @@ -434,7 +434,9 @@ static void splitRtsFlags(char *s) -------------------------------------------------------------------------- */ -void setupRtsFlags (int *argc, char *argv[]) +void setupRtsFlags (int *argc, char *argv[], + RtsOptsEnabledEnum rtsOptsEnabled, + const char *ghc_rts_opts) { nat mode; nat total_arg; @@ -554,14 +556,14 @@ static void checkUnsafe(RtsOptsEnabledEnum enabled) } } -static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum enabled) +static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum rtsOptsEnabled) { rtsBool error = rtsFalse; int arg; if (!(rts_argc0 < rts_argc)) return; - if (enabled == RtsOptsNone) { + if (rtsOptsEnabled == RtsOptsNone) { errorBelch("RTS options are disabled. Link with -rtsopts to enable them."); stg_exit(EXIT_FAILURE); } @@ -578,7 +580,7 @@ static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum enabled) rtsBool option_checked = rtsFalse; #define OPTION_SAFE option_checked = rtsTrue; -#define OPTION_UNSAFE checkUnsafe(enabled); option_checked = rtsTrue; +#define OPTION_UNSAFE checkUnsafe(rtsOptsEnabled); option_checked = rtsTrue; if (rts_argv[arg][0] != '-') { fflush(stdout); @@ -1142,7 +1144,7 @@ error = rtsTrue; errorBelch("bad value for -N"); error = rtsTrue; } - if (enabled == RtsOptsSafeOnly && + if (rtsOptsEnabled == RtsOptsSafeOnly && nNodes > (int)getNumberOfProcessors()) { errorBelch("Using large values for -N is not allowed by default. Link with -rtsopts to allow full control."); stg_exit(EXIT_FAILURE); diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h index a6bfe0a924..73eb6688a6 100644 --- a/rts/RtsFlags.h +++ b/rts/RtsFlags.h @@ -15,7 +15,9 @@ /* Routines that operate-on/to-do-with RTS flags: */ void initRtsFlagsDefaults (void); -void setupRtsFlags (int *argc, char *argv[]); +void setupRtsFlags (int *argc, char *argv[], + RtsOptsEnabledEnum rtsOptsEnabled, + const char *ghc_rts_opts); void setProgName (char *argv[]); void freeRtsArgs (void); diff --git a/rts/RtsMain.c b/rts/RtsMain.c index a822da9749..0f6ca82382 100644 --- a/rts/RtsMain.c +++ b/rts/RtsMain.c @@ -13,7 +13,6 @@ #include "RtsAPI.h" #include "RtsUtils.h" -#include "RtsMain.h" #include "Prelude.h" #include "Task.h" #if defined(mingw32_HOST_OS) @@ -33,8 +32,9 @@ static int progargc; static char **progargv; static StgClosure *progmain_closure; /* This will be ZCMain_main_closure */ +static RtsConfig rtsconfig; -/* Hack: we assume that we're building a batch-mode system unless +/* Hack: we assume that we're building a batch-mode system unless * INTERPRETER is set */ #ifndef INTERPRETER /* Hack */ @@ -43,9 +43,8 @@ static void real_main(void) { int exit_status; SchedulerStatus status; - /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */ - startupHaskell(progargc,progargv,NULL); + hs_init_ghc(&progargc, &progargv, rtsconfig); /* kick off the computation by creating the main thread with a pointer to mainIO_closure representing the computation of the overall program; @@ -89,22 +88,26 @@ static void real_main(void) 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. +/* The rts entry point from a compiled program using a Haskell main + * function. This gets called from a tiny main function generated by + * GHC and linked into each compiled Haskell program that uses a + * Haskell main function. * * We expect the caller to pass ZCMain_main_closure for * main_closure. The reason we cannot refer to this symbol 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[], StgClosure *main_closure) +int hs_main (int argc, char *argv[], // program args + StgClosure *main_closure, // closure for Main.main + RtsConfig rts_config) // RTS configuration { /* 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_closure = main_closure; + rtsconfig = rts_config; #if defined(mingw32_HOST_OS) BEGIN_CATCH diff --git a/rts/RtsMain.h b/rts/RtsMain.h deleted file mode 100644 index e004480cce..0000000000 --- a/rts/RtsMain.h +++ /dev/null @@ -1,19 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (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 - * -------------------------------------------------------------------------- */ - -int hs_main(int argc, char *argv[], StgClosure *main_closure) - GNUC3_ATTRIBUTE(__noreturn__); - -#endif /* RTSMAIN_H */ diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index de8bf792c4..e8ed86c994 100755 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -71,6 +71,11 @@ static int hs_init_count = 0; static void flushStdHandles(void); +const RtsConfig defaultRtsConfig = { + .rts_opts_enabled = RtsOptsSafeOnly, + .rts_opts = NULL +}; + /* ----------------------------------------------------------------------------- Initialise floating point unit on x86 (currently disabled; See Note [x86 Floating point precision] in compiler/nativeGen/X86/Instr.hs) @@ -105,6 +110,12 @@ x86_init_fpu ( void ) void hs_init(int *argc, char **argv[]) +{ + hs_init_ghc(argc, argv, defaultRtsConfig); +} + +void +hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { hs_init_count++; if (hs_init_count > 1) { @@ -132,7 +143,8 @@ hs_init(int *argc, char **argv[]) /* Parse the flags, separating the RTS flags from the programs args */ if (argc != NULL && argv != NULL) { setFullProgArgv(*argc,*argv); - setupRtsFlags(argc, *argv); + setupRtsFlags(argc, *argv, + rts_config.rts_opts_enabled, rts_config.rts_opts); } /* Initialise the stats department, phase 1 */ diff --git a/rts/ghc.mk b/rts/ghc.mk index 54c941d019..40ff02fcc4 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -20,8 +20,7 @@ rts_dist_HC = $(GHC_STAGE1) rts_WAYS = $(GhcLibWays) $(filter-out $(GhcLibWays),$(GhcRTSWays)) rts_dist_WAYS = $(rts_WAYS) -ALL_RTS_LIBS = rts/dist/build/libHSrtsmain.a \ - $(foreach way,$(rts_WAYS),rts/dist/build/libHSrts$($(way)_libsuf)) +ALL_RTS_LIBS = $(foreach way,$(rts_WAYS),rts/dist/build/libHSrts$($(way)_libsuf)) all_rts : $(ALL_RTS_LIBS) # ----------------------------------------------------------------------------- @@ -36,7 +35,6 @@ ALL_DIRS += posix endif EXCLUDED_SRCS := -EXCLUDED_SRCS += rts/Main.c EXCLUDED_SRCS += rts/parallel/SysMan.c EXCLUDED_SRCS += $(wildcard rts/Vis*.c) @@ -484,15 +482,6 @@ $(DTRACEPROBES_H): $(DTRACEPROBES_SRC) includes/ghcplatform.h | $$(dir $$@)/. "$(DTRACE)" $(filter -I%,$(rts_CC_OPTS)) -C $(DTRACE_FLAGS) -h -o $@ -s $< endif -# ----------------------------------------------------------------------------- -# build the static lib containing the C main symbol - -ifneq "$(BINDIST)" "YES" -rts/dist/build/libHSrtsmain.a : rts/dist/build/Main.o - "$(RM)" $(RM_OPTS) $@ - "$(AR_STAGE1)" $(AR_OPTS_STAGE1) $(EXTRA_AR_ARGS_STAGE1) $@ $< -endif - # ----------------------------------------------------------------------------- # The RTS package config diff --git a/rts/hooks/RtsOpts.c b/rts/hooks/RtsOpts.c deleted file mode 100644 index 2aae37246e..0000000000 --- a/rts/hooks/RtsOpts.c +++ /dev/null @@ -1,14 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * Default RTS options. - * - * ---------------------------------------------------------------------------*/ - -#include "PosixSource.h" -#include "Rts.h" - -#include - -// Default RTS options can be given by providing an alternate -// definition for this variable, pointing to a string of RTS options. -char *ghc_rts_opts = NULL; -- cgit v1.2.1