turning off -fhpc in stage1 built ghc

[ghc-hetmet.git] / compiler / main / StaticFlags.hs

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 53957e7..67e8ab5 100644 (file)
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -12,9 +12,10 @@
 module StaticFlags (
        parseStaticFlags,
        staticFlags,
+        initStaticOpts,
 
        -- Ways
-       WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag,
+       WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag, isRTSWay,
 
        -- Output style options
        opt_PprUserLength,
@@ -29,7 +30,6 @@ module StaticFlags (
 
         -- Hpc opts
        opt_Hpc,
-        opt_Hpc_Tracer,
 
        -- language opts
        opt_DictsStrict,
@@ -42,7 +42,6 @@ module StaticFlags (
        opt_NoMethodSharing, 
        opt_NoStateHack,
        opt_CprOff,
-       opt_RulesOff,
        opt_SimplNoPreInlining,
        opt_SimplExcessPrecision,
        opt_MaxWorkerArgs,
@@ -79,7 +78,7 @@ import Config
 import FastString      ( FastString, mkFastString )
 import Util
 import Maybes          ( firstJust )
-import Panic           ( GhcException(..), ghcError )
+import Panic
 
 import Control.Exception ( throwDyn )
 import Data.IORef
@@ -93,6 +92,9 @@ import Data.List      ( sort, intersperse, nub )
 
 parseStaticFlags :: [String] -> IO [String]
 parseStaticFlags args = do
+  ready <- readIORef v_opt_C_ready
+  when ready $ throwDyn (ProgramError "Too late for parseStaticFlags: call it before newSession")
+
   (leftover, errs) <- processArgs static_flags args
   when (not (null errs)) $ throwDyn (UsageError (unlines errs))
 
@@ -106,6 +108,9 @@ parseStaticFlags args = do
 
   (more_leftover, errs) <- processArgs static_flags (unreg_flags ++ way_flags)
 
+    -- see sanity code in staticOpts
+  writeIORef v_opt_C_ready True
+
     -- TABLES_NEXT_TO_CODE affects the info table layout.
     -- Be careful to do this *after* all processArgs,
     -- because evaluating tablesNextToCode involves looking at the global
@@ -116,6 +121,8 @@ parseStaticFlags args = do
   when (not (null errs)) $ ghcError (UsageError (unlines errs))
   return (cg_flags++more_leftover++leftover)
 
+initStaticOpts :: IO ()
+initStaticOpts = writeIORef v_opt_C_ready True
 
 static_flags :: [(String, OptKind IO)]
 -- All the static flags should appear in this list.  It describes how each
@@ -205,7 +212,12 @@ lookup_str       :: String -> Maybe String
 -- holds the static opts while they're being collected, before
 -- being unsafely read by unpacked_static_opts below.
 GLOBAL_VAR(v_opt_C, defaultStaticOpts, [String])
-staticFlags = unsafePerformIO (readIORef v_opt_C)
+GLOBAL_VAR(v_opt_C_ready, False, Bool)
+staticFlags = unsafePerformIO $ do
+  ready <- readIORef v_opt_C_ready
+  if (not ready)
+        then panic "a static opt was looked at too early!"
+        else readIORef v_opt_C
 
 -- -static is the default
 defaultStaticOpts = ["-static"]
@@ -270,14 +282,14 @@ opt_AutoSccsOnAllToplevs  = lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
 opt_AutoSccsOnExportedToplevs  = lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
 opt_AutoSccsOnIndividualCafs   = lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
 opt_SccProfilingOn             = lookUp  FSLIT("-fscc-profiling")
-opt_DoTickyProfiling           = lookUp  FSLIT("-fticky-ticky")
-
-
--- Hpc opts
+opt_DoTickyProfiling            = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways)
 
+-- Hpc opts, only work in a stage2 build
+#if GHCI
 opt_Hpc                                = lookUp FSLIT("-fhpc")  
-                                 || opt_Hpc_Tracer 
-opt_Hpc_Tracer                 = lookUp FSLIT("-fhpc-tracer")
+#else
+opt_Hpc                                = False
+#endif
 
 -- language opts
 opt_DictsStrict                        = lookUp  FSLIT("-fdicts-strict")
@@ -289,12 +301,11 @@ opt_Flatten                       = lookUp  FSLIT("-fflatten")
 opt_NoStateHack                        = lookUp  FSLIT("-fno-state-hack")
 opt_NoMethodSharing            = lookUp  FSLIT("-fno-method-sharing")
 opt_CprOff                     = lookUp  FSLIT("-fcpr-off")
-opt_RulesOff                   = lookUp  FSLIT("-frules-off")
        -- Switch off CPR analysis in the new demand analyser
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
 opt_GranMacros                 = lookUp  FSLIT("-fgransim")
-opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
+opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
 opt_HistorySize                        = lookup_def_int "-fhistory-size" 20
 opt_OmitBlackHoling            = lookUp  FSLIT("-dno-black-holing")
 opt_RuntimeTypes               = lookUp  FSLIT("-fruntime-types")
@@ -346,7 +357,6 @@ isStaticFlag f =
        "fauto-sccs-on-exported-toplevs",
        "fauto-sccs-on-individual-cafs",
        "fscc-profiling",
-       "fticky-ticky",
        "fdicts-strict",
        "firrefutable-tuples",
        "fparallel",
@@ -363,7 +373,6 @@ isStaticFlag f =
        "static",
        "funregisterised",
        "fext-core",
-       "frules-off",
        "fcpr-off",
        "ferror-spans",
        "fPIC"
@@ -409,13 +418,8 @@ decodeSize str
 -----------------------------------------------------------------------------
 -- RTS Hooks
 
-#if __GLASGOW_HASKELL__ >= 504
 foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
 foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-#else
-foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
-foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
-#endif
 
 -----------------------------------------------------------------------------
 -- Ways
@@ -489,8 +493,8 @@ findBuildTag :: IO [String]  -- new options
 findBuildTag = do
   way_names <- readIORef v_Ways
   let ws = sort (nub way_names)
-  res <-
-    if not (allowed_combination ws)
+
+  if not (allowed_combination ws)
       then throwDyn (CmdLineError $
                    "combination not supported: "  ++
                    foldr1 (\a b -> a ++ '/':b) 
@@ -504,13 +508,6 @@ findBuildTag = do
           writeIORef v_RTS_Build_tag rts_tag
           return (concat flags)
 
-  -- krc: horrible, I know.
-  (if opt_DoTickyProfiling then do
-                  writeIORef v_RTS_Build_tag (mkBuildTag [(lkupWay WayTicky)])
-                  return (res ++ (wayOpts (lkupWay WayTicky)))
-   else
-                  return res)
-
 
 
 mkBuildTag :: [Way] -> String
@@ -521,6 +518,8 @@ lkupWay w =
        Nothing -> error "findBuildTag"
        Just details -> details
 
+isRTSWay = wayRTSOnly . lkupWay 
+
 data Way = Way {
   wayTag     :: String,
   wayRTSOnly :: Bool,
@@ -551,9 +550,8 @@ way_details =
        , "-DPROFILING"
        , "-optc-DPROFILING" ]),
 
-    (WayTicky, Way  "t" False "Ticky-ticky Profiling"  
-       [ "-fticky-ticky"
-       , "-DTICKY_TICKY"
+    (WayTicky, Way  "t" True "Ticky-ticky Profiling"  
+       [ "-DTICKY_TICKY"
        , "-optc-DTICKY_TICKY" ]),
 
     (WayUnreg, Way  "u" False "Unregisterised"