[Git][ghc/ghc][wip/ghc-debug] Cache only CostCentres during ProfInfo decoding
Sven Tennie
gitlab at gitlab.haskell.org
Fri Aug 14 10:00:48 UTC 2020
Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC
Commits:
607d60a8 by Sven Tennie at 2020-08-14T11:58:03+02:00
Cache only CostCentres during ProfInfo decoding
Looks like caches for CostCentreStacks and IndexTables are not needed.
- - - - -
1 changed file:
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc
=====================================
@@ -40,19 +40,14 @@ type AddressSet = IntSet
type AddressMap = IntMap
data Cache = Cache {
- ccCache :: AddressMap CostCentre,
--- TODO: Remove ccsCache? Looks like it's not needed anymore due to loop breakers
- ccsCache :: AddressMap CostCentreStack,
--- TODO: Remove indexTableCache? Looks like it's not needed anymore due to loop breakers
- indexTableCache :: AddressMap IndexTable
+ ccCache :: AddressMap CostCentre
}
type DecoderMonad a = StateT Cache IO a
peekStgTSOProfInfo :: Ptr a -> IO (Maybe StgTSOProfInfo)
peekStgTSOProfInfo tsoPtr = do
- print $ "peekStgTSOProfInfo - tsoPtr : " ++ show tsoPtr
cccs_ptr <- peekByteOff tsoPtr cccsOffset
- cccs' <- evalStateT (peekCostCentreStack IntSet.empty cccs_ptr) $ Cache IntMap.empty IntMap.empty IntMap.empty
+ cccs' <- evalStateT (peekCostCentreStack IntSet.empty cccs_ptr) $ Cache IntMap.empty
return $ Just StgTSOProfInfo {
cccs = cccs'
@@ -65,50 +60,38 @@ peekCostCentreStack :: AddressSet -> Ptr costCentreStack -> DecoderMonad (Maybe
peekCostCentreStack _ ptr | ptr == nullPtr = return Nothing
peekCostCentreStack loopBreakers ptr | IntSet.member (ptrToInt ptr) loopBreakers = return Nothing
peekCostCentreStack loopBreakers ptr = do
- cache <- get
- case IntMap.lookup ptrAsInt (ccsCache cache) of
- found@(Just _) -> do
- liftIO $ print $ "CCS Cache hit : " ++ show ptr
- return found
- Nothing -> do
- liftIO $ print $ "peekCostCentreStack - ptr : " ++ show ptr
- ccs_ccsID' <- liftIO $ (#peek struct CostCentreStack_, ccsID) ptr
- ccs_cc_ptr <- liftIO $ (#peek struct CostCentreStack_, cc) ptr
- ccs_cc' <- peekCostCentre ccs_cc_ptr
- ccs_prevStack_ptr <- liftIO $ (#peek struct CostCentreStack_, prevStack) ptr
- let loopBreakers' = (IntSet.insert ptrAsInt loopBreakers)
- ccs_prevStack' <- peekCostCentreStack loopBreakers' ccs_prevStack_ptr
- ccs_indexTable_ptr <- liftIO $ (#peek struct CostCentreStack_, indexTable) ptr
- ccs_indexTable' <- peekIndexTable loopBreakers' ccs_indexTable_ptr
- ccs_root_ptr <- liftIO $ (#peek struct CostCentreStack_, root) ptr
- ccs_root' <- peekCostCentreStack loopBreakers' ccs_root_ptr
- ccs_depth' <- liftIO $ (#peek struct CostCentreStack_, depth) ptr
- ccs_scc_count' <- liftIO $ (#peek struct CostCentreStack_, scc_count) ptr
- ccs_selected' <- liftIO $ (#peek struct CostCentreStack_, selected) ptr
- ccs_time_ticks' <- liftIO $ (#peek struct CostCentreStack_, time_ticks) ptr
- ccs_mem_alloc' <- liftIO $ (#peek struct CostCentreStack_, mem_alloc) ptr
- ccs_inherited_alloc' <- liftIO $ (#peek struct CostCentreStack_, inherited_alloc) ptr
- ccs_inherited_ticks' <- liftIO $ (#peek struct CostCentreStack_, inherited_ticks) ptr
-
- let result = CostCentreStack {
- ccs_ccsID = ccs_ccsID',
- ccs_cc = ccs_cc',
- ccs_prevStack = ccs_prevStack',
- ccs_indexTable = ccs_indexTable',
- ccs_root = ccs_root',
- ccs_depth = ccs_depth',
- ccs_scc_count = ccs_scc_count',
- ccs_selected = ccs_selected',
- ccs_time_ticks = ccs_time_ticks',
- ccs_mem_alloc = ccs_mem_alloc',
- ccs_inherited_alloc = ccs_inherited_alloc',
- ccs_inherited_ticks = ccs_inherited_ticks'
- }
-
- let updatedCCSCache = IntMap.insert ptrAsInt result (ccsCache cache)
- put $ cache { ccsCache = updatedCCSCache }
-
- return $ Just result
+ ccs_ccsID' <- liftIO $ (#peek struct CostCentreStack_, ccsID) ptr
+ ccs_cc_ptr <- liftIO $ (#peek struct CostCentreStack_, cc) ptr
+ ccs_cc' <- peekCostCentre ccs_cc_ptr
+ ccs_prevStack_ptr <- liftIO $ (#peek struct CostCentreStack_, prevStack) ptr
+ let loopBreakers' = (IntSet.insert ptrAsInt loopBreakers)
+ ccs_prevStack' <- peekCostCentreStack loopBreakers' ccs_prevStack_ptr
+ ccs_indexTable_ptr <- liftIO $ (#peek struct CostCentreStack_, indexTable) ptr
+ ccs_indexTable' <- peekIndexTable loopBreakers' ccs_indexTable_ptr
+ ccs_root_ptr <- liftIO $ (#peek struct CostCentreStack_, root) ptr
+ ccs_root' <- peekCostCentreStack loopBreakers' ccs_root_ptr
+ ccs_depth' <- liftIO $ (#peek struct CostCentreStack_, depth) ptr
+ ccs_scc_count' <- liftIO $ (#peek struct CostCentreStack_, scc_count) ptr
+ ccs_selected' <- liftIO $ (#peek struct CostCentreStack_, selected) ptr
+ ccs_time_ticks' <- liftIO $ (#peek struct CostCentreStack_, time_ticks) ptr
+ ccs_mem_alloc' <- liftIO $ (#peek struct CostCentreStack_, mem_alloc) ptr
+ ccs_inherited_alloc' <- liftIO $ (#peek struct CostCentreStack_, inherited_alloc) ptr
+ ccs_inherited_ticks' <- liftIO $ (#peek struct CostCentreStack_, inherited_ticks) ptr
+
+ return $ Just CostCentreStack {
+ ccs_ccsID = ccs_ccsID',
+ ccs_cc = ccs_cc',
+ ccs_prevStack = ccs_prevStack',
+ ccs_indexTable = ccs_indexTable',
+ ccs_root = ccs_root',
+ ccs_depth = ccs_depth',
+ ccs_scc_count = ccs_scc_count',
+ ccs_selected = ccs_selected',
+ ccs_time_ticks = ccs_time_ticks',
+ ccs_mem_alloc = ccs_mem_alloc',
+ ccs_inherited_alloc = ccs_inherited_alloc',
+ ccs_inherited_ticks = ccs_inherited_ticks'
+ }
where
ptrAsInt = ptrToInt ptr
@@ -116,9 +99,7 @@ peekCostCentre :: Ptr costCentre -> DecoderMonad CostCentre
peekCostCentre ptr = do
cache <- get
case IntMap.lookup ptrAsInt (ccCache cache) of
- (Just a) -> do
- liftIO $ print $ "CC Cache hit : " ++ show ptr
- return a
+ (Just a) -> return a
Nothing -> do
cc_ccID' <- liftIO $ (#peek struct CostCentre_, ccID) ptr
cc_label_ptr <- liftIO $ (#peek struct CostCentre_, label) ptr
@@ -161,31 +142,20 @@ peekCostCentre ptr = do
peekIndexTable :: AddressSet -> Ptr indexTable -> DecoderMonad (Maybe IndexTable)
peekIndexTable _ ptr | ptr == nullPtr = return Nothing
peekIndexTable loopBreakers ptr = do
- cache <- get
- case IntMap.lookup ptrAsInt (indexTableCache cache) of
- found@(Just _) -> do
- liftIO $ print $ "IndexTable Cache hit : " ++ show ptr
- return found
- Nothing -> do
- it_cc_ptr <- liftIO $ (#peek struct IndexTable_, cc) ptr
- it_cc' <- peekCostCentre it_cc_ptr
- it_ccs_ptr <- liftIO $ (#peek struct IndexTable_, ccs) ptr
- it_ccs' <- peekCostCentreStack loopBreakers it_ccs_ptr
- it_next_ptr <- liftIO $ (#peek struct IndexTable_, next) ptr
- it_next' <- peekIndexTable loopBreakers it_next_ptr
- it_back_edge' <- liftIO $ (#peek struct IndexTable_, back_edge) ptr
-
- let result = IndexTable {
- it_cc = it_cc',
- it_ccs = it_ccs',
- it_next = it_next',
- it_back_edge = it_back_edge'
- }
-
- let updatedIndexTableCache = IntMap.insert ptrAsInt result (indexTableCache cache)
- put $ cache { indexTableCache = updatedIndexTableCache }
-
- return $ Just result
+ it_cc_ptr <- liftIO $ (#peek struct IndexTable_, cc) ptr
+ it_cc' <- peekCostCentre it_cc_ptr
+ it_ccs_ptr <- liftIO $ (#peek struct IndexTable_, ccs) ptr
+ it_ccs' <- peekCostCentreStack loopBreakers it_ccs_ptr
+ it_next_ptr <- liftIO $ (#peek struct IndexTable_, next) ptr
+ it_next' <- peekIndexTable loopBreakers it_next_ptr
+ it_back_edge' <- liftIO $ (#peek struct IndexTable_, back_edge) ptr
+
+ return $ Just IndexTable {
+ it_cc = it_cc',
+ it_ccs = it_ccs',
+ it_next = it_next',
+ it_back_edge = it_back_edge'
+ }
where
ptrAsInt = ptrToInt ptr
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/607d60a88f4b214ff2125819eefd7e552ac39fde
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/607d60a88f4b214ff2125819eefd7e552ac39fde
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200814/34bc8999/attachment-0001.html>
More information about the ghc-commits
mailing list