X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHpc.hs;h=0aa011d11bfdc1062f2425d371fc18f1f530969c;hb=61c73ae30a45d558815cf21272d13f2fa260519f;hp=9620973d1045f036c67d00fd45b3996981b562fd;hpb=dd8c1ab22f0bf0eaa9028f1621ceac02aea96205;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index 9620973..0aa011d 100644 --- a/compiler/codeGen/CgHpc.hs +++ b/compiler/codeGen/CgHpc.hs @@ -13,12 +13,15 @@ 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 cgTickBox :: Module -> Int -> Code cgTickBox mod n = do @@ -31,11 +34,12 @@ cgTickBox mod n = do [ CmmLoad tick_box I64 , CmmLit (CmmInt 1 I64) ]) - ] - + ] + where + visible_tick = mkFastString "hs_hpc_tick" 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) @@ -49,22 +53,25 @@ hpcTable this_mod hpc_tickCount = do ] where module_name_str = moduleNameString (Module.moduleName this_mod) - +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"