diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-08-16 19:01:05 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-08-16 19:02:28 -0400 |
| commit | a8da0de27e600211f04601ac737c329d6603c700 (patch) | |
| tree | 26d759439b11dab3925d9c4723a5c76054f1dacc /compiler/profiling | |
| parent | 6e9c8eb9885f894eed7e01a074ee7d83b251b1b1 (diff) | |
| download | haskell-a8da0de27e600211f04601ac737c329d6603c700.tar.gz | |
Speed up compilation of profiling stubs
Here we encode the cost centre list as static data. This means that the
initialization stubs are small functions which should be easy for GCC to
compile, even with optimization.
Fixes #7960.
Test Plan: Test profiling
Reviewers: austin, erikd, simonmar
Reviewed By: simonmar
Subscribers: rwbarton, thomie
GHC Trac Issues: #7960
Differential Revision: https://phabricator.haskell.org/D3853
Diffstat (limited to 'compiler/profiling')
| -rw-r--r-- | compiler/profiling/ProfInit.hs | 46 |
1 files changed, 31 insertions, 15 deletions
diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs index 9add61e561..0de8069eb5 100644 --- a/compiler/profiling/ProfInit.hs +++ b/compiler/profiling/ProfInit.hs @@ -12,7 +12,6 @@ import CLabel import CostCentre import DynFlags import Outputable -import FastString import Module -- ----------------------------------------------------------------------------- @@ -27,20 +26,37 @@ profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs) if not (gopt Opt_SccProfilingOn dflags) then empty else vcat - [ text "static void prof_init_" <> ppr this_mod - <> text "(void) __attribute__((constructor));" - , text "static void prof_init_" <> ppr this_mod <> text "(void)" - , braces (vcat ( - map emitRegisterCC local_CCs ++ - map emitRegisterCCS singleton_CCSs - )) - ] + $ map emit_cc_decl local_CCs + ++ map emit_ccs_decl singleton_CCSs + ++ [emit_cc_list local_CCs] + ++ [emit_ccs_list singleton_CCSs] + ++ [ text "static void prof_init_" <> ppr this_mod + <> text "(void) __attribute__((constructor));" + , text "static void prof_init_" <> ppr this_mod <> text "(void)" + , braces (vcat + [ text "registerCcList" <> parens local_cc_list_label <> semi + , text "registerCcsList" <> parens singleton_cc_list_label <> semi + ]) + ] where - emitRegisterCC cc = - text "extern CostCentre " <> cc_lbl <> ptext (sLit "[];") $$ - text "REGISTER_CC(" <> cc_lbl <> char ')' <> semi + emit_cc_decl cc = + text "extern CostCentre" <+> cc_lbl <> text "[];" where cc_lbl = ppr (mkCCLabel cc) - emitRegisterCCS ccs = - text "extern CostCentreStack " <> ccs_lbl <> ptext (sLit "[];") $$ - text "REGISTER_CCS(" <> ccs_lbl <> char ')' <> semi + local_cc_list_label = text "local_cc_" <> ppr this_mod + emit_cc_list ccs = + text "static CostCentre *" <> local_cc_list_label <> text "[] =" + <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma + | cc <- ccs + ] ++ [text "NULL"]) + <> semi + + emit_ccs_decl ccs = + text "extern CostCentreStack" <+> ccs_lbl <> text "[];" where ccs_lbl = ppr (mkCCSLabel ccs) + singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod + emit_ccs_list ccs = + text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" + <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma + | cc <- ccs + ] ++ [text "NULL"]) + <> semi |