Speed up compilation of profiling stubs
authorBen Gamari <bgamari.foss@gmail.com>
Wed, 16 Aug 2017 23:01:05 +0000 (19:01 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 16 Aug 2017 23:02:28 +0000 (19:02 -0400)
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

compiler/profiling/ProfInit.hs
includes/Rts.h
includes/rts/Profiling.h [new file with mode: 0644]
rts/Profiling.c

index 9add61e..0de8069 100644 (file)
@@ -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
index a59a8ca..dd81033 100644 (file)
@@ -202,6 +202,7 @@ void _assertFail(const char *filename, unsigned int linenum)
 #include "rts/Utils.h"
 #include "rts/PrimFloat.h"
 #include "rts/Main.h"
+#include "rts/Profiling.h"
 #include "rts/StaticPtrTable.h"
 #include "rts/Libdw.h"
 #include "rts/LibdwPool.h"
diff --git a/includes/rts/Profiling.h b/includes/rts/Profiling.h
new file mode 100644 (file)
index 0000000..f1dafb7
--- /dev/null
@@ -0,0 +1,17 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2017-2018
+ *
+ * Cost-centre profiling API
+ *
+ * Do not #include this file directly: #include "Rts.h" instead.
+ *
+ * To understand the structure of the RTS headers, see the wiki:
+ *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes
+ *
+ * -------------------------------------------------------------------------- */
+
+#pragma once
+
+void registerCcList(CostCentre **cc_list);
+void registerCcsList(CostCentreStack **cc_list);
index 9523572..803f86b 100644 (file)
@@ -307,6 +307,25 @@ endProfiling ( void )
     }
 }
 
+
+/*
+  These are used in the C stubs produced by the code generator
+  to register code.
+ */
+void registerCcList(CostCentre **cc_list)
+{
+    for (CostCentre **i = cc_list; *i != NULL; i++) {
+        REGISTER_CC(*i);
+    }
+}
+
+void registerCcsList(CostCentreStack **cc_list)
+{
+    for (CostCentreStack **i = cc_list; *i != NULL; i++) {
+        REGISTER_CCS(*i);
+    }
+}
+
 /* -----------------------------------------------------------------------------
    Set CCCS when entering a function.