let no_hs_main = dopt Opt_NoHsMain dflags
let main_lib | no_hs_main = []
| otherwise = [ "-lHSrtsmain" ]
- rtsEnabledObj <- if dopt Opt_RtsOptsEnabled dflags
- then do fn <- mkExtraCObj dflags
- ["#include \"Rts.h\"",
- "const rtsBool rtsOptsEnabled = rtsTrue;"]
- return [fn]
- else return []
+ let mkRtsEnabledObj val = do fn <- mkExtraCObj dflags
+ ["#include \"Rts.h\"",
+ "#include \"RtsOpts.h\"",
+ "const rtsOptsEnabledEnum rtsOptsEnabled = "
+ ++ val ++ ";"]
+ return [fn]
+ rtsEnabledObj <- case rtsOptsEnabled dflags of
+ RtsOptsNone -> mkRtsEnabledObj "rtsOptsNone"
+ RtsOptsSafeOnly -> return []
+ RtsOptsAll -> mkRtsEnabledObj "rtsOptsAll"
rtsOptsObj <- case rtsOpts dflags of
Just opts ->
do fn <- mkExtraCObj dflags
lopt_set_flattened,
lopt_unset_flattened,
DynFlags(..),
+ RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
| Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
- | Opt_RtsOptsEnabled
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
ghcUsagePath :: FilePath, -- Filled in by SysTools
ghciUsagePath :: FilePath, -- ditto
rtsOpts :: Maybe String,
+ rtsOptsEnabled :: RtsOptsEnabled,
hpcDir :: String, -- ^ Path to store the .mix files
| SystemDependent
deriving Eq
+data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
+
-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
cmdlineFrameworks = [],
tmpDir = cDEFAULT_TMPDIR,
rtsOpts = Nothing,
+ rtsOptsEnabled = RtsOptsSafeOnly,
hpcDir = ".hpc",
, Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
, Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported
, Flag "with-rtsopts" (HasArg setRtsOpts) Supported
- , Flag "rtsopts" (NoArg (setDynFlag Opt_RtsOptsEnabled)) Supported
- , Flag "no-rtsopts" (NoArg (unSetDynFlag Opt_RtsOptsEnabled)) Supported
+ , Flag "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
+ , Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll)) Supported
+ , Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly)) Supported
+ , Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
+ , Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone)) Supported
, Flag "main-is" (SepArg setMainIs ) Supported
, Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported
, Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported
setRtsOpts :: String -> DynP ()
setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
+setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
+setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
+
-----------------------------------------------------------------------------
-- Hpc stuff
<entry>-</entry>
</row>
<row>
- <entry><option>-rtsopts</option></entry>
- <entry>Allow the RTS behaviour to be tweaked via command-line
+ <entry><option>-rtsopts</option>, <option>-rtsopts={none,some,all}</option></entry>
+ <entry>Control whether the RTS behaviour can be tweaked via command-line
flags and the <literal>GHCRTS</literal> environment
- variable.</entry>
+ variable. Using <literal>none</literal> means no RTS flags can be given; <literal>some</literal> means only a minimum of safe options can be given (the default), and <literal>all</literal> (or no argument at all) means that all RTS flags are permitted.</entry>
<entry>dynamic</entry>
<entry>-</entry>
</row>
#ifndef RTSOPTS_H
#define RTSOPTS_H
-extern const rtsBool rtsOptsEnabled;
+typedef enum {rtsOptsNone, rtsOptsSafeOnly, rtsOptsAll} rtsOptsEnabledEnum;
+
+extern const rtsOptsEnabledEnum rtsOptsEnabled;
#endif /* RTSOPTS_H */
char *ghc_rts = getenv("GHCRTS");
if (ghc_rts != NULL) {
- if (rtsOptsEnabled) {
+ if (rtsOptsEnabled != rtsOptsNone) {
splitRtsFlags(ghc_rts, rts_argc, rts_argv);
}
else {
break;
}
else if (strequal("+RTS", argv[arg])) {
- if (rtsOptsEnabled) {
+ if (rtsOptsEnabled != rtsOptsNone) {
mode = RTS;
}
else {
mode = PGM;
}
else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
- rts_argv[(*rts_argc)++] = argv[arg];
+ if ((rtsOptsEnabled == rtsOptsAll) ||
+ strequal(argv[arg], "--info")) {
+ rts_argv[(*rts_argc)++] = argv[arg];
+ }
+ else {
+ errorBelch("Most RTS options are disabled. Link with -rtsopts to enable them.");
+ stg_exit(EXIT_FAILURE);
+ }
}
else if (mode == PGM) {
argv[(*argc)++] = argv[arg];
#include "Rts.h"
#include "RtsOpts.h"
-const rtsBool rtsOptsEnabled = rtsFalse;
+const rtsOptsEnabledEnum rtsOptsEnabled = rtsOptsSafeOnly;