diff options
Diffstat (limited to 'compiler/codeGen/CgHpc.hs')
| -rw-r--r-- | compiler/codeGen/CgHpc.hs | 32 |
1 files changed, 29 insertions, 3 deletions
diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index 9620973d10..82ea54a844 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 @@ -31,8 +33,25 @@ cgTickBox mod n = do [ CmmLoad tick_box I64 , CmmLit (CmmInt 1 I64) ]) - ] + ] + let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ mod + whenC (opt_Hpc_Tracer) $ do + emitForeignCall' + PlayRisky -- ?? + [] + (CmmForeignCall + (CmmLit $ CmmLabel $ mkForeignLabel visible_tick Nothing False) + CCallConv + ) + [ (CmmMachOp (MO_Add I32) + [ CmmLoad ext_tick_box I32 + , CmmLit (CmmInt (fromIntegral n) I32) + ] + , NoHint) ] + (Just []) + where + visible_tick = mkFastString "hs_hpc_tick" hpcTable :: Module -> HpcInfo -> Code hpcTable this_mod hpc_tickCount = do @@ -42,6 +61,10 @@ hpcTable this_mod hpc_tickCount = do (module_name_str) ++ [0] ] + emitData Data + [ CmmDataLabel (mkHpcModuleOffsetLabel this_mod) + , CmmStaticLit (CmmInt 0 I32) + ] emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod) ] ++ [ CmmStaticLit (CmmInt 0 I64) @@ -53,9 +76,10 @@ hpcTable this_mod hpc_tickCount = do initHpc :: Module -> HpcInfo -> Code initHpc this_mod tickCount - = do { emitForeignCall' + = do { id <- newTemp wordRep + ; emitForeignCall' PlayRisky - [] + [(id,NoHint)] (CmmForeignCall (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False) CCallConv @@ -65,6 +89,8 @@ initHpc this_mod tickCount , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint) ] (Just []) + ; let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ this_mod + ; stmtsC [ CmmStore ext_tick_box (CmmReg id) ] } where mod_alloc = mkFastString "hs_hpc_module" |