diff --git a/Trace/Hpc/Reflect.hsc b/Trace/Hpc/Reflect.hsc index 20601a1a99a83d1aee95cf81abf11829e67cdf54..5fb2db8274682313adf1181f37498a79e784a522 100644 --- a/Trace/Hpc/Reflect.hsc +++ b/Trace/Hpc/Reflect.hsc @@ -29,6 +29,7 @@ data ModuleInfo = #if __GLASGOW_HASKELL__ >= 907 (Ptr Word64) (Ptr Word64) + (Ptr Word64) #endif moduleInfoList :: Ptr () -> IO [ModuleInfo] @@ -41,14 +42,15 @@ moduleInfoList ptr hashNo <- (#peek HpcModuleInfo, hashNo) ptr tixArr <- (#peek HpcModuleInfo, tixArr) ptr #if __GLASGOW_HASKELL__ >= 907 - trxInfo <- (#peek HpcModuleInfo, trxInfo) ptr - trxArr <- (#peek HpcModuleInfo, trxArr) ptr + trxInfo <- (#peek HpcModuleInfo, trxInfo) ptr + trxArr <- (#peek HpcModuleInfo, trxArr) ptr + rettrxArr <- (#peek HpcModuleInfo, rettrxArr) ptr #endif next <- (#peek HpcModuleInfo, next) ptr rest <- moduleInfoList next return $ #if __GLASGOW_HASKELL__ >= 907 - ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr trxInfo trxArr : rest + ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr trxInfo trxArr rettrxArr : rest #else ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : rest @@ -58,7 +60,7 @@ clearTix :: IO () clearTix = do sequence_ [ pokeArray ptr $ take (fromIntegral count) $ repeat 0 #if __GLASGOW_HASKELL__ >= 907 - | ModuleInfo _mod count _hash ptr _info _trx <- modInfo + | ModuleInfo _mod count _hash ptr _info _trx _rtrx <- modInfo #else | ModuleInfo _mod count _hash ptr <- modInfo #endif @@ -70,8 +72,9 @@ examineTix :: IO Tix examineTix = do mods <- sequence [ do tixs <- peekArray (fromIntegral count) ptr #if __GLASGOW_HASKELL__ >= 907 - info <- peekArray (fromIntegral 2) trxInfo - trx <- peekArray (fromIntegral (info !! 1)) trxArr + info <- peekArray (fromIntegral 3) trxInfo + trx <- peekArray (fromIntegral (info !! 2)) trxArr + rettrx <- peekArray (fromIntegral (info !! 2)) rettrxArr #endif return $ TixModule mod' hash @@ -80,7 +83,8 @@ examineTix = do #if __GLASGOW_HASKELL__ >= 907 (map fromIntegral info) (map fromIntegral trx) - | (ModuleInfo mod' count hash ptr trxInfo trxArr) <- modInfo + (map fromIntegral rettrx) + | (ModuleInfo mod' count hash ptr trxInfo trxArr rettrxArr) <- modInfo #else | (ModuleInfo mod' count hash ptr) <- modInfo #endif @@ -95,8 +99,8 @@ updateTix (Tix modTixes) | otherwise = do sequence_ [ pokeArray ptr $ map fromIntegral tixs #if __GLASGOW_HASKELL__ >= 907 - | (ModuleInfo mod1 count1 hash1 ptr info1 trx1, - TixModule mod2 hash2 count2 tixs info2 trx2) <- zip modInfo modTixes + | (ModuleInfo mod1 count1 hash1 ptr info1 trx1 rtrx1, + TixModule mod2 hash2 count2 tixs info2 trx2 rtrx2) <- zip modInfo modTixes #else | (ModuleInfo mod1 count1 hash1 ptr, TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes diff --git a/Trace/Hpc/Tix.hs b/Trace/Hpc/Tix.hs index 79df547906f112ff23af3530d760677c94dca470..b10f59227c9d78006cd429497f479ba7387087c9 100644 --- a/Trace/Hpc/Tix.hs +++ b/Trace/Hpc/Tix.hs @@ -8,7 +8,7 @@ module Trace.Hpc.Tix(Tix(..), TixModule(..), tixModuleName, tixModuleHash, tixModuleTixs, #if __GLASGOW_HASKELL__ >= 907 - tixModuleTraceInfo, tixModuleTrace, + tixModuleTraceInfo, tixModuleTrace, tixModuleRetTrace, #endif readTix, writeTix, getTixFileName) where @@ -36,6 +36,7 @@ data TixModule = TixModule #if __GLASGOW_HASKELL__ >= 907 [Integer] -- current trace posistion [Integer] -- traces + [Integer] -- rettraces #endif deriving (Read, Show, Eq) @@ -49,13 +50,14 @@ tixModuleName :: TixModule -> String tixModuleHash :: TixModule -> Hash tixModuleTixs :: TixModule -> [Integer] #if __GLASGOW_HASKELL__ >= 907 -tixModuleName (TixModule nm _ _ _ _ _) = nm -tixModuleHash (TixModule _ h _ _ _ _) = h -tixModuleTixs (TixModule _ _ _ tixs _ _) = tixs +tixModuleName (TixModule nm _ _ _ _ _ _) = nm +tixModuleHash (TixModule _ h _ _ _ _ _) = h +tixModuleTixs (TixModule _ _ _ tixs _ _ _) = tixs tixModuleTraceInfo :: TixModule -> [Integer] tixModuleTrace :: TixModule -> [Integer] -tixModuleTraceInfo (TixModule _ _ _ _ info _) = info -tixModuleTrace (TixModule _ _ _ _ _ trace) = trace +tixModuleTraceInfo (TixModule _ _ _ _ info _ _) = info +tixModuleTrace (TixModule _ _ _ _ _ trace _) = trace +tixModuleRetTrace (TixModule _ _ _ _ _ _ ret) = ret #else tixModuleName (TixModule nm _ _ _ ) = nm tixModuleHash (TixModule _ h _ _ ) = h