{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Low-level functions for decoding a closure representation from the raw
-- bytes
module GHC.Debug.Decode ( decodeClosure
                        , decodeInfoTable
                        , decodeCCS
                        , decodeIndexTable
                        ) where

 -- (Addr#, unsafeCoerce#, Any, Word#, ByteArray#)
import GHC.Word

import qualified Data.ByteString.Lazy as BSL

import GHC.Debug.Types.Ptr
import GHC.Debug.Types.Version
import GHC.Debug.Types.Closures
import Data.Binary.Get as B
import Data.Binary
import Control.Monad
import Data.Bits
import Data.Functor
import GHC.Debug.Types (getCCS, getIndexTable)

decodeClosureHeader :: Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader :: Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver = do
  () () -> Get () -> Get ()
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Get ()
skip (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)
  Version -> Get (Maybe ProfHeaderWithPtr)
getProfHeader Version
ver

getProfHeader :: Version -> Get (Maybe ProfHeaderWithPtr)
getProfHeader :: Version -> Get (Maybe ProfHeaderWithPtr)
getProfHeader Version
ver =
  case Version -> Maybe ProfilingMode
v_profiling Version
ver of
    Maybe ProfilingMode
Nothing -> Maybe ProfHeaderWithPtr -> Get (Maybe ProfHeaderWithPtr)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProfHeaderWithPtr
forall a. Maybe a
Nothing
    Just ProfilingMode
mode -> do
      CCSPtr
ccs <- Get CCSPtr
forall t. Binary t => Get t
get
      Word64
header <- Get Word64
getWord64le
      pure $ ProfHeaderWithPtr -> Maybe ProfHeaderWithPtr
forall a. a -> Maybe a
Just (ProfHeaderWithPtr -> Maybe ProfHeaderWithPtr)
-> ProfHeaderWithPtr -> Maybe ProfHeaderWithPtr
forall a b. (a -> b) -> a -> b
$ CCSPtr -> ProfHeaderWord -> ProfHeaderWithPtr
forall a. a -> ProfHeaderWord -> ProfHeader a
ProfHeader CCSPtr
ccs (ProfilingMode -> Word64 -> ProfHeaderWord
decodeHeader ProfilingMode
mode Word64
header)

decodeHeader :: ProfilingMode -> Word64 -> ProfHeaderWord
decodeHeader :: ProfilingMode -> Word64 -> ProfHeaderWord
decodeHeader ProfilingMode
mode Word64
hp = case ProfilingMode
mode of
  ProfilingMode
NoProfiling -> Word64 -> ProfHeaderWord
OtherHeader Word64
hp
  ProfilingMode
OtherProfiling -> Word64 -> ProfHeaderWord
OtherHeader Word64
hp
  -- TODO handle 32 bit
  ProfilingMode
RetainerProfiling -> Bool -> RetainerSetPtr -> ProfHeaderWord
RetainerHeader (Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
hp Int
0) (Word64 -> RetainerSetPtr
RetainerSetPtr (Word64 -> RetainerSetPtr) -> Word64 -> RetainerSetPtr
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
clearBit Word64
hp Int
0)
  ProfilingMode
LDVProfiling -> Bool -> Word32 -> Word32 -> ProfHeaderWord
LDVWord (Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
hp Int
60) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
hp Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
_LDV_CREATE_MASK) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
_LDV_SHIFT)) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
hp Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
_LDV_LAST_MASK))
  ProfilingMode
EraProfiling -> Word64 -> ProfHeaderWord
EraWord Word64
hp

_LDV_CREATE_MASK, _LDV_LAST_MASK :: Word64
_LDV_CREATE_MASK :: Word64
_LDV_CREATE_MASK = Word64
0x0FFFFFFFC0000000
_LDV_LAST_MASK :: Word64
_LDV_LAST_MASK = Word64
0x000000003FFFFFFF
_LDV_SHIFT :: Int
_LDV_SHIFT :: Int
_LDV_SHIFT = Int
30

decodePAPClosure :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodePAPClosure :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodePAPClosure Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  Word32
carity <- Get Word32
getWord32le
  Word32
nargs <- Get Word32
getWord32le
  ClosurePtr
funp <- Get ClosurePtr
getClosurePtr
  [Word64]
cpayload <- Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nargs) Get Word64
getWord64le
  let cont :: PayloadCont
cont = ClosurePtr -> [Word64] -> PayloadCont
PayloadCont ClosurePtr
funp [Word64]
cpayload
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word32
-> Word32
-> ClosurePtr
-> PayloadCont
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word32
-> Word32
-> b
-> pap
-> DebugClosure ccs srt pap string s b
GHC.Debug.Types.Closures.PAPClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof Word32
carity Word32
nargs ClosurePtr
funp PayloadCont
cont)

decodeAPClosure :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeAPClosure :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeAPClosure Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  Word64
_smp_header <- Get Word64
getWord64le
  -- _itbl <- decodeClosureHeader
  Word32
carity <- Get Word32
getWord32le
  Word32
nargs <- Get Word32
getWord32le
  ClosurePtr
funp <- Get ClosurePtr
getClosurePtr
  [Word64]
cpayload <- Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nargs) Get Word64
getWord64le
  let cont :: PayloadCont
cont = ClosurePtr -> [Word64] -> PayloadCont
PayloadCont ClosurePtr
funp [Word64]
cpayload
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word32
-> Word32
-> ClosurePtr
-> PayloadCont
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word32
-> Word32
-> b
-> pap
-> DebugClosure ccs srt pap string s b
GHC.Debug.Types.Closures.APClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof Word32
carity Word32
nargs ClosurePtr
funp PayloadCont
cont)


decodeTVarClosure :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeTVarClosure :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeTVarClosure Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
ptr <- Get ClosurePtr
getClosurePtr
  ClosurePtr
watch_queue <- Get ClosurePtr
getClosurePtr
  ByteOffset
updates <- Get ByteOffset
getInt64le
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> ClosurePtr
-> Int
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> Int
-> DebugClosure ccs srt pap string s b
TVarClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof ClosurePtr
ptr ClosurePtr
watch_queue (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
updates))

getClosurePtr :: Get ClosurePtr
getClosurePtr :: Get ClosurePtr
getClosurePtr = Get ClosurePtr
forall t. Binary t => Get t
get

getWord :: Get Word64
getWord :: Get Word64
getWord = Get Word64
getWord64le

decodeMutPrim :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeMutPrim :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutPrim Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  let kptrs :: Int
kptrs = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgInfoTable -> Word32
ptrs (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
infot))
      kdat :: Int
kdat = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgInfoTable -> Word32
nptrs (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
infot))
  [ClosurePtr]
pts <- Int -> Get ClosurePtr -> Get [ClosurePtr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
kptrs Get ClosurePtr
getClosurePtr
  [Word]
dat <- Int -> Get Word -> Get [Word]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
kdat (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le)
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
MutPrimClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof [ClosurePtr]
pts [Word]
dat)

decodePrim :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodePrim :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodePrim Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  let kptrs :: Int
kptrs = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgInfoTable -> Word32
ptrs (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
infot))
      kdat :: Int
kdat = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgInfoTable -> Word32
nptrs (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
infot))
  [ClosurePtr]
pts <- Int -> Get ClosurePtr -> Get [ClosurePtr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
kptrs Get ClosurePtr
getClosurePtr
  [Word]
dat <- Int -> Get Word -> Get [Word]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
kdat (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le)
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
PrimClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof [ClosurePtr]
pts [Word]
dat)

decodeTrecChunk :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeTrecChunk :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeTrecChunk Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
prev <- Get ClosurePtr
getClosurePtr
  Word64
clos_next_idx <- Get Word64
getWord64le
  [TRecEntry ClosurePtr]
chunks <- Int -> Get (TRecEntry ClosurePtr) -> Get [TRecEntry ClosurePtr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
clos_next_idx) Get (TRecEntry ClosurePtr)
getChunk
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> Word
-> [TRecEntry ClosurePtr]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> Word
-> [TRecEntry b]
-> DebugClosure ccs srt pap string s b
TRecChunkClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof ClosurePtr
prev (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
clos_next_idx) [TRecEntry ClosurePtr]
chunks)
  where
    getChunk :: Get (TRecEntry ClosurePtr)
getChunk = do
      ClosurePtr
-> ClosurePtr -> ClosurePtr -> Int -> TRecEntry ClosurePtr
forall b. b -> b -> b -> Int -> TRecEntry b
TRecEntry (ClosurePtr
 -> ClosurePtr -> ClosurePtr -> Int -> TRecEntry ClosurePtr)
-> Get ClosurePtr
-> Get (ClosurePtr -> ClosurePtr -> Int -> TRecEntry ClosurePtr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClosurePtr
getClosurePtr
                Get (ClosurePtr -> ClosurePtr -> Int -> TRecEntry ClosurePtr)
-> Get ClosurePtr
-> Get (ClosurePtr -> Int -> TRecEntry ClosurePtr)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ClosurePtr
getClosurePtr
                Get (ClosurePtr -> Int -> TRecEntry ClosurePtr)
-> Get ClosurePtr -> Get (Int -> TRecEntry ClosurePtr)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ClosurePtr
getClosurePtr
                Get (Int -> TRecEntry ClosurePtr)
-> Get Int -> Get (TRecEntry ClosurePtr)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Int) -> Get ByteOffset -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteOffset
getInt64le) -- TODO: num_updates field is wrong
                                                  -- Not sure how it should
                                                  -- be decoded

decodeBlockingQueue :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeBlockingQueue :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeBlockingQueue Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
q <- Get ClosurePtr
getClosurePtr
  ClosurePtr
bh <- Get ClosurePtr
getClosurePtr
  ClosurePtr
tso <- Get ClosurePtr
getClosurePtr
  ClosurePtr
bh_q <- Get ClosurePtr
getClosurePtr
  return $ (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> ClosurePtr
-> ClosurePtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> b
-> DebugClosure ccs srt pap string s b
GHC.Debug.Types.Closures.BlockingQueueClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof ClosurePtr
q ClosurePtr
bh ClosurePtr
tso ClosurePtr
bh_q)

-- It is just far simpler to directly decode the stack here rather than use
-- the existing logic in ghc-heap......
decodeStack :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeStack :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStack Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
cp, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
   Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
   Word32
st_size <- Get Word32
getWord32le
   Word8
st_dirty <- Get Word8
getWord8
   Word8
st_marking <- Get Word8
getWord8
   -- Up to now, 14 bytes are read, skip 2 to get to 16/start of
   -- sp field
   Int -> Get ()
skip Int
2
   StackPtr
st_sp <- Word64 -> StackPtr
StackPtr (Word64 -> StackPtr) -> Get Word64 -> Get StackPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord
   ByteOffset
stackHeaderSize <- Get ByteOffset
bytesRead
   let stack_offset :: Int
stack_offset = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StackPtr -> ClosurePtr -> Word64
subtractStackPtr StackPtr
st_sp ClosurePtr
cp)
             -- -stackHeaderSize for the bytes already read
             Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
stackHeaderSize
       len :: Word64
len = Word32 -> Word64 -> ClosurePtr -> StackPtr -> Word64
calculateStackLen Word32
st_size (ByteOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
stackHeaderSize) ClosurePtr
cp StackPtr
st_sp
   -- Skip to start of stack frames
   Int -> Get ()
skip Int
stack_offset
   -- Read the raw frames, we can't decode them yet because we
   -- need to query the debuggee for the bitmaps
   RawStack
raw_stack <- ByteString -> RawStack
RawStack (ByteString -> RawStack) -> Get ByteString -> Get RawStack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)
   return (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word32
-> Word8
-> Word8
-> StackCont
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word32
-> Word8
-> Word8
-> s
-> DebugClosure ccs srt pap string s b
GHC.Debug.Types.Closures.StackClosure
            StgInfoTableWithPtr
infot
            Maybe ProfHeaderWithPtr
prof
            Word32
st_size
            Word8
st_dirty
            Word8
st_marking
            (StackPtr -> RawStack -> StackCont
StackCont StackPtr
st_sp RawStack
raw_stack))

decodeFromBS :: RawClosure -> Get (DebugClosure ccs srt pap string s b)
                           -> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS :: forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS (RawClosure ByteString
rc) Get (DebugClosure ccs srt pap string s b)
parser =
  case Get (DebugClosure ccs srt pap string s b)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, DebugClosure ccs srt pap string s b)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get (DebugClosure ccs srt pap string s b)
parser (ByteString -> ByteString
BSL.fromStrict ByteString
rc) of
    Left (ByteString, ByteOffset, String)
err -> String -> DebugClosureWithExtra Size ccs srt pap string s b
forall a. HasCallStack => String -> a
error (String
"DEC:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString, ByteOffset, String) -> String
forall a. Show a => a -> String
show (ByteString, ByteOffset, String)
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ HasCallStack => ByteString -> String
ByteString -> String
printBS ByteString
rc)
    Right (ByteString
_rem, ByteOffset
o, DebugClosure ccs srt pap string s b
v) ->
      let !s :: Int
s = ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
o
      in Size
-> DebugClosure ccs srt pap string s b
-> DebugClosureWithExtra Size ccs srt pap string s b
forall x ccs srt pap string s b.
x
-> DebugClosure ccs srt pap string s b
-> DebugClosureWithExtra x ccs srt pap string s b
DCS (Int -> Size
Size Int
s) DebugClosure ccs srt pap string s b
v

decodeFromBS' :: RawClosure -> Get a -> a
decodeFromBS' :: forall a. RawClosure -> Get a -> a
decodeFromBS' (RawClosure ByteString
rc) Get a
parser =
  case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get a
parser (ByteString -> ByteString
BSL.fromStrict ByteString
rc) of
    Left (ByteString, ByteOffset, String)
err -> String -> a
forall a. HasCallStack => String -> a
error (String
"DEC:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString, ByteOffset, String) -> String
forall a. Show a => a -> String
show (ByteString, ByteOffset, String)
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ HasCallStack => ByteString -> String
ByteString -> String
printBS ByteString
rc)
    Right (ByteString
_rem, ByteOffset
_offset, a
v) -> a
v

decodeAPStack :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeAPStack :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeAPStack Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr Word64
cp, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  Word64
_smp_header <- Get Word64
getWord64le
  Word64
st_size <- Get Word64
getWord
  ClosurePtr
fun_closure <- Get ClosurePtr
getClosurePtr
  ByteOffset
k <- Get ByteOffset
bytesRead
  let sp :: StackPtr
sp = StackPtr -> Word64 -> StackPtr
addStackPtr (Word64 -> StackPtr
StackPtr Word64
cp) (ByteOffset -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
k)
  RawStack
clos_payload <- ByteString -> RawStack
RawStack (ByteString -> RawStack) -> Get ByteString -> Get RawStack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
st_size)
  return $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word
-> ClosurePtr
-> StackCont
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> b
-> s
-> DebugClosure ccs srt pap string s b
GHC.Debug.Types.Closures.APStackClosure
              StgInfoTableWithPtr
infot
              Maybe ProfHeaderWithPtr
prof
              (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
st_size)
              ClosurePtr
fun_closure
              (StackPtr -> RawStack -> StackCont
StackCont StackPtr
sp RawStack
clos_payload)

decodeStandardLayout :: Version
                     -> Get ()
                     -> (Maybe ProfHeaderWithPtr -> [ClosurePtr] -> [Word] -> Closure)
                     -> (StgInfoTableWithPtr, RawInfoTable)
                     -> (ClosurePtr, RawClosure)
                     -> SizedClosure
decodeStandardLayout :: Version
-> Get ()
-> (Maybe ProfHeaderWithPtr
    -> [ClosurePtr]
    -> [Word]
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStandardLayout Version
ver Get ()
extra Maybe ProfHeaderWithPtr
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
k (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  -- For the THUNK header
  Get ()
extra
  [ClosurePtr]
pts <- Int -> Get ClosurePtr -> Get [ClosurePtr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgInfoTable -> Word32
ptrs (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
infot))) Get ClosurePtr
getClosurePtr
  [Word64]
cwords <- Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgInfoTable -> Word32
nptrs (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
infot))) Get Word64
getWord
  return $ Maybe ProfHeaderWithPtr
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
k Maybe ProfHeaderWithPtr
prof [ClosurePtr]
pts ((Word64 -> Word) -> [Word64] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word64]
cwords)

decodeArrWords :: Version -> (StgInfoTableWithPtr, b)
               -> (a, RawClosure) -> SizedClosure
decodeArrWords :: forall b a.
Version
-> (StgInfoTableWithPtr, b) -> (a, RawClosure) -> SizedClosure
decodeArrWords Version
ver  (StgInfoTableWithPtr
infot, b
_) (a
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  Word64
bytes <- Get Word64
getWord64le
  [Word64]
payload <- Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
bytes Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`ceilIntDiv` Word64
8) Get Word64
getWord
  return $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> [Word]
-> DebugClosure ccs srt pap string s b
GHC.Debug.Types.Closures.ArrWordsClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytes) ((Word64 -> Word) -> [Word64] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word64]
payload)

-- | Compute @ceiling (a/b)@.
ceilIntDiv :: Integral a => a -> a -> a
ceilIntDiv :: forall a. Integral a => a -> a -> a
ceilIntDiv a
a a
b = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
b

tsoVersionChanged :: Version -> Bool
tsoVersionChanged :: Version -> Bool
tsoVersionChanged (Version Word32
majv Word32
minv Maybe ProfilingMode
_ Bool
_) = (Word32
majv Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
905) Bool -> Bool -> Bool
|| (Word32
majv Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
905 Bool -> Bool -> Bool
&& Word32
minv Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
20220925)

whyBlockedWord32 :: Version -> Bool
whyBlockedWord32 :: Version -> Bool
whyBlockedWord32 (Version Word32
majv Word32
minv Maybe ProfilingMode
_ Bool
_) = Word32
majv Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
909 Bool -> Bool -> Bool
|| (Word32
majv Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
909 Bool -> Bool -> Bool
&& Word32
minv Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
20240201)

decodeTSO :: Version
          -> (StgInfoTableWithPtr, RawInfoTable)
          -> (a, RawClosure)
          -> SizedClosure
decodeTSO :: forall a.
Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (a, RawClosure)
-> SizedClosure
decodeTSO Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (a
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
link <- Get ClosurePtr
getClosurePtr
  ClosurePtr
global_link <- Get ClosurePtr
getClosurePtr
  ClosurePtr
tsoStack <- Get ClosurePtr
getClosurePtr
  WhatNext
what_next <- Word16 -> WhatNext
parseWhatNext (Word16 -> WhatNext) -> Get Word16 -> Get WhatNext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
  (WhyBlocked
why_blocked, [TsoFlags]
flags) <-
    if Version -> Bool
whyBlockedWord32 Version
ver
      then do
        [TsoFlags]
flags <- Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> [TsoFlags]) -> Get Word32 -> Get [TsoFlags]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
        -- Padding
        Int -> Get ()
skip Int
2
        WhyBlocked
why_blocked <- Word32 -> WhyBlocked
parseWhyBlocked (Word32 -> WhyBlocked) -> Get Word32 -> Get WhyBlocked
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
        -- Padding
        Int -> Get ()
skip Int
4
        return (WhyBlocked
why_blocked, [TsoFlags]
flags)
      else do
        WhyBlocked
why_blocked <- Word32 -> WhyBlocked
parseWhyBlocked (Word32 -> WhyBlocked)
-> (Word16 -> Word32) -> Word16 -> WhyBlocked
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word32 (Word16 -> WhyBlocked) -> Get Word16 -> Get WhyBlocked
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
        [TsoFlags]
flags <- Word32 -> [TsoFlags]
parseTsoFlags (Word32 -> [TsoFlags]) -> Get Word32 -> Get [TsoFlags]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
        return (WhyBlocked
why_blocked, [TsoFlags]
flags)
  ClosurePtr
_block_info <- Get ClosurePtr
getClosurePtr
  Word64
threadId <- Get Word64
getWord64le
  Word32
saved_errno <- Get Word32
getWord32le
  Word32
dirty       <- Get Word32
getWord32le

  ClosurePtr
_bound       <- Get ClosurePtr
getClosurePtr
  ClosurePtr
_cap         <- Get ClosurePtr
getClosurePtr
  ClosurePtr
trec           <- Get ClosurePtr
getClosurePtr
  Maybe ClosurePtr
threadLabel <-
    if Version -> Bool
tsoVersionChanged Version
ver
      then do
        ClosurePtr
thread_label <- Get ClosurePtr
getClosurePtr
        return $ if ClosurePtr
thread_label ClosurePtr -> ClosurePtr -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> ClosurePtr
mkClosurePtr Word64
0 then Maybe ClosurePtr
forall a. Maybe a
Nothing else ClosurePtr -> Maybe ClosurePtr
forall a. a -> Maybe a
Just ClosurePtr
thread_label
      else Maybe ClosurePtr -> Get (Maybe ClosurePtr)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ClosurePtr
forall a. Maybe a
Nothing
  ClosurePtr
blocked_exceptions <- Get ClosurePtr
getClosurePtr
  ClosurePtr
bq             <- Get ClosurePtr
getClosurePtr
  ByteOffset
alloc_limit    <- Get ByteOffset
getInt64le
  Word32
tot_stack_size <- Get Word32
getWord32le
  let DebugClosure
  CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
res :: Closure = (GHC.Debug.Types.Closures.TSOClosure
            { info :: StgInfoTableWithPtr
info = StgInfoTableWithPtr
infot
            , profHeader :: Maybe ProfHeaderWithPtr
profHeader = Maybe ProfHeaderWithPtr
prof
            , _link :: ClosurePtr
_link = ClosurePtr
link
            , prof :: Maybe StgTSOProfInfo
prof = Maybe StgTSOProfInfo
forall a. Maybe a
Nothing
            , ByteOffset
[TsoFlags]
Maybe ClosurePtr
Word32
Word64
ClosurePtr
WhyBlocked
WhatNext
global_link :: ClosurePtr
tsoStack :: ClosurePtr
what_next :: WhatNext
why_blocked :: WhyBlocked
flags :: [TsoFlags]
threadId :: Word64
saved_errno :: Word32
dirty :: Word32
trec :: ClosurePtr
threadLabel :: Maybe ClosurePtr
blocked_exceptions :: ClosurePtr
bq :: ClosurePtr
alloc_limit :: ByteOffset
tot_stack_size :: Word32
global_link :: ClosurePtr
tsoStack :: ClosurePtr
trec :: ClosurePtr
blocked_exceptions :: ClosurePtr
bq :: ClosurePtr
threadLabel :: Maybe ClosurePtr
what_next :: WhatNext
why_blocked :: WhyBlocked
flags :: [TsoFlags]
threadId :: Word64
saved_errno :: Word32
dirty :: Word32
alloc_limit :: ByteOffset
tot_stack_size :: Word32
.. })
  return DebugClosure
  CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
res

parseWhatNext :: Word16 -> WhatNext
parseWhatNext :: Word16 -> WhatNext
parseWhatNext Word16
i = case Word16
i of
  Word16
1 -> WhatNext
ThreadRunGHC
  Word16
2 -> WhatNext
ThreadInterpret
  Word16
3 -> WhatNext
ThreadKilled
  Word16
4 -> WhatNext
ThreadComplete
  Word16
_ -> Word16 -> WhatNext
WhatNextUnknownValue Word16
i

parseWhyBlocked :: Word32 -> WhyBlocked
parseWhyBlocked :: Word32 -> WhyBlocked
parseWhyBlocked Word32
i = case Word32
i of
  Word32
0  -> WhyBlocked
NotBlocked
  Word32
1  -> WhyBlocked
BlockedOnMVar
  Word32
14 -> WhyBlocked
BlockedOnMVarRead
  Word32
2  -> WhyBlocked
BlockedOnBlackHole
  Word32
3  -> WhyBlocked
BlockedOnRead
  Word32
4  -> WhyBlocked
BlockedOnWrite
  Word32
5  -> WhyBlocked
BlockedOnDelay
  Word32
6  -> WhyBlocked
BlockedOnSTM
  Word32
7  -> WhyBlocked
BlockedOnDoProc
  Word32
10 -> WhyBlocked
BlockedOnCCall
  Word32
11 -> WhyBlocked
BlockedOnCCall_Interruptible
  Word32
12 -> WhyBlocked
BlockedOnMsgThrowTo
  Word32
13 -> WhyBlocked
ThreadMigrating
  Word32
_  -> Word32 -> WhyBlocked
WhyBlockedUnknownValue Word32
i

parseTsoFlags :: Word32 -> [TsoFlags]
parseTsoFlags :: Word32 -> [TsoFlags]
parseTsoFlags Word32
w =
  [(TsoFlags, Int)] -> [TsoFlags]
forall {a}. [(a, Int)] -> [a]
go [ (TsoFlags
TsoLocked             , Int
1)
     , (TsoFlags
TsoBlockx             , Int
2)
     , (TsoFlags
TsoInterruptible      , Int
3)
     , (TsoFlags
TsoStoppedOnBreakpoint, Int
4)
     , (TsoFlags
TsoMarked             , Int
5)
     , (TsoFlags
TsoSqueezed           , Int
6)
     , (TsoFlags
TsoAllocLimit         , Int
7)
     ]
  where
    go :: [(a, Int)] -> [a]
go [(a, Int)]
xs = [a
flag | (a
flag, Int
i) <- [(a, Int)]
xs, Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
w Int
i]

decodeClosure :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeClosure :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeClosure Version
ver i :: (StgInfoTableWithPtr, RawInfoTable)
i@(StgInfoTableWithPtr
itb, RawInfoTable
_) (ClosurePtr, RawClosure)
c
  = case StgInfoTable -> ClosureType
tipe (StgInfoTableWithPtr -> StgInfoTable
decodedTable StgInfoTableWithPtr
itb) of
      ClosureType
ARR_WORDS -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
forall b a.
Version
-> (StgInfoTableWithPtr, b) -> (a, RawClosure) -> SizedClosure
decodeArrWords Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
PAP -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodePAPClosure Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
AP -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeAPClosure Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
TVAR -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeTVarClosure Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
MUT_PRIM -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutPrim Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
PRIM -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodePrim Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
TREC_CHUNK -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeTrecChunk Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
BLOCKING_QUEUE -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeBlockingQueue Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
TSO -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
forall a.
Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (a, RawClosure)
-> SizedClosure
decodeTSO Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
STACK -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStack Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
AP_STACK -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeAPStack Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
THUNK_STATIC -> Version
-> Get ()
-> (Maybe ProfHeaderWithPtr
    -> [ClosurePtr]
    -> [Word]
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStandardLayout Version
ver (() -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\Maybe ProfHeaderWithPtr
ph -> StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> SrtCont
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> srt
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
ThunkClosure StgInfoTableWithPtr
itb Maybe ProfHeaderWithPtr
ph (StgInfoTableWithPtr -> SrtCont
tableId StgInfoTableWithPtr
itb)) (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
THUNK_SELECTOR -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeThunkSelector Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
BCO -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeBCO Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
IND        -> Version
-> (StgInfoTableWithPtr
    -> Maybe ProfHeaderWithPtr
    -> ClosurePtr
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeIndirectee Version
ver StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
IndClosure (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
IND_STATIC -> Version
-> (StgInfoTableWithPtr
    -> Maybe ProfHeaderWithPtr
    -> ClosurePtr
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeIndirectee Version
ver StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
IndClosure (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
BLACKHOLE  -> Version
-> (StgInfoTableWithPtr
    -> Maybe ProfHeaderWithPtr
    -> ClosurePtr
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeIndirectee Version
ver StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
BlackholeClosure (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
MVAR_CLEAN -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMVar Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
MVAR_DIRTY -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMVar Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
MUT_VAR_CLEAN -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutVar Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
MUT_VAR_DIRTY -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutVar Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
WEAK -> Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeWeakClosure Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
      ClosureType
ty
        | ClosureType
CONSTR ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
ty Bool -> Bool -> Bool
&& ClosureType
ty ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
CONSTR_0_2 ->
            Version
-> Get ()
-> (Maybe ProfHeaderWithPtr
    -> [ClosurePtr]
    -> [Word]
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStandardLayout Version
ver (() -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\Maybe ProfHeaderWithPtr
ph [ClosurePtr]
pts [Word]
ws -> StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> [ClosurePtr]
-> [Word]
-> SrtCont
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> string
-> DebugClosure ccs srt pap string s b
ConstrClosure StgInfoTableWithPtr
itb Maybe ProfHeaderWithPtr
ph [ClosurePtr]
pts [Word]
ws (StgInfoTableWithPtr -> SrtCont
tableId StgInfoTableWithPtr
itb)) (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
        | ClosureType
CONSTR ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
ty Bool -> Bool -> Bool
&& ClosureType
ty ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
CONSTR_NOCAF ->
            Version
-> Get ()
-> (Maybe ProfHeaderWithPtr
    -> [ClosurePtr]
    -> [Word]
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStandardLayout Version
ver (() -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\Maybe ProfHeaderWithPtr
ph [ClosurePtr]
pts [Word]
ws -> StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> [ClosurePtr]
-> [Word]
-> SrtCont
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> [b]
-> [Word]
-> string
-> DebugClosure ccs srt pap string s b
ConstrClosure StgInfoTableWithPtr
itb Maybe ProfHeaderWithPtr
ph [ClosurePtr]
pts [Word]
ws (StgInfoTableWithPtr -> SrtCont
tableId StgInfoTableWithPtr
itb)) (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
        | ClosureType
FUN ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
ty Bool -> Bool -> Bool
&& ClosureType
ty ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
FUN_STATIC ->
            Version
-> Get ()
-> (Maybe ProfHeaderWithPtr
    -> [ClosurePtr]
    -> [Word]
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStandardLayout Version
ver (() -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\Maybe ProfHeaderWithPtr
ph -> StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> SrtCont
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> srt
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
FunClosure StgInfoTableWithPtr
itb Maybe ProfHeaderWithPtr
ph (StgInfoTableWithPtr -> SrtCont
tableId StgInfoTableWithPtr
itb)) (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
        | ClosureType
THUNK ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
ty Bool -> Bool -> Bool
&& ClosureType
ty ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
THUNK_0_2 ->
            Version
-> Get ()
-> (Maybe ProfHeaderWithPtr
    -> [ClosurePtr]
    -> [Word]
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeStandardLayout Version
ver (() () -> Get Word64 -> Get ()
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Get Word64
getWord) (\Maybe ProfHeaderWithPtr
ph -> StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> SrtCont
-> [ClosurePtr]
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> srt
-> [b]
-> [Word]
-> DebugClosure ccs srt pap string s b
ThunkClosure StgInfoTableWithPtr
itb Maybe ProfHeaderWithPtr
ph (StgInfoTableWithPtr -> SrtCont
tableId StgInfoTableWithPtr
itb)) (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
        | ClosureType
MUT_ARR_PTRS_CLEAN ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
ty Bool -> Bool -> Bool
&& ClosureType
ty ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
MUT_ARR_PTRS_FROZEN_CLEAN ->
            Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutArr Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
        | ClosureType
SMALL_MUT_ARR_PTRS_CLEAN ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
ty Bool -> Bool -> Bool
&& ClosureType
ty ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
SMALL_MUT_ARR_PTRS_FROZEN_CLEAN ->
            Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeSmallMutArr Version
ver (StgInfoTableWithPtr, RawInfoTable)
i (ClosurePtr, RawClosure)
c
        | Bool
otherwise -> String -> SizedClosure
forall a. HasCallStack => String -> a
error (String -> SizedClosure) -> String -> SizedClosure
forall a b. (a -> b) -> a -> b
$ String
"unhandled closure type" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ClosureType -> String
forall a. Show a => a -> String
show ClosureType
ty

decodeCCS :: Version -> RawClosure -> CCSPayload
decodeCCS :: Version -> RawClosure -> CCSPayload
decodeCCS Version
_ RawClosure
rc = RawClosure -> Get CCSPayload -> CCSPayload
forall a. RawClosure -> Get a -> a
decodeFromBS' RawClosure
rc Get CCSPayload
getCCS

decodeIndexTable :: Version -> RawClosure -> IndexTable
decodeIndexTable :: Version -> RawClosure -> IndexTable
decodeIndexTable Version
_ RawClosure
rc = RawClosure -> Get IndexTable -> IndexTable
forall a. RawClosure -> Get a -> a
decodeFromBS' RawClosure
rc Get IndexTable
getIndexTable

decodeWeakClosure :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeWeakClosure :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeWeakClosure Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
profHeader <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
cfinalizers <- Get ClosurePtr
getClosurePtr
  ClosurePtr
key <- Get ClosurePtr
getClosurePtr
  ClosurePtr
value <- Get ClosurePtr
getClosurePtr
  ClosurePtr
finalizer <- Get ClosurePtr
getClosurePtr
  Maybe ClosurePtr
mlink <- do
    p :: ClosurePtr
p@(ClosurePtr Word64
w) <- Get ClosurePtr
getClosurePtr
    Maybe ClosurePtr -> Get (Maybe ClosurePtr)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ClosurePtr -> Get (Maybe ClosurePtr))
-> Maybe ClosurePtr -> Get (Maybe ClosurePtr)
forall a b. (a -> b) -> a -> b
$ if Word64
w Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then Maybe ClosurePtr
forall a. Maybe a
Nothing else ClosurePtr -> Maybe ClosurePtr
forall a. a -> Maybe a
Just ClosurePtr
p
  pure $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> ClosurePtr
-> ClosurePtr
-> ClosurePtr
-> Maybe ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> b
-> Maybe b
-> DebugClosure ccs srt pap string s b
WeakClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
profHeader ClosurePtr
cfinalizers ClosurePtr
key ClosurePtr
value ClosurePtr
finalizer Maybe ClosurePtr
mlink

decodeMVar :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeMVar :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMVar Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
profHeader <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
hd <- Get ClosurePtr
getClosurePtr
  ClosurePtr
tl <- Get ClosurePtr
getClosurePtr
  ClosurePtr
val <- Get ClosurePtr
getClosurePtr
  pure $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> ClosurePtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> DebugClosure ccs srt pap string s b
MVarClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
profHeader ClosurePtr
hd ClosurePtr
tl ClosurePtr
val

decodeMutVar :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeMutVar :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutVar Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
profHeader <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
val <- Get ClosurePtr
getClosurePtr
  pure $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
MutVarClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
profHeader ClosurePtr
val

decodeMutArr :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeMutArr :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeMutArr Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
profHeader <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  Word64
nptrs <- Get Word64
getWord64le
  Word64
size <- Get Word64
getWord64le
  [ClosurePtr]
payload <- Int -> Get ClosurePtr -> Get [ClosurePtr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nptrs) Get ClosurePtr
getClosurePtr
  pure $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word
-> Word
-> [ClosurePtr]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> Word
-> [b]
-> DebugClosure ccs srt pap string s b
MutArrClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
profHeader (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nptrs) (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
size) [ClosurePtr]
payload

decodeSmallMutArr :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeSmallMutArr :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeSmallMutArr Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
profHeader <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  Word64
nptrs <- Get Word64
getWord64le
  [ClosurePtr]
payload <- Int -> Get ClosurePtr -> Get [ClosurePtr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nptrs) Get ClosurePtr
getClosurePtr
  pure $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> Word
-> [ClosurePtr]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> Word
-> [b]
-> DebugClosure ccs srt pap string s b
SmallMutArrClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
profHeader (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nptrs) [ClosurePtr]
payload

decodeIndirectee :: Version
                 -> (StgInfoTableWithPtr -> Maybe ProfHeaderWithPtr -> ClosurePtr -> Closure)
                 -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) -> SizedClosure
decodeIndirectee :: Version
-> (StgInfoTableWithPtr
    -> Maybe ProfHeaderWithPtr
    -> ClosurePtr
    -> DebugClosure
         CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeIndirectee Version
ver StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
mk (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
ind <- Get ClosurePtr
getClosurePtr
  pure $ StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
mk StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof ClosurePtr
ind

decodeBCO :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeBCO :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeBCO Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  ClosurePtr
instrs <- Get ClosurePtr
getClosurePtr
  ClosurePtr
literals <- Get ClosurePtr
getClosurePtr
  ClosurePtr
bcoptrs <- Get ClosurePtr
getClosurePtr
  Word32
arity <- Get Word32
getWord32le
  Word32
size <- Get Word32
getWord32le
  [Word]
bitmap <- Int -> Get Word -> Get [Word]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size) (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le) -- TODO getWord?
  pure (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> ClosurePtr
-> ClosurePtr
-> Word32
-> Word32
-> [Word]
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> b
-> b
-> Word32
-> Word32
-> [Word]
-> DebugClosure ccs srt pap string s b
BCOClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof ClosurePtr
instrs ClosurePtr
literals ClosurePtr
bcoptrs Word32
arity Word32
size [Word]
bitmap)


decodeThunkSelector :: Version -> (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
decodeThunkSelector :: Version
-> (StgInfoTableWithPtr, RawInfoTable)
-> (ClosurePtr, RawClosure)
-> SizedClosure
decodeThunkSelector Version
ver (StgInfoTableWithPtr
infot, RawInfoTable
_) (ClosurePtr
_, RawClosure
rc) = RawClosure
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall ccs srt pap string s b.
RawClosure
-> Get (DebugClosure ccs srt pap string s b)
-> DebugClosureWithExtra Size ccs srt pap string s b
decodeFromBS RawClosure
rc (Get
   (DebugClosure
      CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
 -> SizedClosure)
-> Get
     (DebugClosure
        CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr)
-> SizedClosure
forall a b. (a -> b) -> a -> b
$ do
  Maybe ProfHeaderWithPtr
prof <- Version -> Get (Maybe ProfHeaderWithPtr)
decodeClosureHeader Version
ver
  (() () -> Get Word64 -> Get ()
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Get Word64
getWord)
  ClosurePtr
selectee <- Get ClosurePtr
getClosurePtr
  pure (StgInfoTableWithPtr
-> Maybe ProfHeaderWithPtr
-> ClosurePtr
-> DebugClosure
     CCSPtr SrtCont PayloadCont SrtCont StackCont ClosurePtr
forall ccs srt pap string s b.
StgInfoTableWithPtr
-> Maybe (ProfHeader ccs)
-> b
-> DebugClosure ccs srt pap string s b
SelectorClosure StgInfoTableWithPtr
infot Maybe ProfHeaderWithPtr
prof ClosurePtr
selectee)

decodeInfoTable :: Version -> RawInfoTable -> StgInfoTable
decodeInfoTable :: Version -> RawInfoTable -> StgInfoTable
decodeInfoTable ver :: Version
ver@Version{Bool
Maybe ProfilingMode
Word32
v_profiling :: Version -> Maybe ProfilingMode
v_major :: Word32
v_patch :: Word32
v_profiling :: Maybe ProfilingMode
v_tntc :: Bool
v_major :: Version -> Word32
v_patch :: Version -> Word32
v_tntc :: Version -> Bool
..} (RawInfoTable ByteString
itbl) =
  case Get StgInfoTable
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, StgInfoTable)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get StgInfoTable
itParser (ByteString -> ByteString
BSL.fromStrict ByteString
itbl) of
    Left (ByteString, ByteOffset, String)
err -> String -> StgInfoTable
forall a. HasCallStack => String -> a
error (String
"DEC:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString, ByteOffset, String) -> String
forall a. Show a => a -> String
show (ByteString, ByteOffset, String)
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ HasCallStack => ByteString -> String
ByteString -> String
printBS ByteString
itbl)
    Right (ByteString
_rem, !ByteOffset
_, StgInfoTable
v) -> StgInfoTable
v
  where
    itParser :: Get StgInfoTable
itParser = do
      Maybe Any
_entry <- case Bool
v_tntc of
        Bool
True -> Maybe Any -> Get (Maybe Any)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Any
forall a. Maybe a
Nothing
        Bool
False -> do
          Get Word64
getWord64le -- todo return funptr
          pure Maybe Any
forall a. Maybe a
Nothing
      Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Bool
isProfiledRTS Version
ver) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
        () () -> Get Word64 -> Get ()
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Get Word64
getWord64le
        () () -> Get Word64 -> Get ()
forall a b. a -> Get b -> Get a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Get Word64
getWord64le
      Word32
ptrs <- Get Word32
getWord32le
      Word32
nptrs <- Get Word32
getWord32le
      Word32
tipe <- Get Word32
getWord32le
      Word32
srtlen <- Get Word32
getWord32le
      return $
        StgInfoTable
        { ptrs :: Word32
ptrs = Word32
ptrs
        , nptrs :: Word32
nptrs = Word32
nptrs
        , tipe :: ClosureType
tipe = Word32 -> ClosureType
decodeInfoTableType Word32
tipe
        , srtlen :: Word32
srtlen = Word32
srtlen
        }

decodeInfoTableType :: Word32 -> ClosureType
decodeInfoTableType :: Word32 -> ClosureType
decodeInfoTableType Word32
i = case Word32
i of
  Word32
0 -> ClosureType
INVALID_OBJECT
  Word32
1 -> ClosureType
CONSTR
  Word32
2 -> ClosureType
CONSTR_1_0
  Word32
3 -> ClosureType
CONSTR_0_1
  Word32
4 -> ClosureType
CONSTR_2_0
  Word32
5 -> ClosureType
CONSTR_1_1
  Word32
6 -> ClosureType
CONSTR_0_2
  Word32
7 -> ClosureType
CONSTR_NOCAF
  Word32
8 -> ClosureType
FUN
  Word32
9 -> ClosureType
FUN_1_0
  Word32
10 -> ClosureType
FUN_0_1
  Word32
11 -> ClosureType
FUN_2_0
  Word32
12 -> ClosureType
FUN_1_1
  Word32
13 -> ClosureType
FUN_0_2
  Word32
14 -> ClosureType
FUN_STATIC
  Word32
15 -> ClosureType
THUNK
  Word32
16 -> ClosureType
THUNK_1_0
  Word32
17 -> ClosureType
THUNK_0_1
  Word32
18 -> ClosureType
THUNK_2_0
  Word32
19 -> ClosureType
THUNK_1_1
  Word32
20 -> ClosureType
THUNK_0_2
  Word32
21 -> ClosureType
THUNK_STATIC
  Word32
22 -> ClosureType
THUNK_SELECTOR
  Word32
23 -> ClosureType
BCO
  Word32
24 -> ClosureType
AP
  Word32
25 -> ClosureType
PAP
  Word32
26 -> ClosureType
AP_STACK
  Word32
27 -> ClosureType
IND
  Word32
28 -> ClosureType
IND_STATIC
  Word32
29 -> ClosureType
RET_BCO
  Word32
30 -> ClosureType
RET_SMALL
  Word32
31 -> ClosureType
RET_BIG
  Word32
32 -> ClosureType
RET_FUN
  Word32
33 -> ClosureType
UPDATE_FRAME
  Word32
34 -> ClosureType
CATCH_FRAME
  Word32
35 -> ClosureType
UNDERFLOW_FRAME
  Word32
36 -> ClosureType
STOP_FRAME
  Word32
37 -> ClosureType
BLOCKING_QUEUE
  Word32
38 -> ClosureType
BLACKHOLE
  Word32
39 -> ClosureType
MVAR_CLEAN
  Word32
40 -> ClosureType
MVAR_DIRTY
  Word32
41 -> ClosureType
TVAR
  Word32
42 -> ClosureType
ARR_WORDS
  Word32
43 -> ClosureType
MUT_ARR_PTRS_CLEAN
  Word32
44 -> ClosureType
MUT_ARR_PTRS_DIRTY
  Word32
45 -> ClosureType
MUT_ARR_PTRS_FROZEN_DIRTY
  Word32
46 -> ClosureType
MUT_ARR_PTRS_FROZEN_CLEAN
  Word32
47 -> ClosureType
MUT_VAR_CLEAN
  Word32
48 -> ClosureType
MUT_VAR_DIRTY
  Word32
49 -> ClosureType
WEAK
  Word32
50 -> ClosureType
PRIM
  Word32
51 -> ClosureType
MUT_PRIM
  Word32
52 -> ClosureType
TSO
  Word32
53 -> ClosureType
STACK
  Word32
54 -> ClosureType
TREC_CHUNK
  Word32
55 -> ClosureType
ATOMICALLY_FRAME
  Word32
56 -> ClosureType
CATCH_RETRY_FRAME
  Word32
57 -> ClosureType
CATCH_STM_FRAME
  Word32
58 -> ClosureType
WHITEHOLE
  Word32
59 -> ClosureType
SMALL_MUT_ARR_PTRS_CLEAN
  Word32
60 -> ClosureType
SMALL_MUT_ARR_PTRS_DIRTY
  Word32
61 -> ClosureType
SMALL_MUT_ARR_PTRS_FROZEN_DIRTY
  Word32
62 -> ClosureType
SMALL_MUT_ARR_PTRS_FROZEN_CLEAN
  Word32
63 -> ClosureType
COMPACT_NFDATA
  Word32
64 -> ClosureType
CONTINUATION
  Word32
65 -> ClosureType
N_CLOSURE_TYPES
  Word32
n  -> String -> ClosureType
forall a. HasCallStack => String -> a
error (String -> ClosureType) -> String -> ClosureType
forall a b. (a -> b) -> a -> b
$ String
"Unexpected closure type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n