module CgHpc (cgTickBox, initHpc, hpcTable) where
-import Cmm
+import OldCmm
import CLabel
import Module
-import MachOp
-import CmmUtils
+import OldCmmUtils
+import CgUtils
import CgMonad
import CgForeignCall
import ForeignCall
+import ClosureInfo
import FastString
import HscTypes
-import Char
+import Panic
+import BasicTypes
+
+import Data.Char
+import Data.Word
cgTickBox :: Module -> Int -> Code
cgTickBox mod n = do
- let tick_box = (cmmIndex I64
+ let tick_box = (cmmIndex W64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
- (fromIntegral n)
+ n
)
stmtsC [ CmmStore tick_box
- (CmmMachOp (MO_Add I64)
- [ CmmLoad tick_box I64
- , CmmLit (mkIntCLit 1)
+ (CmmMachOp (MO_Add W64)
+ [ CmmLoad tick_box b64
+ , CmmLit (CmmInt 1 W64)
])
- ]
-
+ ]
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 (mkHpcTicksLabel this_mod)
] ++
- [ CmmStaticLit (CmmInt 0 I64)
- | _ <- take hpc_tickCount [0..]
+ [ CmmStaticLit (CmmInt 0 W64)
+ | _ <- 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 _ (NoHpcInfo {}) = error "TODO: impossible"
initHpc :: Module -> HpcInfo -> Code
-initHpc this_mod tickCount
- = do { emitForeignCall'
+initHpc this_mod (HpcInfo tickCount hashNo)
+ = do { id <- newTemp bWord
+ ; emitForeignCall'
PlayRisky
- []
- (CmmForeignCall
- (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
+ [CmmHinted id NoHint]
+ (CmmCallee
+ (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
CCallConv
)
- [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
- , (CmmLit $ mkIntCLit tickCount,NoHint)
- , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
+ [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) AddrHint
+ , CmmHinted (word32 tickCount) NoHint
+ , CmmHinted (word32 hashNo) NoHint
+ , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) AddrHint
]
(Just [])
+ NoC_SRT -- No SRT b/c we PlayRisky
+ CmmMayReturn
}
where
+ word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) W32)
mod_alloc = mkFastString "hs_hpc_module"
+initHpc _ (NoHpcInfo {}) = panic "initHpc: NoHpcInfo"