    {-# LANGUAGE CPP #-}
    #if MIN_TOOL_VERSION_ghc(9,9,0)
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE DuplicateRecordFields #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GHCForeignImportPrim #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeInType #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# LANGUAGE UnliftedFFITypes #-}

    module GHC.Exts.Stack.Decode
      ( decodeStack,
      )
    where

    import Control.Monad
    import Data.Bits
    import Data.Maybe
    import Foreign
    import GHC.Exts
    import GHC.Exts.Heap (Box (..))
    import GHC.Exts.Heap.ClosureTypes
    import GHC.Exts.Heap.Closures
      ( StackFrame,
        GenStackFrame (..),
        StgStackClosure,
        GenStgStackClosure (..),
        StackField,
        GenStackField(..)
      )
    import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS)
    import GHC.Exts.Heap.InfoTable
    import GHC.Exts.Stack.Constants
    import GHC.Stack.CloneStack
    import GHC.Word
    import Prelude

    {- Note [Decoding the stack]
       ~~~~~~~~~~~~~~~~~~~~~~~~~

    The stack is represented by a chain of StgStack closures. Each of these closures
    is subject to garbage collection. I.e. they can be moved in memory (in a
    simplified perspective) at any time.

    The array of closures inside an StgStack (that makeup the execution stack; the
    stack frames) is moved as bare memory by the garbage collector. References
    (pointers) to stack frames are not updated by the garbage collector.

    As the StgStack closure is moved as whole, the relative offsets inside it stay
    the same. (Though, the absolute addresses change!)

    Decoding
    ========

    Stack frames are defined by their `StackSnapshot#` (`StgStack*` in RTS) and
    their relative offset. This tuple is described by `StackFrameLocation`.

    `StackFrame` is an ADT for decoded stack frames. Regarding payload and fields we
    have to deal with three cases:

    - If the payload can only be a closure, we put it in a `Box` for later decoding
      by the heap closure functions.

    - If the payload can either be a closure or a word-sized value (this happens for
      bitmap-encoded payloads), we use a `StackField` which is a sum type to
      represent either a `Word` or a `Box`.

    - Fields that are just simple (i.e. non-closure) values are decoded as such.

    The decoding happens in two phases:

    1. The whole stack is decoded into `StackFrameLocation`s.

    2. All `StackFrameLocation`s are decoded into `StackFrame`s.

    `StackSnapshot#` parameters are updated by the garbage collector and thus safe
    to hand around.

    The head of the stack frame array has offset (index) 0. To traverse the stack
    frames the latest stack frame's offset is incremented by the closure size. The
    unit of the offset is machine words (32bit or 64bit.)

    IO
    ==

    Unfortunately, ghc-heap decodes `Closure`s in `IO`. This leads to `StackFrames`
    also being decoded in `IO`, due to references to `Closure`s.

    Technical details
    =================

    - All access to StgStack/StackSnapshot# closures is made through Cmm code. This
      keeps the closure from being moved by the garbage collector during the
      operation.

    - As StgStacks are mainly used in Cmm and C code, much of the decoding logic is
      implemented in Cmm and C. It's just easier to reuse existing helper macros and
      functions, than reinventing them in Haskell.

    - Offsets and sizes of closures are imported from DerivedConstants.h via HSC.
      This keeps the code very portable.
    -}

    foreign import prim "getUnderflowFrameNextChunkzh"
      getUnderflowFrameNextChunk# ::
        StackSnapshot# -> Word# -> StackSnapshot#

    getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> StackSnapshot
    getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> StackSnapshot
    getUnderflowFrameNextChunk StackSnapshot#
    stackSnapshot# WordOffset
    index =
      StackSnapshot# -> StackSnapshot
    StackSnapshot (StackSnapshot# -> Word# -> StackSnapshot#
    getUnderflowFrameNextChunk# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index))

    foreign import prim "getWordzh"
      getWord# ::
        StackSnapshot# -> Word# -> Word#

    getWord :: StackSnapshot# -> WordOffset -> Word
    getWord :: StackSnapshot# -> WordOffset -> Word
    getWord StackSnapshot#
    stackSnapshot# WordOffset
    index =
      Word# -> Word
    W# (StackSnapshot# -> Word# -> Word#
    getWord# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index))

    foreign import prim "isArgGenBigRetFunTypezh" isArgGenBigRetFunType# :: StackSnapshot# -> Word# -> Int#

    isArgGenBigRetFunType :: StackSnapshot# -> WordOffset -> Bool
    isArgGenBigRetFunType :: StackSnapshot# -> WordOffset -> Bool
    isArgGenBigRetFunType StackSnapshot#
    stackSnapshot# WordOffset
    index =
      Int# -> Int
    I# (StackSnapshot# -> Word# -> Int#
    isArgGenBigRetFunType# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index)) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0

    -- | Gets contents of a `LargeBitmap` (@StgLargeBitmap@)
    --
    -- The first two arguments identify the location of the frame on the stack.
    -- Returned is the `Addr#` of the @StgWord[]@ (bitmap) and it's size.
    type LargeBitmapGetter = StackSnapshot# -> Word# -> (# Addr#, Word# #)

    foreign import prim "getLargeBitmapzh" getLargeBitmap# :: LargeBitmapGetter

    foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: LargeBitmapGetter

    foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: LargeBitmapGetter

    -- | Gets contents of a small bitmap (fitting in one @StgWord@)
    --
    -- The first two arguments identify the location of the frame on the stack.
    -- Returned is the bitmap and it's size.
    type SmallBitmapGetter = StackSnapshot# -> Word# -> (# Word#, Word# #)

    foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter

    foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter

    foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr#

    foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr#

    getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable
    getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable
    getInfoTableOnStack StackSnapshot#
    stackSnapshot# WordOffset
    index =
      let infoTablePtr :: Ptr StgInfoTable
    infoTablePtr = Addr# -> Ptr StgInfoTable
    forall a. Addr# -> Ptr a
    Ptr (StackSnapshot# -> Word# -> Addr#
    getInfoTableAddr# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index))
       in Ptr StgInfoTable -> IO StgInfoTable
    peekItbl Ptr StgInfoTable
    infoTablePtr

    getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable
    getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable
    getInfoTableForStack StackSnapshot#
    stackSnapshot# =
      Ptr StgInfoTable -> IO StgInfoTable
    peekItbl (Ptr StgInfoTable -> IO StgInfoTable)
    -> Ptr StgInfoTable -> IO StgInfoTable
    forall a b. (a -> b) -> a -> b
    $
        Addr# -> Ptr StgInfoTable
    forall a. Addr# -> Ptr a
    Ptr (StackSnapshot# -> Addr#
    getStackInfoTableAddr# StackSnapshot#
    stackSnapshot#)

    foreign import prim "getStackClosurezh"
      getStackClosure# ::
        StackSnapshot# -> Word# ->  Any

    foreign import prim "getStackFieldszh"
      getStackFields# ::
        StackSnapshot# -> Word32#

    getStackFields :: StackSnapshot# -> Word32
    getStackFields :: StackSnapshot# -> Word32
    getStackFields StackSnapshot#
    stackSnapshot# =
      case StackSnapshot# -> Word32#
    getStackFields# StackSnapshot#
    stackSnapshot# of
        Word32#
    sSize# -> Word32# -> Word32
    W32# Word32#
    sSize#

    -- | `StackFrameLocation` of the top-most stack frame
    stackHead :: StackSnapshot# -> StackFrameLocation
    stackHead :: StackSnapshot# -> StackFrameLocation
    stackHead StackSnapshot#
    s# = (StackSnapshot# -> StackSnapshot
    StackSnapshot StackSnapshot#
    s#, WordOffset
    0) -- GHC stacks are never empty

    -- | Advance to the next stack frame (if any)
    --
    -- The last `Int#` in the result tuple is meant to be treated as bool
    -- (has_next).
    foreign import prim "advanceStackFrameLocationzh"
      advanceStackFrameLocation# ::
        StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)

    -- | Advance to the next stack frame (if any)
    advanceStackFrameLocation :: StackFrameLocation -> Maybe StackFrameLocation
    advanceStackFrameLocation :: StackFrameLocation -> Maybe StackFrameLocation
    advanceStackFrameLocation ((StackSnapshot StackSnapshot#
    stackSnapshot#), WordOffset
    index) =
      let !(# StackSnapshot#
    s', Word#
    i', Int#
    hasNext #) = StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
    advanceStackFrameLocation# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index)
       in if Int# -> Int
    I# Int#
    hasNext Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
            then StackFrameLocation -> Maybe StackFrameLocation
    forall a. a -> Maybe a
    Just (StackSnapshot# -> StackSnapshot
    StackSnapshot StackSnapshot#
    s', Word# -> WordOffset
    primWordToWordOffset Word#
    i')
            else Maybe StackFrameLocation
    forall a. Maybe a
    Nothing
      where
        primWordToWordOffset :: Word# -> WordOffset
        primWordToWordOffset :: Word# -> WordOffset
    primWordToWordOffset Word#
    w# = Word -> WordOffset
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word# -> Word
    W# Word#
    w#)

    getClosureBox :: StackSnapshot# -> WordOffset -> Box
    getClosureBox :: StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# WordOffset
    index =
            case StackSnapshot# -> Word# -> Any
    getStackClosure# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index) of
              -- c needs to be strictly evaluated, otherwise a thunk gets boxed (and
              -- will later be decoded as such)
              !Any
    c -> Any -> Box
    Box Any
    c

    -- | Representation of @StgLargeBitmap@ (RTS)
    data LargeBitmap = LargeBitmap
      { LargeBitmap -> Word
    largeBitmapSize :: Word,
        LargeBitmap -> Ptr Word
    largebitmapWords :: Ptr Word
      }

    -- | Is a bitmap entry a closure pointer or a primitive non-pointer?
    data Pointerness = Pointer | NonPointer
      deriving (Int -> Pointerness -> ShowS
    [Pointerness] -> ShowS
    Pointerness -> String
    (Int -> Pointerness -> ShowS)
    -> (Pointerness -> String)
    -> ([Pointerness] -> ShowS)
    -> Show Pointerness
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Pointerness -> ShowS
    showsPrec :: Int -> Pointerness -> ShowS
    $cshow :: Pointerness -> String
    show :: Pointerness -> String
    $cshowList :: [Pointerness] -> ShowS
    showList :: [Pointerness] -> ShowS
    Show)

    decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
    decodeLargeBitmap :: LargeBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
    decodeLargeBitmap LargeBitmapGetter
    getterFun# StackSnapshot#
    stackSnapshot# WordOffset
    index WordOffset
    relativePayloadOffset = do
      let largeBitmap :: LargeBitmap
    largeBitmap = case LargeBitmapGetter
    getterFun# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index) of
            (# Addr#
    wordsAddr#, Word#
    size# #) -> Word -> Ptr Word -> LargeBitmap
    LargeBitmap (Word# -> Word
    W# Word#
    size#) (Addr# -> Ptr Word
    forall a. Addr# -> Ptr a
    Ptr Addr#
    wordsAddr#)
      bitmapWords <- LargeBitmap -> IO [Word]
    largeBitmapToList LargeBitmap
    largeBitmap
      pure $ decodeBitmaps
              stackSnapshot#
              (index + relativePayloadOffset)
              (bitmapWordsPointerness (largeBitmapSize largeBitmap) bitmapWords)
      where
        largeBitmapToList :: LargeBitmap -> IO [Word]
        largeBitmapToList :: LargeBitmap -> IO [Word]
    largeBitmapToList LargeBitmap {Word
    Ptr Word
    largeBitmapSize :: LargeBitmap -> Word
    largebitmapWords :: LargeBitmap -> Ptr Word
    largeBitmapSize :: Word
    largebitmapWords :: Ptr Word
    ..} =
          Ptr Word -> Int -> IO [Word]
    cWordArrayToList Ptr Word
    largebitmapWords (Int -> IO [Word]) -> Int -> IO [Word]
    forall a b. (a -> b) -> a -> b
    $
            (Int -> Int
    usedBitmapWords (Int -> Int) -> (Word -> Int) -> Word -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) Word
    largeBitmapSize

        cWordArrayToList :: Ptr Word -> Int -> IO [Word]
        cWordArrayToList :: Ptr Word -> Int -> IO [Word]
    cWordArrayToList Ptr Word
    ptr Int
    size = (Int -> IO Word) -> [Int] -> IO [Word]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Ptr Word -> Int -> IO Word
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word
    ptr) [Int
    0 .. (Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)]

        usedBitmapWords :: Int -> Int
        usedBitmapWords :: Int -> Int
    usedBitmapWords Int
    0 = String -> Int
    forall a. HasCallStack => String -> a
    error String
    "Invalid large bitmap size 0."
        usedBitmapWords Int
    size = (Int
    size Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    wORD_SIZE_IN_BITS) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

        bitmapWordsPointerness :: Word -> [Word] -> [Pointerness]
        bitmapWordsPointerness :: Word -> [Word] -> [Pointerness]
    bitmapWordsPointerness Word
    size [Word]
    _ | Word
    size Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word
    0 = []
        bitmapWordsPointerness Word
    _ [] = []
        bitmapWordsPointerness Word
    size (Word
    w : [Word]
    wds) =
          Word -> Word -> [Pointerness]
    bitmapWordPointerness (Word -> Word -> Word
    forall a. Ord a => a -> a -> a
    min Word
    size (Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    wORD_SIZE_IN_BITS)) Word
    w
            [Pointerness] -> [Pointerness] -> [Pointerness]
    forall a. [a] -> [a] -> [a]
    ++ Word -> [Word] -> [Pointerness]
    bitmapWordsPointerness (Word
    size Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    wORD_SIZE_IN_BITS) [Word]
    wds

    bitmapWordPointerness :: Word -> Word -> [Pointerness]
    bitmapWordPointerness :: Word -> Word -> [Pointerness]
    bitmapWordPointerness Word
    0 Word
    _ = []
    bitmapWordPointerness Word
    bSize Word
    bitmapWord =
      ( if (Word
    bitmapWord Word -> Word -> Word
    forall a. Bits a => a -> a -> a
    .&. Word
    1) Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word
    0
          then Pointerness
    NonPointer
          else Pointerness
    Pointer
      )
        Pointerness -> [Pointerness] -> [Pointerness]
    forall a. a -> [a] -> [a]
    : Word -> Word -> [Pointerness]
    bitmapWordPointerness
          (Word
    bSize Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    1)
          (Word
    bitmapWord Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    1)

    decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> [StackField]
    decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> [StackField]
    decodeBitmaps StackSnapshot#
    stack# WordOffset
    index [Pointerness]
    ps =
      (Pointerness -> WordOffset -> StackField)
    -> [Pointerness] -> [WordOffset] -> [StackField]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Pointerness -> WordOffset -> StackField
    toPayload [Pointerness]
    ps [WordOffset
    index ..]
      where
        toPayload :: Pointerness -> WordOffset -> StackField
        toPayload :: Pointerness -> WordOffset -> StackField
    toPayload Pointerness
    p WordOffset
    i = case Pointerness
    p of
          Pointerness
    NonPointer -> Word -> StackField
    forall b. Word -> GenStackField b
    StackWord (StackSnapshot# -> WordOffset -> Word
    getWord StackSnapshot#
    stack# WordOffset
    i)
          Pointerness
    Pointer -> Box -> StackField
    forall b. b -> GenStackField b
    StackBox (StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stack# WordOffset
    i)

    decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
    decodeSmallBitmap :: SmallBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
    decodeSmallBitmap SmallBitmapGetter
    getterFun# StackSnapshot#
    stackSnapshot# WordOffset
    index WordOffset
    relativePayloadOffset =
      let (Word
    bitmap, Word
    size) = case SmallBitmapGetter
    getterFun# StackSnapshot#
    stackSnapshot# (WordOffset -> Word#
    wordOffsetToWord# WordOffset
    index) of
            (# Word#
    b#, Word#
    s# #) -> (Word# -> Word
    W# Word#
    b#, Word# -> Word
    W# Word#
    s#)
      in StackSnapshot# -> WordOffset -> [Pointerness] -> [StackField]
    decodeBitmaps
          StackSnapshot#
    stackSnapshot#
          (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    relativePayloadOffset)
          (Word -> Word -> [Pointerness]
    bitmapWordPointerness Word
    size Word
    bitmap)

    unpackStackFrame :: StackFrameLocation -> IO StackFrame
    unpackStackFrame :: StackFrameLocation -> IO StackFrame
    unpackStackFrame (StackSnapshot StackSnapshot#
    stackSnapshot#, WordOffset
    index) = do
      info <- StackSnapshot# -> WordOffset -> IO StgInfoTable
    getInfoTableOnStack StackSnapshot#
    stackSnapshot# WordOffset
    index
      unpackStackFrame' info
      where
        unpackStackFrame' :: StgInfoTable -> IO StackFrame
        unpackStackFrame' :: StgInfoTable -> IO StackFrame
    unpackStackFrame' StgInfoTable
    info =
          case StgInfoTable -> ClosureType
    tipe StgInfoTable
    info of
            ClosureType
    RET_BCO -> do
              let bco' :: Box
    bco' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgClosurePayload)
              -- The arguments begin directly after the payload's one element
              bcoArgs' <- LargeBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
    decodeLargeBitmap LargeBitmapGetter
    getBCOLargeBitmap# StackSnapshot#
    stackSnapshot# WordOffset
    index (WordOffset
    offsetStgClosurePayload WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    1)
              pure
                RetBCO
                  { info_tbl = info,
                    bco = bco',
                    bcoArgs = bcoArgs'
                  }
            ClosureType
    RET_SMALL ->
              let payload' :: [StackField]
    payload' = SmallBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
    decodeSmallBitmap SmallBitmapGetter
    getSmallBitmap# StackSnapshot#
    stackSnapshot# WordOffset
    index WordOffset
    offsetStgClosurePayload
              in
                StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $
                  RetSmall
                    { info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info,
                      stack_payload :: [StackField]
    stack_payload = [StackField]
    payload'
                    }
            ClosureType
    RET_BIG -> do
              payload' <- LargeBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
    decodeLargeBitmap LargeBitmapGetter
    getLargeBitmap# StackSnapshot#
    stackSnapshot# WordOffset
    index WordOffset
    offsetStgClosurePayload
              pure $
                RetBig
                  { info_tbl = info,
                    stack_payload = payload'
                  }
            ClosureType
    RET_FUN -> do
              let retFunSize' :: Word
    retFunSize' = StackSnapshot# -> WordOffset -> Word
    getWord StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgRetFunFrameSize)
                  retFunFun' :: Box
    retFunFun' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgRetFunFrameFun)
              retFunPayload' <-
                if StackSnapshot# -> WordOffset -> Bool
    isArgGenBigRetFunType StackSnapshot#
    stackSnapshot# WordOffset
    index Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    True
                  then LargeBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
    decodeLargeBitmap LargeBitmapGetter
    getRetFunLargeBitmap# StackSnapshot#
    stackSnapshot# WordOffset
    index WordOffset
    offsetStgRetFunFramePayload
                  else [StackField] -> IO [StackField]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([StackField] -> IO [StackField])
    -> [StackField] -> IO [StackField]
    forall a b. (a -> b) -> a -> b
    $ SmallBitmapGetter
    -> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
    decodeSmallBitmap SmallBitmapGetter
    getRetFunSmallBitmap# StackSnapshot#
    stackSnapshot# WordOffset
    index WordOffset
    offsetStgRetFunFramePayload
              pure $
                RetFun
                  { info_tbl = info,
                    retFunSize = retFunSize',
                    retFunFun = retFunFun',
                    retFunPayload = retFunPayload'
                  }
            ClosureType
    UPDATE_FRAME ->
              let updatee' :: Box
    updatee' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgUpdateFrameUpdatee)
              in
                StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $
                  UpdateFrame
                    { info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info,
                      updatee :: Box
    updatee = Box
    updatee'
                    }
            ClosureType
    CATCH_FRAME -> do
              let handler' :: Box
    handler' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgCatchFrameHandler)
              StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $
                CatchFrame
                  { info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info,
                    handler :: Box
    handler = Box
    handler'
                  }
            ClosureType
    UNDERFLOW_FRAME -> do
              let nextChunk' :: StackSnapshot
    nextChunk' = StackSnapshot# -> WordOffset -> StackSnapshot
    getUnderflowFrameNextChunk StackSnapshot#
    stackSnapshot# WordOffset
    index
              stackClosure <- StackSnapshot -> IO StgStackClosure
    decodeStack StackSnapshot
    nextChunk'
              pure $
                UnderflowFrame
                  { info_tbl = info,
                    nextChunk = stackClosure
                  }
            ClosureType
    STOP_FRAME -> StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $ StopFrame {info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info}
            ClosureType
    ATOMICALLY_FRAME -> do
              let atomicallyFrameCode' :: Box
    atomicallyFrameCode' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgAtomicallyFrameCode)
                  result' :: Box
    result' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgAtomicallyFrameResult)
              StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $
                AtomicallyFrame
                  { info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info,
                    atomicallyFrameCode :: Box
    atomicallyFrameCode = Box
    atomicallyFrameCode',
                    result :: Box
    result = Box
    result'
                  }
            ClosureType
    CATCH_RETRY_FRAME ->
              let running_alt_code' :: Word
    running_alt_code' = StackSnapshot# -> WordOffset -> Word
    getWord StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgCatchRetryFrameRunningAltCode)
                  first_code' :: Box
    first_code' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgCatchRetryFrameRunningFirstCode)
                  alt_code' :: Box
    alt_code' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgCatchRetryFrameAltCode)
              in
                StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $
                  CatchRetryFrame
                    { info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info,
                      running_alt_code :: Word
    running_alt_code = Word
    running_alt_code',
                      first_code :: Box
    first_code = Box
    first_code',
                      alt_code :: Box
    alt_code = Box
    alt_code'
                    }
            ClosureType
    CATCH_STM_FRAME ->
              let catchFrameCode' :: Box
    catchFrameCode' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgCatchSTMFrameCode)
                  handler' :: Box
    handler' = StackSnapshot# -> WordOffset -> Box
    getClosureBox StackSnapshot#
    stackSnapshot# (WordOffset
    index WordOffset -> WordOffset -> WordOffset
    forall a. Num a => a -> a -> a
    + WordOffset
    offsetStgCatchSTMFrameHandler)
              in
                StackFrame -> IO StackFrame
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (StackFrame -> IO StackFrame) -> StackFrame -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $
                  CatchStmFrame
                    { info_tbl :: StgInfoTable
    info_tbl = StgInfoTable
    info,
                      catchFrameCode :: Box
    catchFrameCode = Box
    catchFrameCode',
                      handler :: Box
    handler = Box
    handler'
                    }
            ClosureType
    x -> String -> IO StackFrame
    forall a. HasCallStack => String -> a
    error (String -> IO StackFrame) -> String -> IO StackFrame
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected closure type on stack: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ClosureType -> String
    forall a. Show a => a -> String
    show ClosureType
    x

    -- | Unbox 'Int#' from 'Int'
    toInt# :: Int -> Int#
    toInt# :: Int -> Int#
    toInt# (I# Int#
    i) = Int#
    i

    -- | Convert `Int` to `Word#`
    intToWord# :: Int -> Word#
    intToWord# :: Int -> Word#
    intToWord# Int
    i = Int# -> Word#
    int2Word# (Int -> Int#
    toInt# Int
    i)

    wordOffsetToWord# :: WordOffset -> Word#
    wordOffsetToWord# :: WordOffset -> Word#
    wordOffsetToWord# WordOffset
    wo = Int -> Word#
    intToWord# (WordOffset -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral WordOffset
    wo)

    -- | Location of a stackframe on the stack
    --
    -- It's defined by the `StackSnapshot` (@StgStack@) and the offset to the bottom
    -- of the stack.
    type StackFrameLocation = (StackSnapshot, WordOffset)

    -- | Decode `StackSnapshot` to a `StgStackClosure`
    --
    -- The return value is the representation of the @StgStack@ itself.
    --
    -- See /Note [Decoding the stack]/.
    decodeStack :: StackSnapshot -> IO StgStackClosure
    decodeStack :: StackSnapshot -> IO StgStackClosure
    decodeStack (StackSnapshot StackSnapshot#
    stack#) = do
      info <- StackSnapshot# -> IO StgInfoTable
    getInfoTableForStack StackSnapshot#
    stack#
      case tipe info of
        ClosureType
    STACK -> do
          let stack_size' :: Word32
    stack_size' = StackSnapshot# -> Word32
    getStackFields StackSnapshot#
    stack#
              sfls :: [StackFrameLocation]
    sfls = StackSnapshot# -> [StackFrameLocation]
    stackFrameLocations StackSnapshot#
    stack#
          stack' <- (StackFrameLocation -> IO StackFrame)
    -> [StackFrameLocation] -> IO [StackFrame]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM StackFrameLocation -> IO StackFrame
    unpackStackFrame [StackFrameLocation]
    sfls
          pure $
            GenStgStackClosure
              { ssc_info = info,
                ssc_stack_size = stack_size',
                ssc_stack = stack'
              }
        ClosureType
    _ -> String -> IO StgStackClosure
    forall a. HasCallStack => String -> a
    error (String -> IO StgStackClosure) -> String -> IO StgStackClosure
    forall a b. (a -> b) -> a -> b
    $ String
    "Expected STACK closure, got " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ StgInfoTable -> String
    forall a. Show a => a -> String
    show StgInfoTable
    info
      where
        stackFrameLocations :: StackSnapshot# -> [StackFrameLocation]
        stackFrameLocations :: StackSnapshot# -> [StackFrameLocation]
    stackFrameLocations StackSnapshot#
    s# =
          StackSnapshot# -> StackFrameLocation
    stackHead StackSnapshot#
    s#
            StackFrameLocation -> [StackFrameLocation] -> [StackFrameLocation]
    forall a. a -> [a] -> [a]
    : Maybe StackFrameLocation -> [StackFrameLocation]
    go (StackFrameLocation -> Maybe StackFrameLocation
    advanceStackFrameLocation (StackSnapshot# -> StackFrameLocation
    stackHead StackSnapshot#
    s#))
          where
            go :: Maybe StackFrameLocation -> [StackFrameLocation]
            go :: Maybe StackFrameLocation -> [StackFrameLocation]
    go Maybe StackFrameLocation
    Nothing = []
            go (Just StackFrameLocation
    r) = StackFrameLocation
    r StackFrameLocation -> [StackFrameLocation] -> [StackFrameLocation]
    forall a. a -> [a] -> [a]
    : Maybe StackFrameLocation -> [StackFrameLocation]
    go (StackFrameLocation -> Maybe StackFrameLocation
    advanceStackFrameLocation StackFrameLocation
    r)

    #else
    module GHC.Exts.Stack.Decode where
    #endif