Add a -with-rtsopts link-time flag

You can now link with
    -with-rtsopts="-H128m -K1m"

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 2bdf982..0ca76a2 100644 (file)
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1429,6 +1429,14 @@ linkBinary dflags o_files dep_packages = do
                                      "const rtsBool rtsOptsEnabled = rtsTrue;"]
                              return [fn]
                      else return []
+    rtsOptsObj <- case rtsOpts dflags of
+                  Just opts ->
+                      do fn <- mkExtraCObj dflags
+                                 -- We assume that the Haskell "show" does
+                                 -- the right thing here
+                                 ["char *ghc_rts_opts = " ++ show opts ++ ";"]
+                         return [fn]
+                  Nothing -> return []
 
     pkg_link_opts <- getPackageLinkOpts dflags dep_packages
 
@@ -1504,6 +1512,7 @@ linkBinary dflags o_files dep_packages = do
                      ++ pkg_lib_path_opts
                       ++ main_lib
                       ++ rtsEnabledObj
+                      ++ rtsOptsObj
                      ++ pkg_link_opts
 #ifdef darwin_TARGET_OS
                      ++ pkg_framework_path_opts

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index bb2d132..8ea1293 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -407,6 +407,7 @@ data DynFlags = DynFlags {
 
   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
   ghciUsagePath         :: FilePath,    -- ditto
+  rtsOpts               :: Maybe String,
 
   hpcDir                :: String,      -- ^ Path to store the .mix files
 
@@ -641,6 +642,7 @@ defaultDynFlags =
         frameworkPaths          = [],
         cmdlineFrameworks       = [],
         tmpDir                  = cDEFAULT_TMPDIR,
+        rtsOpts                 = Nothing,
 
         hpcDir                  = ".hpc",
 
@@ -1110,6 +1112,7 @@ dynamic_flags = [
         ------- Miscellaneous ----------------------------------------------
   , 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 "main-is"        (SepArg setMainIs ) Supported
@@ -2013,6 +2016,12 @@ setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
   -- seem necessary now --SDM 7/2/2008
 
 -----------------------------------------------------------------------------
+-- RTS opts
+
+setRtsOpts :: String -> DynP ()
+setRtsOpts arg  = upd $ \ d -> d {rtsOpts = Just arg}
+
+-----------------------------------------------------------------------------
 -- Hpc stuff
 
 setOptHpcDir :: String -> DynP ()