Commit 929d1669 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add a link-time flag to en/disable the RTS options

If RTS options are disabled then:
* The ghc_rts_opts C code variable is processed as normal
* The GHCRTS environment variable is ignored and, if it is defined, a
  warning is emitted
* The +RTS flag gives an error and terminates the program
parent 1e31c296
......@@ -1299,6 +1299,20 @@ wrapper_behaviour dflags mode dep_packages =
putStrLn (unwords (map (packageIdString . packageConfigId) allpkg))
return $ 'F':s ++ ';':(seperateBySemiColon (map (packageIdString . packageConfigId) allpkg))
mkExtraCObj :: DynFlags -> [String] -> IO FilePath
mkExtraCObj dflags xs
= do cFile <- newTempName dflags "c"
oFile <- newTempName dflags "o"
writeFile cFile $ unlines xs
let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId
SysTools.runCc dflags
([Option "-c",
FileOption "" cFile,
Option "-o",
FileOption "" oFile] ++
map (FileOption "-I") (includeDirs rtsDetails))
return oFile
-- generates a Perl skript starting a parallel prg under PVM
mk_pvm_wrapper_script :: String -> String -> String -> String
mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
......@@ -1409,6 +1423,12 @@ linkBinary dflags o_files dep_packages = do
let no_hs_main = dopt Opt_NoHsMain dflags
let main_lib | no_hs_main = []
| otherwise = [ "-lHSrtsmain" ]
rtsEnabledLib <- if dopt Opt_RtsOptsEnabled dflags
then do fn <- mkExtraCObj dflags
["#include \"Rts.h\"",
"const rtsBool rtsOptsEnabled = rtsTrue;"]
return [fn]
else return []
pkg_link_opts <- getPackageLinkOpts dflags dep_packages
......@@ -1483,6 +1503,7 @@ linkBinary dflags o_files dep_packages = do
#endif
++ pkg_lib_path_opts
++ main_lib
++ rtsEnabledLib
++ pkg_link_opts
#ifdef darwin_TARGET_OS
++ pkg_framework_path_opts
......
......@@ -298,6 +298,7 @@ data DynFlag
| Opt_EagerBlackHoling
| Opt_ReadUserPackageConf
| Opt_NoHsMain
| Opt_RtsOptsEnabled
| Opt_SplitObjs
| Opt_StgStats
| Opt_HideAllPackages
......@@ -690,6 +691,7 @@ defaultDynFlags =
dirsToClean = panic "defaultDynFlags: No dirsToClean",
haddockOptions = Nothing,
flags = [
Opt_RtsOptsEnabled,
Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
......@@ -1108,6 +1110,8 @@ dynamic_flags = [
------- Miscellaneous ----------------------------------------------
, Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
, Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported
, Flag "rtsopts" (NoArg (setDynFlag Opt_RtsOptsEnabled)) Supported
, Flag "no-rtsopts" (NoArg (unSetDynFlag Opt_RtsOptsEnabled)) Supported
, Flag "main-is" (SepArg setMainIs ) Supported
, Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported
, Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported
......
......@@ -10,6 +10,7 @@
#include "PosixSource.h"
#include "Rts.h"
#include "RtsOpts.h"
#include "RtsUtils.h"
#include "Profiling.h"
......@@ -413,7 +414,13 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
char *ghc_rts = getenv("GHCRTS");
if (ghc_rts != NULL) {
splitRtsFlags(ghc_rts, rts_argc, rts_argv);
if (rtsOptsEnabled) {
splitRtsFlags(ghc_rts, rts_argc, rts_argv);
}
else {
errorBelch("Warning: Ignoring GHCRTS variable");
// We don't actually exit, just warn
}
}
}
......@@ -432,7 +439,13 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
break;
}
else if (strequal("+RTS", argv[arg])) {
mode = RTS;
if (rtsOptsEnabled) {
mode = RTS;
}
else {
errorBelch("RTS options are disabled");
stg_exit(EXIT_FAILURE);
}
}
else if (strequal("-RTS", argv[arg])) {
mode = PGM;
......
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 2010
*
* En/disable RTS options
*
* ---------------------------------------------------------------------------*/
#ifndef RTSOPTS_H
#define RTSOPTS_H
extern const rtsBool rtsOptsEnabled;
#endif /* RTSOPTS_H */
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team 2010
*
* En/disable RTS options
*
* ---------------------------------------------------------------------------*/
#include "Rts.h"
#include "RtsOpts.h"
const rtsBool rtsOptsEnabled = rtsFalse;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment