{-# OPTIONS_GHC -optc-DPROFILING #-}
{-# LINE 1 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}

module GHC.Exts.Heap.FFIClosures_ProfilingEnabled where

-- See [hsc and CPP workaround]




import Prelude
import Foreign
import GHC.Exts
import GHC.Exts.Heap.ProfInfo.PeekProfInfo
import GHC.Exts.Heap.ProfInfo.Types
import GHC.Exts.Heap.Closures(WhatNext(..), WhyBlocked(..), TsoFlags(..))

data TSOFields = TSOFields {
    TSOFields -> WhatNext
tso_what_next :: WhatNext,
    TSOFields -> WhyBlocked
tso_why_blocked :: WhyBlocked,
    TSOFields -> [TsoFlags]
tso_flags :: [TsoFlags],
-- Unfortunately block_info is a union without clear discriminator.
--    block_info :: TDB,
    TSOFields -> Word64
tso_threadId :: Word64,
    TSOFields -> Word32
tso_saved_errno :: Word32,
    TSOFields -> Word32
tso_dirty:: Word32,
    TSOFields -> Int64
tso_alloc_limit :: Int64,
    TSOFields -> Word32
tso_tot_stack_size :: Word32,
    TSOFields -> Maybe StgTSOProfInfo
tso_prof :: Maybe StgTSOProfInfo
}

-- | Get non-pointer fields from @StgTSO_@ (@TSO.h@)
peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields
peekTSOFields :: forall a tsoPtr.
(Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields
peekTSOFields Ptr a -> IO (Maybe CostCentreStack)
decodeCCS Ptr tsoPtr
ptr = do
    Word16
what_next' <- ((\Ptr tsoPtr
hsc_ptr -> Ptr tsoPtr -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr tsoPtr
hsc_ptr Int
48)) Ptr tsoPtr
ptr
{-# LINE 36 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    why_blocked' <- ((\hsc_ptr -> peekByteOff hsc_ptr 50)) ptr
{-# LINE 37 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    flags' <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) ptr
{-# LINE 38 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    threadId' <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
{-# LINE 39 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    saved_errno' <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) ptr
{-# LINE 40 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    dirty' <- ((\hsc_ptr -> peekByteOff hsc_ptr 76)) ptr
{-# LINE 41 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    alloc_limit' <- ((\hsc_ptr -> peekByteOff hsc_ptr 120)) ptr
{-# LINE 42 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    tot_stack_size' <- ((\hsc_ptr -> peekByteOff hsc_ptr 128)) ptr
{-# LINE 43 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    tso_prof' <- peekStgTSOProfInfo decodeCCS ptr

    TSOFields -> IO TSOFields
forall (m :: * -> *) a. Monad m => a -> m a
return TSOFields {
        tso_what_next :: WhatNext
tso_what_next = Word16 -> WhatNext
parseWhatNext Word16
what_next',
        tso_why_blocked :: WhyBlocked
tso_why_blocked = Word16 -> WhyBlocked
parseWhyBlocked Word16
why_blocked',
        tso_flags :: [TsoFlags]
tso_flags = Word32 -> [TsoFlags]
parseTsoFlags Word32
flags',
        tso_threadId :: Word64
tso_threadId = Word64
threadId',
        tso_saved_errno :: Word32
tso_saved_errno = Word32
saved_errno',
        tso_dirty :: Word32
tso_dirty = Word32
dirty',
        tso_alloc_limit :: Int64
tso_alloc_limit = Int64
alloc_limit',
        tso_tot_stack_size :: Word32
tso_tot_stack_size = Word32
tot_stack_size',
        tso_prof :: Maybe StgTSOProfInfo
tso_prof = Maybe StgTSOProfInfo
tso_prof'
    }

parseWhatNext :: Word16 -> WhatNext
parseWhatNext :: Word16 -> WhatNext
parseWhatNext Word16
w = case Word16
w of
                    (Word16
1) -> WhatNext
ThreadRunGHC
{-# LINE 60 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                    (Word16
2) -> WhatNext
ThreadInterpret
{-# LINE 61 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                    (Word16
3) -> WhatNext
ThreadKilled
{-# LINE 62 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                    (Word16
4) -> WhatNext
ThreadComplete
{-# LINE 63 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                    Word16
_ -> Word16 -> WhatNext
WhatNextUnknownValue Word16
w

parseWhyBlocked :: Word16 -> WhyBlocked
parseWhyBlocked :: Word16 -> WhyBlocked
parseWhyBlocked Word16
w = case Word16
w of
                        (Word16
0) -> WhyBlocked
NotBlocked
{-# LINE 68 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
1) -> WhyBlocked
BlockedOnMVar
{-# LINE 69 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
14) -> WhyBlocked
BlockedOnMVarRead
{-# LINE 70 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
2) -> WhyBlocked
BlockedOnBlackHole
{-# LINE 71 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
3) -> WhyBlocked
BlockedOnRead
{-# LINE 72 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
4) -> WhyBlocked
BlockedOnWrite
{-# LINE 73 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
5) -> WhyBlocked
BlockedOnDelay
{-# LINE 74 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
6) -> WhyBlocked
BlockedOnSTM
{-# LINE 75 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
7) -> WhyBlocked
BlockedOnDoProc
{-# LINE 76 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
10) -> WhyBlocked
BlockedOnCCall
{-# LINE 77 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
11) -> WhyBlocked
BlockedOnCCall_Interruptible
{-# LINE 78 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
12) -> WhyBlocked
BlockedOnMsgThrowTo
{-# LINE 79 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        (Word16
13) -> WhyBlocked
ThreadMigrating
{-# LINE 80 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}

{-# LINE 83 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                        Word16
_ -> Word16 -> WhyBlocked
WhyBlockedUnknownValue Word16
w

parseTsoFlags :: Word32 -> [TsoFlags]
parseTsoFlags :: Word32 -> [TsoFlags]
parseTsoFlags Word32
w | Word32 -> Word32 -> Bool
isSet (Word32
2) Word32
w = TsoFlags
TsoLocked TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
2) Word32
w)
{-# LINE 87 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                | Word32 -> Word32 -> Bool
isSet (Word32
4) Word32
w = TsoFlags
TsoBlockx TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
4) Word32
w)
{-# LINE 88 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                | Word32 -> Word32 -> Bool
isSet (Word32
8) Word32
w = TsoFlags
TsoInterruptible TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
8) Word32
w)
{-# LINE 89 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                | Word32 -> Word32 -> Bool
isSet (Word32
16) Word32
w = TsoFlags
TsoStoppedOnBreakpoint TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
16) Word32
w)
{-# LINE 90 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                | Word32 -> Word32 -> Bool
isSet (Word32
64) Word32
w = TsoFlags
TsoMarked TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
64) Word32
w)
{-# LINE 91 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                | Word32 -> Word32 -> Bool
isSet (Word32
128) Word32
w = TsoFlags
TsoSqueezed TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
128) Word32
w)
{-# LINE 92 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
                | Word32 -> Word32 -> Bool
isSet (Word32
256) Word32
w = TsoFlags
TsoAllocLimit TsoFlags -> [TsoFlags] -> [TsoFlags]
forall a. a -> [a] -> [a]
: Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> Word32 -> Word32
unset (Word32
256) Word32
w)
{-# LINE 93 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
parseTsoFlags 0 = []
parseTsoFlags Word32
w = [Word32 -> TsoFlags
TsoFlagsUnknownValue Word32
w]

isSet :: Word32 -> Word32 -> Bool
isSet :: Word32 -> Word32 -> Bool
isSet Word32
bitMask Word32
w = Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
bitMask Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0

unset :: Word32 -> Word32 -> Word32
unset :: Word32 -> Word32 -> Word32
unset Word32
bitMask Word32
w = Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
bitMask

data StackFields = StackFields {
    StackFields -> Word32
stack_size :: Word32,
    StackFields -> Word8
stack_dirty :: Word8,

{-# LINE 106 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    stack_marking :: Word8,

{-# LINE 108 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    stack_sp :: Addr#
}

-- | Get non-closure fields from @StgStack_@ (@TSO.h@)
peekStackFields :: Ptr a -> IO StackFields
peekStackFields :: forall a. Ptr a -> IO StackFields
peekStackFields Ptr a
ptr = do
    Word32
stack_size' <- ((\Ptr a
hsc_ptr -> Ptr a -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
hsc_ptr Int
24)) Ptr a
ptr ::IO Word32
{-# LINE 115 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    dirty' <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 116 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}

{-# LINE 117 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    marking' <- ((\hsc_ptr -> peekByteOff hsc_ptr 29)) ptr
{-# LINE 118 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}

{-# LINE 119 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
    Ptr sp' <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 120 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}

    -- TODO decode the stack.

    StackFields -> IO StackFields
forall (m :: * -> *) a. Monad m => a -> m a
return StackFields {
        stack_size :: Word32
stack_size = Word32
stack_size',
        stack_dirty :: Word8
stack_dirty = Word8
dirty',

{-# LINE 127 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
        stack_marking :: Word8
stack_marking = Word8
marking',

{-# LINE 129 "GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc" #-}
        stack_sp :: Addr#
stack_sp = Addr#
sp'
    }