X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHpc.hs;h=6da243b804cf71b3173f66a933dcfe698d68b49e;hp=9620973d1045f036c67d00fd45b3996981b562fd;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=dd8c1ab22f0bf0eaa9028f1621ceac02aea96205 diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index 9620973..6da243b 100644 --- a/compiler/codeGen/CgHpc.hs +++ b/compiler/codeGen/CgHpc.hs @@ -13,12 +13,16 @@ import CLabel import Module import MachOp import CmmUtils +import CgUtils import CgMonad import CgForeignCall import ForeignCall +import ClosureInfo import FastString import HscTypes import Char +import StaticFlags +import PackageConfig cgTickBox :: Module -> Int -> Code cgTickBox mod n = do @@ -31,15 +35,14 @@ cgTickBox mod n = do [ CmmLoad tick_box I64 , CmmLit (CmmInt 1 I64) ]) - ] - + ] hpcTable :: Module -> HpcInfo -> Code -hpcTable this_mod hpc_tickCount = do +hpcTable this_mod (HpcInfo hpc_tickCount _) = do emitData ReadOnlyData [ CmmDataLabel mkHpcModuleNameLabel , CmmString $ map (fromIntegral . ord) - (module_name_str) + (full_name_str) ++ [0] ] emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod) @@ -49,22 +52,30 @@ hpcTable this_mod hpc_tickCount = do ] where module_name_str = moduleNameString (Module.moduleName this_mod) + full_name_str = if modulePackageId this_mod == mainPackageId + then module_name_str + else packageIdString (modulePackageId this_mod) ++ "/" ++ + module_name_str +hpcTable this_mod (NoHpcInfo {}) = error "TODO: impossible" initHpc :: Module -> HpcInfo -> Code -initHpc this_mod tickCount - = do { emitForeignCall' +initHpc this_mod (HpcInfo tickCount hashNo) + = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW + ; emitForeignCall' PlayRisky - [] + [(id,NoHint)] (CmmForeignCall (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False) CCallConv ) [ (mkLblExpr mkHpcModuleNameLabel,PtrHint) , (CmmLit $ mkIntCLit tickCount,NoHint) + , (CmmLit $ mkIntCLit hashNo,NoHint) , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint) ] (Just []) + NoC_SRT -- No SRT b/c we PlayRisky } where mod_alloc = mkFastString "hs_hpc_module"