diff options
Diffstat (limited to 'compiler/GHC/StgToCmm/Prof.hs')
| -rw-r--r-- | compiler/GHC/StgToCmm/Prof.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs index 473e240a54..451d38ec4c 100644 --- a/compiler/GHC/StgToCmm/Prof.hs +++ b/compiler/GHC/StgToCmm/Prof.hs @@ -10,6 +10,9 @@ module GHC.StgToCmm.Prof ( initCostCentres, ccType, ccsType, mkCCostCentre, mkCCostCentreStack, + -- infoTablePRov + initInfoTableProv, emitInfoTableProv, + -- Cost-centre Profiling dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf, enterCostCentreThunk, enterCostCentreFun, @@ -41,10 +44,13 @@ import GHC.Cmm.Utils import GHC.Cmm.CLabel import GHC.Types.CostCentre +import GHC.Types.IPE import GHC.Data.FastString import GHC.Unit.Module as Module import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Driver.CodeOutput ( ipInitCode ) + import Control.Monad import Data.Char (ord) @@ -269,6 +275,53 @@ sizeof_ccs_words platform where (ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform + +initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> Module -> FCode SDoc +-- Emit the declarations +initInfoTableProv infos itmap this_mod + = do + dflags <- getDynFlags + let ents = convertInfoProvMap dflags infos this_mod itmap + --pprTraceM "UsedInfo" (ppr (length infos)) + --pprTraceM "initInfoTable" (ppr (length ents)) + -- Output the actual IPE data + mapM_ emitInfoTableProv ents + -- Create the C stub which initialises the IPE_LIST + return (ipInitCode dflags this_mod ents) + +--- Info Table Prov stuff +emitInfoTableProv :: InfoProvEnt -> FCode () +emitInfoTableProv ip = do + { dflags <- getDynFlags + ; let mod = infoProvModule ip + ; let (src, label) = maybe ("", "") (\(s, l) -> (showPpr dflags s, l)) (infoTableProv ip) + ; platform <- getPlatform + -- NB. bytesFS: we want the UTF-8 bytes here (#5559) + ; label <- newByteStringCLit (bytesFS $ mkFastString label) + ; modl <- newByteStringCLit (bytesFS $ moduleNameFS + $ moduleName + $ mod) + + ; ty_string <- newByteStringCLit (bytesFS (mkFastString (infoTableType ip))) + ; loc <- newByteStringCLit $ bytesFS $ mkFastString $ src + -- XXX going via FastString to get UTF-8 encoding is silly + ; table_name <- newByteStringCLit $ bytesFS $ mkFastString $ + showPpr dflags (pprCLabel platform CStyle (infoTablePtr ip)) + + ; closure_type <- newByteStringCLit $ bytesFS $ mkFastString $ + showPpr dflags (text $ show $ infoProvEntClosureType ip) + ; let + lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer + table_name, -- char *table_name + closure_type, -- char *closure_desc -- Filled in from the InfoTable + ty_string, -- char *ty_string + label, -- char *label, + modl, -- char *module, + loc, -- char *srcloc, + zero platform -- struct _InfoProvEnt *link + ] + ; emitDataLits (mkIPELabel ip) lits + } -- --------------------------------------------------------------------------- -- Set the current cost centre stack |