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.

8 files changed, 42 insertions, 91 deletions

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)
@@ -106,6 +111,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) {
 	// second and subsequent inits are ignored
@@ -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)
 
@@ -485,15 +483,6 @@ $(DTRACEPROBES_H): $(DTRACEPROBES_SRC) includes/ghcplatform.h | $$(dir $$@)/.
 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
 
 # If -DDEBUG is in effect, adjust package conf accordingly..
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 <stdlib.h>
-
-// 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;