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

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