    {-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving,
        BangPatterns, CPP, MagicHash, FlexibleInstances, FlexibleContexts,
        TypeApplications, ScopedTypeVariables, UnboxedTuples, UndecidableInstances #-}
    module GHCi.ResolvedBCO
      ( ResolvedBCO(..)
      , ResolvedBCOPtr(..)
      , isLittleEndian
      , BCOByteArray(..)
      , mkBCOByteArray
      ) where

    import Prelude -- See note [Why do we import Prelude here?]
    import GHC.Data.SizedSeq
    import GHCi.RemoteTypes
    import GHCi.BreakArray

    import Data.Binary
    import GHC.Generics

    import Foreign.Storable
    import GHC.Exts
    import Data.Array.Base (IArray, UArray(..))

    #include "MachDeps.h"

    isLittleEndian :: Bool
    #if defined(WORDS_BIGENDIAN)
    isLittleEndian = False
    #else
    isLittleEndian :: Bool
    isLittleEndian = Bool
    True
    #endif

    -- -----------------------------------------------------------------------------
    -- ResolvedBCO

    -- | A 'ResolvedBCO' is one in which all the 'Name' references have been
    -- resolved to actual addresses or 'RemoteHValues'.
    --
    data ResolvedBCO
       = ResolvedBCO {
            ResolvedBCO -> Bool
    resolvedBCOIsLE   :: Bool,
            ResolvedBCO -> Int
    resolvedBCOArity  :: {-# UNPACK #-} !Int,
            ResolvedBCO -> BCOByteArray Word16
    resolvedBCOInstrs :: BCOByteArray Word16,       -- insns
            ResolvedBCO -> BCOByteArray Word
    resolvedBCOBitmap :: BCOByteArray Word,         -- bitmap
            ResolvedBCO -> BCOByteArray Word
    resolvedBCOLits   :: BCOByteArray Word,         -- non-ptrs
            ResolvedBCO -> SizedSeq ResolvedBCOPtr
    resolvedBCOPtrs   :: (SizedSeq ResolvedBCOPtr)  -- ptrs
       }
       deriving ((forall x. ResolvedBCO -> Rep ResolvedBCO x)
    -> (forall x. Rep ResolvedBCO x -> ResolvedBCO)
    -> Generic ResolvedBCO
    forall x. Rep ResolvedBCO x -> ResolvedBCO
    forall x. ResolvedBCO -> Rep ResolvedBCO x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ResolvedBCO -> Rep ResolvedBCO x
    from :: forall x. ResolvedBCO -> Rep ResolvedBCO x
    $cto :: forall x. Rep ResolvedBCO x -> ResolvedBCO
    to :: forall x. Rep ResolvedBCO x -> ResolvedBCO
    Generic, Int -> ResolvedBCO -> ShowS
    [ResolvedBCO] -> ShowS
    ResolvedBCO -> String
    (Int -> ResolvedBCO -> ShowS)
    -> (ResolvedBCO -> String)
    -> ([ResolvedBCO] -> ShowS)
    -> Show ResolvedBCO
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ResolvedBCO -> ShowS
    showsPrec :: Int -> ResolvedBCO -> ShowS
    $cshow :: ResolvedBCO -> String
    show :: ResolvedBCO -> String
    $cshowList :: [ResolvedBCO] -> ShowS
    showList :: [ResolvedBCO] -> ShowS
    Show)

    -- | Wrapper for a 'ByteArray#'.
    -- The phantom type tells what elements are stored in the 'ByteArray#'.
    -- Creating a 'ByteArray#' can be achieved using 'UArray''s API,
    -- where the underlying 'ByteArray#' can be unpacked.
    data BCOByteArray a
      = BCOByteArray {
            forall {k} (a :: k). BCOByteArray a -> ByteArray#
    getBCOByteArray :: !ByteArray#
      }

    fromBCOByteArray :: forall a . Storable a => BCOByteArray a -> UArray Int a
    fromBCOByteArray :: forall a. Storable a => BCOByteArray a -> UArray Int a
    fromBCOByteArray (BCOByteArray ByteArray#
    ba#) = Int -> Int -> Int -> ByteArray# -> UArray Int a
    forall i e. i -> i -> Int -> ByteArray# -> UArray i e
    UArray Int
    0 (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int
    n ByteArray#
    ba#
      where
        len# :: Int#
    len# = ByteArray# -> Int#
    sizeofByteArray# ByteArray#
    ba#
        n :: Int
    n = (Int# -> Int
    I# Int#
    len#) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)

    mkBCOByteArray :: UArray Int a -> BCOByteArray a
    mkBCOByteArray :: forall a. UArray Int a -> BCOByteArray a
    mkBCOByteArray (UArray Int
    _ Int
    _ Int
    _ ByteArray#
    arr) = ByteArray# -> BCOByteArray a
    forall {k} (a :: k). ByteArray# -> BCOByteArray a
    BCOByteArray ByteArray#
    arr

    instance Show (BCOByteArray Word16) where
      showsPrec :: Int -> BCOByteArray Word16 -> ShowS
    showsPrec Int
    _ BCOByteArray Word16
    _ = String -> ShowS
    showString String
    "BCOByteArray Word16"

    instance Show (BCOByteArray Word) where
      showsPrec :: Int -> BCOByteArray Word -> ShowS
    showsPrec Int
    _ BCOByteArray Word
    _ = String -> ShowS
    showString String
    "BCOByteArray Word"

    -- | The Binary instance for ResolvedBCOs.
    --
    -- Note, that we do encode the endianness, however there is no support for mixed
    -- endianness setups.  This is primarily to ensure that ghc and iserv share the
    -- same endianness.
    instance Binary ResolvedBCO where
      put :: ResolvedBCO -> Put
    put ResolvedBCO{Bool
    Int
    SizedSeq ResolvedBCOPtr
    BCOByteArray Word
    BCOByteArray Word16
    resolvedBCOIsLE :: ResolvedBCO -> Bool
    resolvedBCOArity :: ResolvedBCO -> Int
    resolvedBCOInstrs :: ResolvedBCO -> BCOByteArray Word16
    resolvedBCOBitmap :: ResolvedBCO -> BCOByteArray Word
    resolvedBCOLits :: ResolvedBCO -> BCOByteArray Word
    resolvedBCOPtrs :: ResolvedBCO -> SizedSeq ResolvedBCOPtr
    resolvedBCOIsLE :: Bool
    resolvedBCOArity :: Int
    resolvedBCOInstrs :: BCOByteArray Word16
    resolvedBCOBitmap :: BCOByteArray Word
    resolvedBCOLits :: BCOByteArray Word
    resolvedBCOPtrs :: SizedSeq ResolvedBCOPtr
    ..} = do
        Bool -> Put
    forall t. Binary t => t -> Put
    put Bool
    resolvedBCOIsLE
        Int -> Put
    forall t. Binary t => t -> Put
    put Int
    resolvedBCOArity
        BCOByteArray Word16 -> Put
    forall t. Binary t => t -> Put
    put BCOByteArray Word16
    resolvedBCOInstrs
        BCOByteArray Word -> Put
    forall t. Binary t => t -> Put
    put BCOByteArray Word
    resolvedBCOBitmap
        BCOByteArray Word -> Put
    forall t. Binary t => t -> Put
    put BCOByteArray Word
    resolvedBCOLits
        SizedSeq ResolvedBCOPtr -> Put
    forall t. Binary t => t -> Put
    put SizedSeq ResolvedBCOPtr
    resolvedBCOPtrs
      get :: Get ResolvedBCO
    get = Bool
    -> Int
    -> BCOByteArray Word16
    -> BCOByteArray Word
    -> BCOByteArray Word
    -> SizedSeq ResolvedBCOPtr
    -> ResolvedBCO
    ResolvedBCO (Bool
     -> Int
     -> BCOByteArray Word16
     -> BCOByteArray Word
     -> BCOByteArray Word
     -> SizedSeq ResolvedBCOPtr
     -> ResolvedBCO)
    -> Get Bool
    -> Get
         (Int
          -> BCOByteArray Word16
          -> BCOByteArray Word
          -> BCOByteArray Word
          -> SizedSeq ResolvedBCOPtr
          -> ResolvedBCO)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Bool
    forall t. Binary t => Get t
    get Get
      (Int
       -> BCOByteArray Word16
       -> BCOByteArray Word
       -> BCOByteArray Word
       -> SizedSeq ResolvedBCOPtr
       -> ResolvedBCO)
    -> Get Int
    -> Get
         (BCOByteArray Word16
          -> BCOByteArray Word
          -> BCOByteArray Word
          -> SizedSeq ResolvedBCOPtr
          -> ResolvedBCO)
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get Int
    forall t. Binary t => Get t
    get Get
      (BCOByteArray Word16
       -> BCOByteArray Word
       -> BCOByteArray Word
       -> SizedSeq ResolvedBCOPtr
       -> ResolvedBCO)
    -> Get (BCOByteArray Word16)
    -> Get
         (BCOByteArray Word
          -> BCOByteArray Word -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get (BCOByteArray Word16)
    forall t. Binary t => Get t
    get Get
      (BCOByteArray Word
       -> BCOByteArray Word -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
    -> Get (BCOByteArray Word)
    -> Get
         (BCOByteArray Word -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get (BCOByteArray Word)
    forall t. Binary t => Get t
    get Get (BCOByteArray Word -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
    -> Get (BCOByteArray Word)
    -> Get (SizedSeq ResolvedBCOPtr -> ResolvedBCO)
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get (BCOByteArray Word)
    forall t. Binary t => Get t
    get Get (SizedSeq ResolvedBCOPtr -> ResolvedBCO)
    -> Get (SizedSeq ResolvedBCOPtr) -> Get ResolvedBCO
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get (SizedSeq ResolvedBCOPtr)
    forall t. Binary t => Get t
    get

    -- See Note [BCOByteArray serialization]
    instance (Binary a, Storable a, IArray UArray a) => Binary (BCOByteArray a) where
      put :: BCOByteArray a -> Put
    put = UArray Int a -> Put
    forall t. Binary t => t -> Put
    put (UArray Int a -> Put)
    -> (BCOByteArray a -> UArray Int a) -> BCOByteArray a -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BCOByteArray a -> UArray Int a
    forall a. Storable a => BCOByteArray a -> UArray Int a
    fromBCOByteArray
      get :: Get (BCOByteArray a)
    get = UArray Int a -> BCOByteArray a
    forall a. UArray Int a -> BCOByteArray a
    mkBCOByteArray (UArray Int a -> BCOByteArray a)
    -> Get (UArray Int a) -> Get (BCOByteArray a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get (UArray Int a)
    forall t. Binary t => Get t
    get

    data ResolvedBCOPtr
      = ResolvedBCORef {-# UNPACK #-} !Int
          -- ^ reference to the Nth BCO in the current set
      | ResolvedBCOPtr {-# UNPACK #-} !(RemoteRef HValue)
          -- ^ reference to a previously created BCO
      | ResolvedBCOStaticPtr {-# UNPACK #-} !(RemotePtr ())
          -- ^ reference to a static ptr
      | ResolvedBCOPtrBCO ResolvedBCO
          -- ^ a nested BCO
      | ResolvedBCOPtrBreakArray {-# UNPACK #-} !(RemoteRef BreakArray)
          -- ^ Resolves to the MutableArray# inside the BreakArray
      deriving ((forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x)
    -> (forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr)
    -> Generic ResolvedBCOPtr
    forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr
    forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x
    from :: forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x
    $cto :: forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr
    to :: forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr
    Generic, Int -> ResolvedBCOPtr -> ShowS
    [ResolvedBCOPtr] -> ShowS
    ResolvedBCOPtr -> String
    (Int -> ResolvedBCOPtr -> ShowS)
    -> (ResolvedBCOPtr -> String)
    -> ([ResolvedBCOPtr] -> ShowS)
    -> Show ResolvedBCOPtr
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ResolvedBCOPtr -> ShowS
    showsPrec :: Int -> ResolvedBCOPtr -> ShowS
    $cshow :: ResolvedBCOPtr -> String
    show :: ResolvedBCOPtr -> String
    $cshowList :: [ResolvedBCOPtr] -> ShowS
    showList :: [ResolvedBCOPtr] -> ShowS
    Show)

    instance Binary ResolvedBCOPtr

    -- Note [BCOByteArray serialization]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- !12142 changed some BCO blob types from UArray to
    -- BCOByteArray(ByteArray#) to save a little space. Unfortunately, a
    -- nasty serialization bug has surfaced since then. It happens when we
    -- need to pass BCOByteArray between host/target with mismatching word
    -- sizes. When 32-bit iserv receives a `BCOByteArray Word` from 64-bit
    -- host GHC, it would parse the buffer assuming each Word=Word32, even
    -- if host GHC assumes each Word=Word64, and of course it's horribly
    -- wrong!
    --
    -- The root issue here is the usage of platform sized integer types in
    -- BCO (and any messages we pass between ghc/iserv really), we should
    -- do what we already do for RemotePtr: always use Word64 instead of
    -- Word. But that takes much more work, and there's an easier
    -- mitigation: keep BCOByteArray as ByteArray#, but serialize it as
    -- UArray, given the Binary instances are independent of platform word
    -- size and endianness, so each Word/Int is always serialized as
    -- 64-bit big-endian Word64/Int64, and the entire UArray is serialized
    -- as a list (length+elements).
    --
    -- Since we erase the metadata in UArray, we need to find a way to
    -- calculate the item count by dividing the ByteArray# length with
    -- element size. The element size comes from Storable's sizeOf method,
    -- thus the addition of Storable constraint.