diff options
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Flags.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 22 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 3 |
4 files changed, 26 insertions, 4 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 5b3f614d8e..ce5a7e156d 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -327,7 +327,8 @@ outputForeignStubs_help fname doc_str header footer -- | Generate code to initialise cost centres profilingInitCode :: Platform -> Module -> CollectedCCs -> CStub profilingInitCode platform this_mod (local_CCs, singleton_CCSs) - = initializerCStub platform fn_name decls body + = {-# SCC profilingInitCode #-} + initializerCStub platform fn_name decls body where fn_name = mkInitializerStubLabel this_mod "prof_init" decls = vcat diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index a4e5827bc6..fd23d2e81e 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -96,6 +96,7 @@ data DumpFlag | Opt_D_dump_simpl_iterations | Opt_D_dump_spec | Opt_D_dump_prep + | Opt_D_dump_late_cc | Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output) | Opt_D_dump_stg_unarised -- ^ STG after unarise | Opt_D_dump_stg_cg -- ^ STG (after stg2stg) @@ -303,6 +304,7 @@ data GeneralFlag -- profiling opts | Opt_AutoSccsOnIndividualCafs | Opt_ProfCountEntries + | Opt_ProfLateInlineCcs | Opt_ProfLateCcs | Opt_ProfManualCcs -- ^ Ignore manual SCC annotations diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 2f6a3262d0..e03883702b 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -171,6 +171,8 @@ import GHC.Core.InstEnv import GHC.Core.FamInstEnv import GHC.Core.Rules import GHC.Core.Stats +import GHC.Core.LateCC (addLateCostCentresPgm) + import GHC.CoreToStg.Prep import GHC.CoreToStg ( coreToStg ) @@ -268,7 +270,6 @@ import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) - {- ********************************************************************** %* * Initialisation @@ -1692,6 +1693,21 @@ hscGenHardCode hsc_env cgguts location output_filename = do -- but we don't generate any code for newtypes ------------------- + -- Insert late cost centres if enabled. + -- If `-fprof-late-inline` is enabled we can skip this, as it will have added + -- a superset of cost centres we would add here already. + + (late_cc_binds, late_local_ccs) <- + if gopt Opt_ProfLateCcs dflags && not (gopt Opt_ProfLateInlineCcs dflags) + then {-# SCC lateCC #-} do + (binds,late_ccs) <- addLateCostCentresPgm dflags logger this_mod core_binds + return ( binds, (S.toList late_ccs `mappend` local_ccs )) + else + return (core_binds, local_ccs) + + + + ------------------- -- PREPARE FOR CODE GENERATION -- Do saturation and convert to A-normal form (prepd_binds) <- {-# SCC "CorePrep" #-} do @@ -1700,7 +1716,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do (hsc_logger hsc_env) cp_cfg (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) - this_mod location core_binds data_tycons + this_mod location late_cc_binds data_tycons ----------------- Convert to STG ------------------ (stg_binds, denv, (caf_ccs, caf_cc_stacks)) @@ -1711,7 +1727,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = - (local_ccs ++ caf_ccs, caf_cc_stacks) + (late_local_ccs ++ caf_ccs, caf_cc_stacks) platform = targetPlatform dflags prof_init | sccProfilingEnabled dflags = profilingInitCode platform this_mod cost_centre_info diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index ee032a2652..0407952c33 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -2486,6 +2486,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_spec) , make_ord_flag defGhcFlag "ddump-prep" (setDumpFlag Opt_D_dump_prep) + , make_ord_flag defGhcFlag "ddump-late-cc" + (setDumpFlag Opt_D_dump_late_cc) , make_ord_flag defGhcFlag "ddump-stg-from-core" (setDumpFlag Opt_D_dump_stg_from_core) , make_ord_flag defGhcFlag "ddump-stg-unarised" @@ -3446,6 +3448,7 @@ fFlagsDeps = [ flagSpec "prof-count-entries" Opt_ProfCountEntries, flagSpec "prof-late" Opt_ProfLateCcs, flagSpec "prof-manual" Opt_ProfManualCcs, + flagSpec "prof-late-inline" Opt_ProfLateInlineCcs, flagSpec "regs-graph" Opt_RegsGraph, flagSpec "regs-iterative" Opt_RegsIterative, depFlagSpec' "rewrite-rules" Opt_EnableRewriteRules |