X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FStaticFlags.hs;h=30489593f1e0a10526efb1a0fa41a8679a59f833;hb=ab272eb88f58835d4ad6293813b88d2d6acc23c9;hp=53957e774485b85876c5d9aaab3d2d597f39e016;hpb=5ddee764beb312933256096d03df7c3ec47ac452;p=ghc-hetmet.git diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 53957e7..3048959 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"] @@ -294,7 +302,7 @@ opt_RulesOff = lookUp FSLIT("-frules-off") 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") @@ -409,13 +417,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 +492,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 +507,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 +547,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" ]),