diff options
| -rw-r--r-- | compiler/profiling/ProfInit.hs | 46 | ||||
| -rw-r--r-- | includes/Rts.h | 1 | ||||
| -rw-r--r-- | includes/rts/Profiling.h | 17 | ||||
| -rw-r--r-- | rts/Profiling.c | 19 |
4 files changed, 68 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 diff --git a/includes/Rts.h b/includes/Rts.h index a59a8ca432..dd81033603 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -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 index 0000000000..f1dafb78f5 --- /dev/null +++ b/includes/rts/Profiling.h @@ -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); diff --git a/rts/Profiling.c b/rts/Profiling.c index 9523572887..803f86befc 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -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. |