X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHpc.hs;h=0d0fdb1183f2e06d0024b2a451238c3a0e016e90;hb=6084fb5517da34f65034370a3695e2af3b85ce2b;hp=f44289d1db0a6ca5eb2f0683089ac9e2175f83db;hpb=982c1f494de8a691294a95aee108e765c3f592a0;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index f44289d..0d0fdb1 100644 --- a/compiler/codeGen/CgHpc.hs +++ b/compiler/codeGen/CgHpc.hs @@ -31,6 +31,8 @@ import Char import StaticFlags import PackageConfig +import Data.Word + cgTickBox :: Module -> Int -> Code cgTickBox mod n = do let tick_box = (cmmIndex I64 @@ -71,20 +73,21 @@ initHpc this_mod (HpcInfo tickCount hashNo) = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW ; emitForeignCall' PlayRisky - [(id,NoHint)] + [CmmKinded id NoHint] (CmmCallee (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) + [ CmmKinded (mkLblExpr mkHpcModuleNameLabel) PtrHint + , CmmKinded (word32 tickCount) NoHint + , CmmKinded (word32 hashNo) NoHint + , CmmKinded (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint ] (Just []) 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"