From: Simon Marlow <simonmar@microsoft.com>
Date: Fri, 9 Feb 2007 14:08:18 +0000 (+0000)
Subject: Ticky is an RTS-only way; also fix collateral damage to other ways
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5bf1b7f5742ba6405239692f329e8be35491b350

Ticky is an RTS-only way; also fix collateral damage to other ways
The ticky static flag was being poked too early, which lead to
breakage in the -prof way amongst other things.  I've installed some
sanity checking to make sure we catch this earlier if it happens again.
---

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 53957e7..be70daa 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -79,7 +79,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
@@ -106,6 +106,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
@@ -205,7 +208,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"]
@@ -489,8 +497,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 +512,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
@@ -551,7 +552,7 @@ way_details =
 	, "-DPROFILING"
 	, "-optc-DPROFILING" ]),
 
-    (WayTicky, Way  "t" False "Ticky-ticky Profiling"  
+    (WayTicky, Way  "t" True "Ticky-ticky Profiling"  
 	[ "-fticky-ticky"
 	, "-DTICKY_TICKY"
 	, "-optc-DTICKY_TICKY" ]),