From 4b4ecff5d4fbf8d884b32f5907a2182054eadb28 Mon Sep 17 00:00:00 2001
From: Austin Seipp <austin@well-typed.com>
Date: Wed, 9 Oct 2013 06:39:10 -0500
Subject: Turn -H and -Rghc-timing into dynamic flags.

Signed-off-by: Austin Seipp <austin@well-typed.com>
---
 compiler/main/DynFlags.hs    | 38 +++++++++++++++++++++++++++++++++++++-
 compiler/main/StaticFlags.hs | 29 -----------------------------
 2 files changed, 37 insertions(+), 30 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 83d9bcae92..0dcad39200 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -600,6 +600,9 @@ data DynFlags = DynFlags {
                                         --   in --make mode, where Nothing ==> compile as
                                         --   many in parallel as there are CPUs.
 
+  enableTimeStats       :: Bool,        -- ^ Enable RTS timing statistics?
+  ghcHeapSize           :: Maybe Int,   -- ^ The heap size to set.
+
   maxRelevantBinds      :: Maybe Int,   -- ^ Maximum number of bindings from the type envt
                                         --   to show in type error messages
   simplTickFactor       :: Int,         -- ^ Multiplier for simplifier ticks
@@ -1313,6 +1316,9 @@ defaultDynFlags mySettings =
 
         parMakeCount            = Just 1,
 
+        enableTimeStats         = False,
+        ghcHeapSize             = Nothing,
+
         cmdlineHcIncludes       = [],
         importPaths             = ["."],
         mainModIs               = mAIN,
@@ -1969,6 +1975,12 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
                         let ss = map (Set.fromList . words) (lines xs)
                         return $ dflags4 { dllSplit = Just ss }
 
+  -- Set timer stats & heap size
+  when (enableTimeStats dflags5) $ liftIO enableTimingStats
+  case (ghcHeapSize dflags5) of
+    Just x -> liftIO (setHeapSize x)
+    _      -> return ()
+
   liftIO $ setUnsafeGlobalDynFlags dflags5
 
   return (dflags5, leftover, consistency_warnings ++ sh_warns ++ warns)
@@ -2080,7 +2092,13 @@ dynamic_flags = [
 
   , Flag "j"        (OptIntSuffix (\n -> upd (\d -> d {parMakeCount = n})))
 
-        ------- ways --------------------------------------------------------
+    -- RTS options -------------------------------------------------------------
+  , Flag "H"           (HasArg (\s -> upd (\d ->
+          d { ghcHeapSize = Just $ fromIntegral (decodeSize s)})))
+
+  , Flag "Rghc-timing" (NoArg (upd (\d -> d { enableTimeStats = True })))
+
+    ------- ways ---------------------------------------------------------------
   , Flag "prof"           (NoArg (addWay WayProf))
   , Flag "eventlog"       (NoArg (addWay WayEventLog))
   , Flag "parallel"       (NoArg (addWay WayPar))
@@ -3675,3 +3693,21 @@ data LinkerInfo
   | DarwinLD [Option]
   | UnknownLD
   deriving Eq
+
+-- -----------------------------------------------------------------------------
+-- RTS hooks
+
+-- Convert sizes like "3.5M" into integers
+decodeSize :: String -> Integer
+decodeSize str
+  | c == ""      = truncate n
+  | c == "K" || c == "k" = truncate (n * 1000)
+  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
+  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
+  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))
+  where (m, c) = span pred str
+        n      = readRational m
+        pred c = isDigit c || c == '.'
+
+foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
+foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 8b82f17377..c35b1273cd 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -48,7 +48,6 @@ import Util
 import Panic
 
 import Control.Monad
-import Data.Char
 import Data.IORef
 import System.IO.Unsafe ( unsafePerformIO )
 
@@ -124,11 +123,6 @@ flagsStatic = [
   , Flag "dno-debug-output" (PassFlag addOptEwM)
   -- rest of the debugging flags are dynamic
 
-  ----- RTS opts ------------------------------------------------------
-  , Flag "H"           (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
-
-  , Flag "Rghc-timing" (NoArg (liftEwM enableTimingStats))
-
   ------ Compiler flags -----------------------------------------------
   -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
   , Flag "fno-"
@@ -195,22 +189,6 @@ opt_CprOff         = lookUp  (fsLit "-fcpr-off")
 opt_NoOptCoercion  :: Bool
 opt_NoOptCoercion  = lookUp  (fsLit "-fno-opt-coercion")
 
-
------------------------------------------------------------------------------
--- Convert sizes like "3.5M" into integers
-
-decodeSize :: String -> Integer
-decodeSize str
-  | c == ""      = truncate n
-  | c == "K" || c == "k" = truncate (n * 1000)
-  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
-  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
-  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))
-  where (m, c) = span pred str
-        n      = readRational m
-        pred c = isDigit c || c == '.'
-
-
 -----------------------------------------------------------------------------
 -- Tunneling our global variables into a new instance of the GHC library
 
@@ -223,13 +201,6 @@ restoreStaticFlagGlobals (c_ready, c) = do
     writeIORef v_opt_C c
 
 
------------------------------------------------------------------------------
--- RTS Hooks
-
-foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
-foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-
-
 {-
 -- (lookup_str "foo") looks for the flag -foo=X or -fooX,
 -- and returns the string X
-- 
cgit v1.2.1