-- -----------------------------------------------------------------------------
--
-- (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 :: Module -> CollectedCCs -> SDoc
profilingInitCode this_mod :: Module
this_mod (local_CCs :: [CostCentre]
local_CCs, singleton_CCSs :: [CostCentreStack]
singleton_CCSs)
 = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
   if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SccProfilingOn DynFlags
dflags)
   then SDoc
empty
   else [SDoc] -> SDoc
vcat
    ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$  (CostCentre -> SDoc) -> [CostCentre] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CostCentre -> SDoc
emit_cc_decl [CostCentre]
local_CCs
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ (CostCentreStack -> SDoc) -> [CostCentreStack] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CostCentreStack -> SDoc
emit_ccs_decl [CostCentreStack]
singleton_CCSs
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [[CostCentre] -> SDoc
emit_cc_list [CostCentre]
local_CCs]
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [[CostCentreStack] -> SDoc
emit_ccs_list [CostCentreStack]
singleton_CCSs]
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [ String -> SDoc
text "static void prof_init_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
            SDoc -> SDoc -> SDoc
<> String -> SDoc
text "(void) __attribute__((constructor));"
       , String -> SDoc
text "static void prof_init_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod SDoc -> SDoc -> SDoc
<> String -> SDoc
text "(void)"
       , SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat
                 [ String -> SDoc
text "registerCcList" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens SDoc
local_cc_list_label SDoc -> SDoc -> SDoc
<> SDoc
semi
                 , String -> SDoc
text "registerCcsList" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens SDoc
singleton_cc_list_label SDoc -> SDoc -> SDoc
<> SDoc
semi
                 ])
       ]
 where
   emit_cc_decl :: CostCentre -> SDoc
emit_cc_decl cc :: CostCentre
cc =
       String -> SDoc
text "extern CostCentre" SDoc -> SDoc -> SDoc
<+> SDoc
cc_lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text "[];"
     where cc_lbl :: SDoc
cc_lbl = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentre -> CLabel
mkCCLabel CostCentre
cc)
   local_cc_list_label :: SDoc
local_cc_list_label = String -> SDoc
text "local_cc_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
   emit_cc_list :: [CostCentre] -> SDoc
emit_cc_list ccs :: [CostCentre]
ccs =
      String -> SDoc
text "static CostCentre *" SDoc -> SDoc -> SDoc
<> SDoc
local_cc_list_label SDoc -> SDoc -> SDoc
<> String -> SDoc
text "[] ="
      SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentre -> CLabel
mkCCLabel CostCentre
cc) SDoc -> SDoc -> SDoc
<> SDoc
comma
                         | CostCentre
cc <- [CostCentre]
ccs
                         ] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [String -> SDoc
text "NULL"])
      SDoc -> SDoc -> SDoc
<> SDoc
semi

   emit_ccs_decl :: CostCentreStack -> SDoc
emit_ccs_decl ccs :: CostCentreStack
ccs =
       String -> SDoc
text "extern CostCentreStack" SDoc -> SDoc -> SDoc
<+> SDoc
ccs_lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text "[];"
     where ccs_lbl :: SDoc
ccs_lbl = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
ccs)
   singleton_cc_list_label :: SDoc
singleton_cc_list_label = String -> SDoc
text "singleton_cc_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
   emit_ccs_list :: [CostCentreStack] -> SDoc
emit_ccs_list ccs :: [CostCentreStack]
ccs =
      String -> SDoc
text "static CostCentreStack *" SDoc -> SDoc -> SDoc
<> SDoc
singleton_cc_list_label SDoc -> SDoc -> SDoc
<> String -> SDoc
text "[] ="
      SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
cc) SDoc -> SDoc -> SDoc
<> SDoc
comma
                         | CostCentreStack
cc <- [CostCentreStack]
ccs
                         ] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [String -> SDoc
text "NULL"])
      SDoc -> SDoc -> SDoc
<> SDoc
semi