X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHpc.hs;h=f70d159739b890b8c9910980920ed4dceff7851d;hb=bb5c3f58b1da850b68e0745766f2786e538b5fbf;hp=53d81c91fa1b6aeb7a0129dadda39ed418536321;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index 53d81c9..f70d159 100644 --- a/compiler/codeGen/CgHpc.hs +++ b/compiler/codeGen/CgHpc.hs @@ -13,12 +13,14 @@ import CLabel import Module import MachOp import CmmUtils +import CgUtils import CgMonad import CgForeignCall import ForeignCall import FastString import HscTypes import Char +import StaticFlags cgTickBox :: Module -> Int -> Code cgTickBox mod n = do @@ -29,13 +31,14 @@ cgTickBox mod n = do stmtsC [ CmmStore tick_box (CmmMachOp (MO_Add I64) [ CmmLoad tick_box I64 - , CmmLit (mkIntCLit 1) + , 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,19 +52,21 @@ 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 <- newTemp wordRep + ; 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 [])