+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Code generation for coverage
import CgMonad
import CgForeignCall
import ForeignCall
+import ClosureInfo
import FastString
import HscTypes
import Char
import StaticFlags
+import PackageConfig
+
+import Data.Word
cgTickBox :: Module -> Int -> Code
cgTickBox mod n = do
, 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)
- , ( CmmReg (CmmGlobal CurrentTSO)
- , PtrHint
- )
- ]
- (Just [])
- 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)
- (module_name_str)
+ (full_name_str)
++ [0]
]
- emitData Data
- [ CmmDataLabel (mkHpcModuleOffsetLabel this_mod)
- , CmmStaticLit (CmmInt 0 I32)
- ]
emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 I64)
- | _ <- take hpc_tickCount [0..]
+ | _ <- take hpc_tickCount [0::Int ..]
]
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 { id <- newTemp wordRep
+initHpc this_mod (HpcInfo tickCount hashNo)
+ = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
; emitForeignCall'
PlayRisky
- [(id,NoHint)]
- (CmmForeignCall
+ [CmmHinted id NoHint]
+ (CmmCallee
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
CCallConv
)
- [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
- , (CmmLit $ mkIntCLit tickCount,NoHint)
- , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
+ [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) PtrHint
+ , CmmHinted (word32 tickCount) NoHint
+ , CmmHinted (word32 hashNo) NoHint
+ , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint
]
(Just [])
- ; let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ this_mod
- ; stmtsC [ CmmStore ext_tick_box (CmmReg id) ]
+ NoC_SRT -- No SRT b/c we PlayRisky
+ CmmMayReturn
}
where
+ word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) I32)
mod_alloc = mkFastString "hs_hpc_module"