diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgHpc.hs | 32 | ||||
| -rw-r--r-- | compiler/codeGen/CodeGen.lhs | 6 |
2 files changed, 32 insertions, 6 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" diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs index 3b7fc0abe2..4302e84f56 100644 --- a/compiler/codeGen/CodeGen.lhs +++ b/compiler/codeGen/CodeGen.lhs @@ -152,7 +152,7 @@ mkModuleInit dflags way cost_centre_info this_mod main_mod foreign_stubs importe emitData Data [CmmDataLabel moduleRegdLabel, CmmStaticLit zeroCLit] - ; whenC (dopt Opt_Hpc dflags) $ + ; whenC (opt_Hpc) $ hpcTable this_mod hpc_info -- we emit a recursive descent module search for all modules @@ -210,7 +210,7 @@ mkModuleInit dflags way cost_centre_info this_mod main_mod foreign_stubs importe ; whenC (opt_SccProfilingOn) $ do initCostCentres cost_centre_info - ; whenC (dopt Opt_Hpc dflags) $ + ; whenC (opt_Hpc) $ initHpc this_mod hpc_info ; mapCs (registerModuleImport this_pkg way) @@ -224,7 +224,7 @@ mkModuleInit dflags way cost_centre_info this_mod main_mod foreign_stubs importe , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ] - rec_descent_init = if opt_SccProfilingOn || dopt Opt_Hpc dflags + rec_descent_init = if opt_SccProfilingOn || opt_Hpc then jump_to_init else ret_code |