{-# OPTIONS_GHC -optc-DPROFILING #-}
{-# LINE 1 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MagicHash #-}
module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled(
peekStgTSOProfInfo
, peekTopCCS
) where
{-# LINE 10 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Foreign
import Foreign.C.String
import GHC.Exts
import GHC.Exts.Heap.ProfInfo.Types
import Prelude
type AddressSet = IntSet
type AddressMap = IntMap
peekStgTSOProfInfo :: (Ptr b -> IO (Maybe CostCentreStack)) -> Ptr a -> IO (Maybe StgTSOProfInfo)
peekStgTSOProfInfo :: forall b a.
(Ptr b -> IO (Maybe CostCentreStack))
-> Ptr a -> IO (Maybe StgTSOProfInfo)
peekStgTSOProfInfo Ptr b -> IO (Maybe CostCentreStack)
decodeCCS Ptr a
tsoPtr = do
cccs_ptr <- Ptr a -> Int -> IO (Ptr b)
forall b. Ptr b -> Int -> IO (Ptr b)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
tsoPtr Int
cccsOffset
cccs' <- decodeCCS cccs_ptr
return $ Just StgTSOProfInfo {
cccs = cccs'
}
peekTopCCS :: Ptr b -> IO (Maybe CostCentreStack)
peekTopCCS :: forall b. Ptr b -> IO (Maybe CostCentreStack)
peekTopCCS Ptr b
cccs_ptr = do
costCenterCacheRef <- IntMap CostCentre -> IO (IORef (IntMap CostCentre))
forall a. a -> IO (IORef a)
newIORef IntMap CostCentre
forall a. IntMap a
IntMap.empty
peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr
cccsOffset :: Int
cccsOffset :: Int
cccsOffset = (Int
128) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
24))
{-# LINE 53 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
peekCostCentreStack
:: AddressSet
-> IORef (AddressMap CostCentre)
-> Ptr costCentreStack
-> IO (Maybe CostCentreStack)
peekCostCentreStack :: forall costCentreStack.
AddressSet
-> IORef (IntMap CostCentre)
-> Ptr costCentreStack
-> IO (Maybe CostCentreStack)
peekCostCentreStack AddressSet
_ IORef (IntMap CostCentre)
_ Ptr costCentreStack
ptr | Ptr costCentreStack
ptr Ptr costCentreStack -> Ptr costCentreStack -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr costCentreStack
forall a. Ptr a
nullPtr = Maybe CostCentreStack -> IO (Maybe CostCentreStack)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CostCentreStack
forall a. Maybe a
Nothing
peekCostCentreStack AddressSet
loopBreakers IORef (IntMap CostCentre)
_ Ptr costCentreStack
ptr | Int -> AddressSet -> Bool
IntSet.member (Ptr costCentreStack -> Int
forall a. Ptr a -> Int
ptrToInt Ptr costCentreStack
ptr) AddressSet
loopBreakers = Maybe CostCentreStack -> IO (Maybe CostCentreStack)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CostCentreStack
forall a. Maybe a
Nothing
peekCostCentreStack AddressSet
loopBreakers IORef (IntMap CostCentre)
costCenterCacheRef Ptr costCentreStack
ptr = do
ccs_ccsID' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Int
forall b. Ptr b -> Int -> IO Int
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
0)) Ptr costCentreStack
ptr
{-# LINE 63 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_cc_ptr <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
8)) ptr
{-# LINE 64 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_cc' <- peekCostCentre costCenterCacheRef ccs_cc_ptr
ccs_prevStack_ptr <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
16)) ptr
{-# LINE 66 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
let loopBreakers' = (Int -> AddressSet -> AddressSet
IntSet.insert Int
ptrAsInt AddressSet
loopBreakers)
ccs_prevStack' <- peekCostCentreStack loopBreakers' costCenterCacheRef ccs_prevStack_ptr
ccs_indexTable_ptr <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
24)) ptr
{-# LINE 69 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_indexTable' <- peekIndexTable loopBreakers' costCenterCacheRef ccs_indexTable_ptr
ccs_root_ptr <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
32)) ptr
{-# LINE 71 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_root' <- peekCostCentreStack loopBreakers' costCenterCacheRef ccs_root_ptr
ccs_depth' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word
forall b. Ptr b -> Int -> IO Word
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
40)) ptr
{-# LINE 73 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_scc_count' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
48)) ptr
{-# LINE 74 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_selected' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word
forall b. Ptr b -> Int -> IO Word
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
56)) ptr
{-# LINE 75 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_time_ticks' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word
forall b. Ptr b -> Int -> IO Word
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
64)) ptr
{-# LINE 76 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_mem_alloc' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
72)) ptr
{-# LINE 77 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_inherited_alloc' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
80)) ptr
{-# LINE 78 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
ccs_inherited_ticks' <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO Word
forall b. Ptr b -> Int -> IO Word
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
88)) ptr
{-# LINE 79 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
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 :: Int
ptrAsInt = Ptr costCentreStack -> Int
forall a. Ptr a -> Int
ptrToInt Ptr costCentreStack
ptr
peekCostCentre :: IORef (AddressMap CostCentre) -> Ptr costCentre -> IO CostCentre
peekCostCentre :: forall costCentre.
IORef (IntMap CostCentre) -> Ptr costCentre -> IO CostCentre
peekCostCentre IORef (IntMap CostCentre)
costCenterCacheRef Ptr costCentre
ptr = do
costCenterCache <- IORef (IntMap CostCentre) -> IO (IntMap CostCentre)
forall a. IORef a -> IO a
readIORef IORef (IntMap CostCentre)
costCenterCacheRef
case IntMap.lookup ptrAsInt costCenterCache of
(Just CostCentre
a) -> CostCentre -> IO CostCentre
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CostCentre
a
Maybe CostCentre
Nothing -> do
cc_ccID' <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO Int
forall b. Ptr b -> Int -> IO Int
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
0)) Ptr costCentre
ptr
{-# LINE 104 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_label_ptr <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
8)) ptr
{-# LINE 105 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_label' <- peekCString cc_label_ptr
cc_module_ptr <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
16)) ptr
{-# LINE 107 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_module' <- peekCString cc_module_ptr
cc_srcloc_ptr <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
24)) ptr
{-# LINE 109 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_srcloc' <- do
if cc_srcloc_ptr == nullPtr then
return Nothing
else
fmap Just (peekCString cc_srcloc_ptr)
cc_mem_alloc' <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO Word64
forall b. Ptr b -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
32)) ptr
{-# LINE 115 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_time_ticks' <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO Word
forall b. Ptr b -> Int -> IO Word
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
40)) ptr
{-# LINE 116 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_is_caf' <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
48)) ptr
{-# LINE 117 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_link_ptr <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
56)) ptr
{-# LINE 118 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
cc_link' <- if cc_link_ptr == nullPtr then
return Nothing
else
fmap Just (peekCostCentre costCenterCacheRef cc_link_ptr)
let result = CostCentre {
cc_ccID :: Int
cc_ccID = Int
cc_ccID',
cc_label :: String
cc_label = String
cc_label',
cc_module :: String
cc_module = String
cc_module',
cc_srcloc :: Maybe String
cc_srcloc = Maybe String
cc_srcloc',
cc_mem_alloc :: Word64
cc_mem_alloc = Word64
cc_mem_alloc',
cc_time_ticks :: Word
cc_time_ticks = Word
cc_time_ticks',
cc_is_caf :: Bool
cc_is_caf = Bool
cc_is_caf',
cc_link :: Maybe CostCentre
cc_link = Maybe CostCentre
cc_link'
}
writeIORef costCenterCacheRef (IntMap.insert ptrAsInt result costCenterCache)
return result
where
ptrAsInt :: Int
ptrAsInt = Ptr costCentre -> Int
forall a. Ptr a -> Int
ptrToInt Ptr costCentre
ptr
peekIndexTable :: AddressSet -> IORef (AddressMap CostCentre) -> Ptr indexTable -> IO (Maybe IndexTable)
peekIndexTable :: forall indexTable.
AddressSet
-> IORef (IntMap CostCentre)
-> Ptr indexTable
-> IO (Maybe IndexTable)
peekIndexTable AddressSet
_ IORef (IntMap CostCentre)
_ Ptr indexTable
ptr | Ptr indexTable
ptr Ptr indexTable -> Ptr indexTable -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr indexTable
forall a. Ptr a
nullPtr = Maybe IndexTable -> IO (Maybe IndexTable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexTable
forall a. Maybe a
Nothing
peekIndexTable AddressSet
loopBreakers IORef (IntMap CostCentre)
costCenterCacheRef Ptr indexTable
ptr = do
it_cc_ptr <- ((\Ptr indexTable
hsc_ptr -> Ptr indexTable -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
0)) Ptr indexTable
ptr
{-# LINE 144 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
it_cc' <- peekCostCentre costCenterCacheRef it_cc_ptr
it_ccs_ptr <- ((\Ptr indexTable
hsc_ptr -> Ptr indexTable -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
8)) ptr
{-# LINE 146 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
it_ccs' <- peekCostCentreStack loopBreakers costCenterCacheRef it_ccs_ptr
it_next_ptr <- ((\Ptr indexTable
hsc_ptr -> Ptr indexTable -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
16)) ptr
{-# LINE 148 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
it_next' <- peekIndexTable loopBreakers costCenterCacheRef it_next_ptr
it_back_edge' <- ((\Ptr indexTable
hsc_ptr -> Ptr indexTable -> Int -> IO Bool
forall b. Ptr b -> Int -> IO Bool
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
24)) ptr
{-# LINE 150 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
return $ Just IndexTable {
it_cc = it_cc',
it_ccs = it_ccs',
it_next = it_next',
it_back_edge = it_back_edge'
}
ptrToInt :: Ptr a -> Int
ptrToInt :: forall a. Ptr a -> Int
ptrToInt (Ptr Addr#
a#) = Int# -> Int
I# (Addr# -> Int#
addr2Int# Addr#
a#)
{-# LINE 174 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}