summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DriverPipeline.hs1
-rw-r--r--includes/RtsAPI.h5
-rw-r--r--rts/RtsFlags.c44
-rw-r--r--rts/RtsFlags.h3
-rw-r--r--rts/RtsStartup.c15
5 files changed, 49 insertions, 19 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index a6567c8c39..048896c009 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1634,6 +1634,7 @@ mkExtraObjToLinkIntoBinary dflags = do
Nothing -> empty
Just opts -> ptext (sLit " __conf.rts_opts= ") <>
text (show opts) <> semi,
+ ptext (sLit " __conf.rts_hs_main = rtsTrue;"),
ptext (sLit " return hs_main(argc, argv, &ZCMain_main_closure,__conf);"),
char '}',
char '\n' -- final newline, to keep gcc happy
diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index ca87662eb4..018b5813ce 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -62,6 +62,7 @@ typedef enum {
typedef struct {
RtsOptsEnabledEnum rts_opts_enabled;
const char *rts_opts;
+ HsBool rts_hs_main;
} RtsConfig;
// Clients should start with defaultRtsConfig and then customise it.
@@ -80,6 +81,10 @@ extern void startupHaskell ( int argc, char *argv[],
/* DEPRECATED, use hs_exit() instead */
extern void shutdownHaskell ( void );
+/* Like hs_init(), but allows rtsopts. For more complicated usage,
+ * use hs_init_ghc. */
+extern void hs_init_with_rtsopts (int *argc, char **argv[]);
+
/*
* GHC-specific version of hs_init() that allows specifying whether
* +RTS ... -RTS options are allowed or not (default: only "safe"
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 1e541a0201..4f850b583c 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -61,7 +61,7 @@ wchar_t **win32_prog_argv = NULL;
Static function decls
-------------------------------------------------------------------------- */
-static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum enabled);
+static void procRtsOpts (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum enabled);
static void normaliseRtsOpts (void);
@@ -85,6 +85,8 @@ static char * copyArg (char *arg);
static char ** copyArgv (int argc, char *argv[]);
static void freeArgv (int argc, char *argv[]);
+static void errorRtsOptsDisabled(HsBool is_hs_main, const char *s);
+
/* -----------------------------------------------------------------------------
* Command-line option parsing routines.
* ---------------------------------------------------------------------------*/
@@ -444,6 +446,17 @@ static void splitRtsFlags(const char *s)
} while (*c1 != '\0');
}
+static void
+errorRtsOptsDisabled(HsBool is_hs_main, const char *s) {
+ char *advice;
+ if (is_hs_main) {
+ advice = "Link with -rtsopts to enable them.";
+ } else {
+ advice = "Use hs_init_with_rtsopts() to enable them.";
+ }
+ errorBelch(s, advice);
+}
+
/* -----------------------------------------------------------------------------
Parse the command line arguments, collecting options for the RTS.
@@ -463,7 +476,8 @@ static void splitRtsFlags(const char *s)
void setupRtsFlags (int *argc, char *argv[],
RtsOptsEnabledEnum rtsOptsEnabled,
- const char *ghc_rts_opts)
+ const char *ghc_rts_opts,
+ HsBool is_hs_main)
{
nat mode;
nat total_arg;
@@ -488,7 +502,7 @@ void setupRtsFlags (int *argc, char *argv[],
if (ghc_rts_opts != NULL) {
splitRtsFlags(ghc_rts_opts);
// opts from ghc_rts_opts are always enabled:
- procRtsOpts(rts_argc0, RtsOptsAll);
+ procRtsOpts(is_hs_main, rts_argc0, RtsOptsAll);
rts_argc0 = rts_argc;
}
}
@@ -500,11 +514,11 @@ void setupRtsFlags (int *argc, char *argv[],
if (ghc_rts != NULL) {
if (rtsOptsEnabled == RtsOptsNone) {
- errorBelch("Warning: Ignoring GHCRTS variable as RTS options are disabled.\n Link with -rtsopts to enable them.");
+ errorRtsOptsDisabled(is_hs_main, "Warning: Ignoring GHCRTS variable as RTS options are disabled.\n %s");
// We don't actually exit, just warn
} else {
splitRtsFlags(ghc_rts);
- procRtsOpts(rts_argc0, rtsOptsEnabled);
+ procRtsOpts(is_hs_main, rts_argc0, rtsOptsEnabled);
rts_argc0 = rts_argc;
}
}
@@ -543,7 +557,7 @@ void setupRtsFlags (int *argc, char *argv[],
}
argv[*argc] = (char *) 0;
- procRtsOpts(rts_argc0, rtsOptsEnabled);
+ procRtsOpts(is_hs_main, rts_argc0, rtsOptsEnabled);
appendRtsArg((char *)0);
rts_argc--; // appendRtsArg will have bumped it for the NULL (#7227)
@@ -564,29 +578,29 @@ void setupRtsFlags (int *argc, char *argv[],
* procRtsOpts: Process rts_argv between rts_argc0 and rts_argc.
* -------------------------------------------------------------------------- */
-static void checkSuid(RtsOptsEnabledEnum enabled)
+static void checkSuid(HsBool is_hs_main, RtsOptsEnabledEnum enabled)
{
if (enabled == RtsOptsSafeOnly) {
#if defined(HAVE_UNISTD_H) && defined(HAVE_SYS_TYPES_H) && !defined(mingw32_HOST_OS)
/* This doesn't cover linux/posix capabilities like CAP_DAC_OVERRIDE,
we'd have to link with -lcap for that. */
if ((getuid() != geteuid()) || (getgid() != getegid())) {
- errorBelch("RTS options are disabled for setuid binaries. Link with -rtsopts to enable them.");
+ errorRtsOptsDisabled(is_hs_main, "RTS options are disabled for setuid binaries. %s");
stg_exit(EXIT_FAILURE);
}
#endif
}
}
-static void checkUnsafe(RtsOptsEnabledEnum enabled)
+static void checkUnsafe(HsBool is_hs_main, RtsOptsEnabledEnum enabled)
{
if (enabled == RtsOptsSafeOnly) {
- errorBelch("Most RTS options are disabled. Link with -rtsopts to enable them.");
+ errorRtsOptsDisabled(is_hs_main, "Most RTS options are disabled. %s");
stg_exit(EXIT_FAILURE);
}
}
-static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum rtsOptsEnabled)
+static void procRtsOpts (HsBool is_hs_main, int rts_argc0, RtsOptsEnabledEnum rtsOptsEnabled)
{
rtsBool error = rtsFalse;
int arg;
@@ -594,11 +608,11 @@ static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum rtsOptsEnabled)
if (!(rts_argc0 < rts_argc)) return;
if (rtsOptsEnabled == RtsOptsNone) {
- errorBelch("RTS options are disabled. Link with -rtsopts to enable them.");
+ errorRtsOptsDisabled(is_hs_main, "RTS options are disabled. %s");
stg_exit(EXIT_FAILURE);
}
- checkSuid(rtsOptsEnabled);
+ checkSuid(is_hs_main, rtsOptsEnabled);
// Process RTS (rts_argv) part: mainly to determine statsfile
for (arg = rts_argc0; arg < rts_argc; arg++) {
@@ -610,7 +624,7 @@ static void procRtsOpts (int rts_argc0, RtsOptsEnabledEnum rtsOptsEnabled)
rtsBool option_checked = rtsFalse;
#define OPTION_SAFE option_checked = rtsTrue;
-#define OPTION_UNSAFE checkUnsafe(rtsOptsEnabled); option_checked = rtsTrue;
+#define OPTION_UNSAFE checkUnsafe(is_hs_main, rtsOptsEnabled); option_checked = rtsTrue;
if (rts_argv[arg][0] != '-') {
fflush(stdout);
@@ -1162,7 +1176,7 @@ error = rtsTrue;
}
if (rtsOptsEnabled == RtsOptsSafeOnly &&
nNodes > (int)getNumberOfProcessors()) {
- errorBelch("Using large values for -N is not allowed by default. Link with -rtsopts to allow full control.");
+ errorRtsOptsDisabled(is_hs_main, "Using large values for -N is not allowed by default. %s");
stg_exit(EXIT_FAILURE);
}
RtsFlags.ParFlags.nNodes = (nat)nNodes;
diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h
index 73eb6688a6..b3627e0e48 100644
--- a/rts/RtsFlags.h
+++ b/rts/RtsFlags.h
@@ -17,7 +17,8 @@
void initRtsFlagsDefaults (void);
void setupRtsFlags (int *argc, char *argv[],
RtsOptsEnabledEnum rtsOptsEnabled,
- const char *ghc_rts_opts);
+ const char *ghc_rts_opts,
+ HsBool is_hs_main);
void setProgName (char *argv[]);
void freeRtsArgs (void);
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 39c5ef1f94..a1c74ae6a6 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -69,7 +69,8 @@ static void flushStdHandles(void);
const RtsConfig defaultRtsConfig = {
.rts_opts_enabled = RtsOptsSafeOnly,
- .rts_opts = NULL
+ .rts_opts = NULL,
+ .rts_hs_main = rtsFalse
};
/* -----------------------------------------------------------------------------
@@ -111,6 +112,14 @@ hs_init(int *argc, char **argv[])
}
void
+hs_init_with_rtsopts(int *argc, char **argv[])
+{
+ RtsConfig rts_opts = defaultRtsConfig; /* by value */
+ rts_opts.rts_opts_enabled = RtsOptsAll;
+ hs_init_ghc(argc, argv, rts_opts);
+}
+
+void
hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
{
hs_init_count++;
@@ -146,11 +155,11 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
char *my_argv[] = { "<unknown>", NULL };
setFullProgArgv(my_argc,my_argv);
setupRtsFlags(&my_argc, my_argv,
- rts_config.rts_opts_enabled, rts_config.rts_opts);
+ rts_config.rts_opts_enabled, rts_config.rts_opts, rts_config.rts_hs_main);
} else {
setFullProgArgv(*argc,*argv);
setupRtsFlags(argc, *argv,
- rts_config.rts_opts_enabled, rts_config.rts_opts);
+ rts_config.rts_opts_enabled, rts_config.rts_opts, rts_config.rts_hs_main);
}
/* Initialise the stats department, phase 1 */
View Lorry Controller Status