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