{-# 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


-- See [hsc and CPP workaround]









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

-- Use Int based containers for pointers (addresses) for better performance.
-- These will be queried a lot!
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 52 "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 62 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
        ccs_cc_ptr <- ((\Ptr costCentreStack
hsc_ptr -> Ptr costCentreStack -> Int -> IO (Ptr (ZonkAny 4))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 4))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
8)) ptr
{-# LINE 63 "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 (ZonkAny 5))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 5))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
16)) ptr
{-# LINE 65 "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 (ZonkAny 6))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 6))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
24)) ptr
{-# LINE 68 "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 (ZonkAny 7))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 7))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentreStack
hsc_ptr Int
32)) ptr
{-# LINE 70 "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 72 "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 73 "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 74 "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 75 "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 76 "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 77 "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 78 "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 103 "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 104 "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 106 "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 108 "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 114 "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 115 "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 116 "libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc" #-}
                    cc_link_ptr <- ((\Ptr costCentre
hsc_ptr -> Ptr costCentre -> Int -> IO (Ptr (ZonkAny 0))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 0))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr costCentre
hsc_ptr Int
56)) ptr
{-# LINE 117 "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 (ZonkAny 1))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 1))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
0)) Ptr indexTable
ptr
{-# LINE 143 "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 (ZonkAny 2))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 2))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
8)) ptr
{-# LINE 145 "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 (ZonkAny 3))
forall b. Ptr b -> Int -> IO (Ptr (ZonkAny 3))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr indexTable
hsc_ptr Int
16)) ptr
{-# LINE 147 "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 149 "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'
        }

-- | casts a @Ptr@ to an @Int@
ptrToInt :: Ptr a -> Int
ptrToInt :: forall a. Ptr a -> Int
ptrToInt (Ptr Addr#
a#) = Int# -> Int
I# (Addr# -> Int#
addr2Int# Addr#
a#)