Distinguish between hs-main cases when giving rtsopts advice.
authorEdward Z. Yang <ezyang@mit.edu>
Sat, 14 Sep 2013 05:11:12 +0000 (22:11 -0700)
committerEdward Z. Yang <ezyang@mit.edu>
Mon, 16 Sep 2013 06:53:10 +0000 (23:53 -0700)
Signed-off-by: Edward Z. Yang <ezyang@mit.edu>
compiler/main/DriverPipeline.hs
includes/RtsAPI.h
rts/RtsFlags.c
rts/RtsFlags.h
rts/RtsStartup.c

index a6567c8..048896c 100644 (file)
@@ -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
index ca87662..018b581 100644 (file)
@@ -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"
index 1e541a0..4f850b5 100644 (file)
@@ -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;
index 73eb668..b3627e0 100644 (file)
@@ -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);
 
index 39c5ef1..a1c74ae 100644 (file)
@@ -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 */