Fold testsuite.git into ghc.git (re #8545)
[ghc.git] / compiler / profiling / ProfInit.hs
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow, 2011
4 --
5 -- Generate code to initialise cost centres
6 --
7 -- -----------------------------------------------------------------------------
8
9 module ProfInit (profilingInitCode) where
10
11 import CLabel
12 import CostCentre
13 import DynFlags
14 import Outputable
15 import FastString
16 import Module
17
18 -- -----------------------------------------------------------------------------
19 -- Initialising cost centres
20
21 -- We must produce declarations for the cost-centres defined in this
22 -- module;
23
24 profilingInitCode :: Module -> CollectedCCs -> SDoc
25 profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs)
26 = sdocWithDynFlags $ \dflags ->
27 if not (gopt Opt_SccProfilingOn dflags)
28 then empty
29 else vcat
30 [ text "static void prof_init_" <> ppr this_mod
31 <> text "(void) __attribute__((constructor));"
32 , text "static void prof_init_" <> ppr this_mod <> text "(void)"
33 , braces (vcat (
34 map emitRegisterCC local_CCs ++
35 map emitRegisterCCS singleton_CCSs
36 ))
37 ]
38 where
39 emitRegisterCC cc =
40 ptext (sLit "extern CostCentre ") <> cc_lbl <> ptext (sLit "[];") $$
41 ptext (sLit "REGISTER_CC(") <> cc_lbl <> char ')' <> semi
42 where cc_lbl = ppr (mkCCLabel cc)
43 emitRegisterCCS ccs =
44 ptext (sLit "extern CostCentreStack ") <> ccs_lbl <> ptext (sLit "[];") $$
45 ptext (sLit "REGISTER_CCS(") <> ccs_lbl <> char ')' <> semi
46 where ccs_lbl = ppr (mkCCSLabel ccs)