diff options
Diffstat (limited to 'libraries/ghci')
| -rw-r--r-- | libraries/ghci/GHCi/CreateBCO.hs | 23 | ||||
| -rw-r--r-- | libraries/ghci/GHCi/RemoteTypes.hs | 2 |
2 files changed, 13 insertions, 12 deletions
diff --git a/libraries/ghci/GHCi/CreateBCO.hs b/libraries/ghci/GHCi/CreateBCO.hs index 96fc4418ff..7098c27fb8 100644 --- a/libraries/ghci/GHCi/CreateBCO.hs +++ b/libraries/ghci/GHCi/CreateBCO.hs @@ -23,6 +23,7 @@ import System.IO (fixIO) import Control.Monad import Data.Array.Base import Foreign hiding (newArray) +import Unsafe.Coerce (unsafeCoerce) import GHC.Arr ( Array(..) ) import GHC.Exts import GHC.IO @@ -44,7 +45,9 @@ createBCO _ ResolvedBCO{..} | resolvedBCOIsLE /= isLittleEndian , "mixed endianness setup is not supported!" ]) createBCO arr bco - = do BCO bco# <- linkBCO' arr bco + = do linked_bco <- linkBCO' arr bco + -- Note [Updatable CAF BCOs] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~ -- Why do we need mkApUpd0 here? Otherwise top-level -- interpreted CAFs don't get updated after evaluation. A -- top-level BCO will evaluate itself and return its value @@ -57,9 +60,10 @@ createBCO arr bco -- (c) An AP is always fully saturated, so we *can't* wrap -- non-zero arity BCOs in an AP thunk. -- + -- See #17424. if (resolvedBCOArity bco > 0) - then return (HValue (unsafeCoerce# bco#)) - else case mkApUpd0# bco# of { (# final_bco #) -> + then return (HValue (unsafeCoerce linked_bco)) + else case mkApUpd0# linked_bco of { (# final_bco #) -> return (HValue final_bco) } @@ -102,8 +106,8 @@ mkPtrsArray arr n_ptrs ptrs = do fill (ResolvedBCOStaticPtr r) i = do writePtrsArrayPtr i (fromRemotePtr r) marr fill (ResolvedBCOPtrBCO bco) i = do - BCO bco# <- linkBCO' arr bco - writePtrsArrayBCO i bco# marr + bco <- linkBCO' arr bco + writePtrsArrayBCO i bco marr fill (ResolvedBCOPtrBreakArray r) i = do BA mba <- localRef r writePtrsArrayMBA i mba marr @@ -130,23 +134,20 @@ writePtrsArrayPtr (I# i) (Ptr a#) (PtrsArr arr) = IO $ \s -> writeArrayAddr# :: MutableArray# s a -> Int# -> Addr# -> State# s -> State# s writeArrayAddr# marr i addr s = unsafeCoerce# writeArray# marr i addr s -writePtrsArrayBCO :: Int -> BCO# -> PtrsArr -> IO () +writePtrsArrayBCO :: Int -> BCO -> PtrsArr -> IO () writePtrsArrayBCO (I# i) bco (PtrsArr arr) = IO $ \s -> case (unsafeCoerce# writeArray#) arr i bco s of s' -> (# s', () #) -data BCO = BCO BCO# - writePtrsArrayMBA :: Int -> MutableByteArray# s -> PtrsArr -> IO () writePtrsArrayMBA (I# i) mba (PtrsArr arr) = IO $ \s -> case (unsafeCoerce# writeArray#) arr i mba s of s' -> (# s', () #) newBCO :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> IO BCO newBCO instrs lits ptrs arity bitmap = IO $ \s -> - case newBCO# instrs lits ptrs arity bitmap s of - (# s1, bco #) -> (# s1, BCO bco #) + newBCO# instrs lits ptrs arity bitmap s {- Note [BCO empty array] - + ~~~~~~~~~~~~~~~~~~~~~~ Lots of BCOs have empty ptrs or nptrs, but empty arrays are not free: they are 2-word heap objects. So let's make a single empty array and share it between all BCOs. diff --git a/libraries/ghci/GHCi/RemoteTypes.hs b/libraries/ghci/GHCi/RemoteTypes.hs index c024ae9fff..6a552f37da 100644 --- a/libraries/ghci/GHCi/RemoteTypes.hs +++ b/libraries/ghci/GHCi/RemoteTypes.hs @@ -33,7 +33,7 @@ import GHC.ForeignPtr -- Static pointers only; don't use this for heap-resident pointers. -- Instead use HValueRef. We will fix the remote pointer to be 64 bits. This -- should cover 64 and 32bit systems, and permits the exchange of remote ptrs --- between machines of different word size. For exmaple, when connecting to +-- between machines of different word size. For example, when connecting to -- an iserv instance on a different architecture with different word size via -- -fexternal-interpreter. newtype RemotePtr a = RemotePtr Word64 |