diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/deSugar/Desugar.lhs | 12 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 37 | ||||
-rw-r--r-- | compiler/main/StaticFlagParser.hs | 19 | ||||
-rw-r--r-- | compiler/main/StaticFlags.hs | 9 | ||||
-rw-r--r-- | compiler/profiling/SCCfinal.lhs | 11 | ||||
-rw-r--r-- | compiler/simplStg/SimplStg.lhs | 2 |
6 files changed, 51 insertions, 39 deletions
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index 8387146f17..18f177ab2e 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -77,7 +77,7 @@ deSugar hsc_env -- Desugar the program ; let export_set = availsToNameSet exports - ; let auto_scc = mkAutoScc mod export_set + ; let auto_scc = mkAutoScc dflags mod export_set ; let target = hscTarget dflags ; let hpcInfo = emptyHpcInfo other_hpc_info ; (msgs, mb_res) @@ -150,16 +150,18 @@ deSugar hsc_env ; return (msgs, Just mod_guts) }}} -mkAutoScc :: Module -> NameSet -> AutoScc -mkAutoScc mod exports +mkAutoScc :: DynFlags -> Module -> NameSet -> AutoScc +mkAutoScc dflags mod exports | not opt_SccProfilingOn -- No profiling = NoSccs - | opt_AutoSccsOnAllToplevs -- Add auto-scc on all top-level things + -- Add auto-scc on all top-level things + | dopt Opt_AutoSccsOnAllToplevs dflags = AddSccs mod (\id -> not $ isDerivedOccName $ getOccName id) -- See #1641. This is pretty yucky, but I can't see a better way -- to identify compiler-generated Ids, and at least this should -- catch them all. - | opt_AutoSccsOnExportedToplevs -- Only on exported things + -- Only on exported things + | dopt Opt_AutoSccsOnExportedToplevs dflags = AddSccs mod (\id -> idName id `elemNameSet` exports) | otherwise = NoSccs diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index a4a338c3b4..1e405ea414 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -268,6 +268,11 @@ data DynFlag | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation + -- profiling opts + | Opt_AutoSccsOnAllToplevs + | Opt_AutoSccsOnExportedToplevs + | Opt_AutoSccsOnIndividualCafs + -- misc opts | Opt_Cpp | Opt_Pp @@ -1484,6 +1489,38 @@ dynamic_flags = [ (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) Supported + ------ Profiling ---------------------------------------------------- + + -- XXX Should the -f* flags be deprecated? + -- They don't seem to be documented + , Flag "fauto-sccs-on-all-toplevs" + (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "auto-all" + (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "no-auto-all" + (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs)) + Supported + , Flag "fauto-sccs-on-exported-toplevs" + (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "auto" + (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "no-auto" + (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs)) + Supported + , Flag "fauto-sccs-on-individual-cafs" + (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + , Flag "caf-all" + (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + , Flag "no-caf-all" + (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs)) + Supported + ------ DPH flags ---------------------------------------------------- , Flag "fdph-seq" diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs index a611156054..7ed4c4c25f 100644 --- a/compiler/main/StaticFlagParser.hs +++ b/compiler/main/StaticFlagParser.hs @@ -125,22 +125,6 @@ static_flags = [ , Flag "dstub-dead-values" (PassFlag addOpt) Supported -- rest of the debugging flags are dynamic - --------- Profiling -------------------------------------------------- - , Flag "auto-all" (NoArg (addOpt "-fauto-sccs-on-all-toplevs")) - Supported - , Flag "auto" (NoArg (addOpt "-fauto-sccs-on-exported-toplevs")) - Supported - , Flag "caf-all" (NoArg (addOpt "-fauto-sccs-on-individual-cafs")) - Supported - -- "ignore-sccs" doesn't work (ToDo) - - , Flag "no-auto-all" (NoArg (removeOpt "-fauto-sccs-on-all-toplevs")) - Supported - , Flag "no-auto" (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs")) - Supported - , Flag "no-caf-all" (NoArg (removeOpt "-fauto-sccs-on-individual-cafs")) - Supported - ----- Linker -------------------------------------------------------- , Flag "static" (PassFlag addOpt) Supported , Flag "dynamic" (NoArg (removeOpt "-static")) Supported @@ -165,9 +149,6 @@ static_flags = [ isStaticFlag :: String -> Bool isStaticFlag f = f `elem` [ - "fauto-sccs-on-all-toplevs", - "fauto-sccs-on-exported-toplevs", - "fauto-sccs-on-individual-cafs", "fscc-profiling", "fdicts-strict", "fspec-inline-join-points", diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 026273e7e1..93ff1a7b79 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -26,9 +26,6 @@ module StaticFlags ( opt_NoDebugOutput, -- profiling opts - opt_AutoSccsOnAllToplevs, - opt_AutoSccsOnExportedToplevs, - opt_AutoSccsOnIndividualCafs, opt_SccProfilingOn, opt_DoTickyProfiling, @@ -198,12 +195,6 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output") -- profiling opts -opt_AutoSccsOnAllToplevs :: Bool -opt_AutoSccsOnAllToplevs = lookUp (fsLit "-fauto-sccs-on-all-toplevs") -opt_AutoSccsOnExportedToplevs :: Bool -opt_AutoSccsOnExportedToplevs = lookUp (fsLit "-fauto-sccs-on-exported-toplevs") -opt_AutoSccsOnIndividualCafs :: Bool -opt_AutoSccsOnIndividualCafs = lookUp (fsLit "-fauto-sccs-on-individual-cafs") opt_SccProfilingOn :: Bool opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling") opt_DoTickyProfiling :: Bool diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index 9e8b1b4466..8c3b62574d 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -28,7 +28,6 @@ module SCCfinal ( stgMassageForProfiling ) where import StgSyn -import StaticFlags ( opt_AutoSccsOnIndividualCafs ) import CostCentre -- lots of things import Id import Name @@ -40,24 +39,26 @@ import UniqSupply ( uniqFromSupply ) import VarSet import ListSetOps ( removeDups ) import Outputable +import DynFlags \end{code} \begin{code} stgMassageForProfiling - :: PackageId + :: DynFlags + -> PackageId -> Module -- module name -> UniqSupply -- unique supply -> [StgBinding] -- input -> (CollectedCCs, [StgBinding]) -stgMassageForProfiling this_pkg mod_name us stg_binds +stgMassageForProfiling dflags this_pkg mod_name us stg_binds = let ((local_ccs, extern_ccs, cc_stacks), stg_binds2) = initMM mod_name us (do_top_bindings stg_binds) (fixed_ccs, fixed_cc_stacks) - = if opt_AutoSccsOnIndividualCafs + = if dopt Opt_AutoSccsOnIndividualCafs dflags then ([],[]) -- don't need "all CAFs" CC -- (for Prelude, we use PreludeCC) else ([all_cafs_cc], [all_cafs_ccs]) @@ -121,7 +122,7 @@ stgMassageForProfiling this_pkg mod_name us stg_binds | noCCSAttached no_cc || currentOrSubsumedCCS no_cc = do -- Top level CAF without a cost centre attached -- Attach CAF cc (collect if individual CAF ccs) - caf_ccs <- if opt_AutoSccsOnIndividualCafs + caf_ccs <- if dopt Opt_AutoSccsOnIndividualCafs dflags then let cc = mkAutoCC binder modl CafCC ccs = mkSingletonCCS cc -- careful: the binder might be :Main.main, diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs index e31415b2f5..4c240e2135 100644 --- a/compiler/simplStg/SimplStg.lhs +++ b/compiler/simplStg/SimplStg.lhs @@ -72,7 +72,7 @@ stg2stg dflags module_name binds {-# SCC "ProfMassage" #-} let (collected_CCs, binds3) - = stgMassageForProfiling this_pkg module_name us1 binds + = stgMassageForProfiling dflags this_pkg module_name us1 binds this_pkg = thisPackage dflags in end_pass us2 "ProfMassage" collected_CCs binds3 |