-- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow, 2011 -- -- Generate code to initialise cost centres -- -- ----------------------------------------------------------------------------- module ProfInit (profilingInitCode) where import GhcPrelude import CLabel import CostCentre import DynFlags import Outputable import Module -- ----------------------------------------------------------------------------- -- Initialising cost centres -- We must produce declarations for the cost-centres defined in this -- module; profilingInitCode :: Module -> CollectedCCs -> SDoc profilingInitCode this_mod (local_CCs, singleton_CCSs) = sdocWithDynFlags $ \dflags -> if not (gopt Opt_SccProfilingOn dflags) then empty else vcat $ 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 emit_cc_decl cc = text "extern CostCentre" <+> cc_lbl <> text "[];" where cc_lbl = ppr (mkCCLabel cc) 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