Cheng Shao pushed to branch wip/faster-linkBCO at Glasgow Haskell Compiler / GHC Commits: d27af92b by Cheng Shao at 2026-03-18T03:04:36+00:00 ghci: use SmallArray directly in ResolvedBCO/UnlinkedBCO This patch makes ghci use `SmallArray` directly in `ResolvedBCO` and `UnlinkedBCO` when applicable, making the memory representation more compact and reducing marshaling overhead. Closes #27058. - - - - - 5 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -87,9 +87,9 @@ bcoFreeNames bco where bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs) = unionManyUniqDSets ( - mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] : - mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] : - map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ] + mkUniqDSet [ n | BCOPtrName n <- smallArrayToList ptrs ] : + mkUniqDSet [ n | BCONPtrItbl n <- smallArrayToList nonptrs ] : + map bco_refs [ bco | BCOPtrBCO bco <- smallArrayToList ptrs ] ) -- ----------------------------------------------------------------------------- @@ -234,8 +234,8 @@ assembleBCO platform , unlinkedBCOArity = arity , unlinkedBCOInstrs = insns_arr , unlinkedBCOBitmap = bitmap_arr - , unlinkedBCOLits = fromSmallArray final_lit_array - , unlinkedBCOPtrs = fromSmallArray final_ptr_array + , unlinkedBCOLits = final_lit_array + , unlinkedBCOPtrs = final_ptr_array } -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -29,7 +29,7 @@ import GHC.Unit.Types import GHC.Data.FastString import GHC.Data.Maybe -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHC.Linker.Types @@ -43,7 +43,8 @@ import GHC.Types.Unique.DFM -- Standard libraries import Control.Concurrent -import Data.Array.Unboxed +import Data.Array.Base +import Data.Array.IO.Internals import Foreign.Ptr import GHC.Exts @@ -62,15 +63,16 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0) - let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits + litsMut <- unsafeNewArray_ (0, sizeofSmallArray lits0 - 1) + flip imapSmallArrayM_ lits0 $ \i lit -> unsafeWrite litsMut i =<< lookupLiteral interp pkgs_loaded bytecode_state lit + lits <- unsafeFreezeIOUArray litsMut + ptrs <- mapSmallArrayIO (resolvePtr interp pkgs_loaded bytecode_state bco_ix) ptrs0 return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity , resolvedBCOInstrs = insns , resolvedBCOBitmap = bitmap - , resolvedBCOLits = mkBCOByteArray lits' - , resolvedBCOPtrs = addListToSS emptySS ptrs + , resolvedBCOLits = mkBCOByteArray lits + , resolvedBCOPtrs = ptrs } lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Data.FlatBag +import GHC.Data.SmallArray import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Binary @@ -250,14 +251,14 @@ data UnlinkedBCO unlinkedBCOArity :: {-# UNPACK #-} !Int, unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap - unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs - unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs + unlinkedBCOLits :: !(SmallArray BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(SmallArray BCOPtr) -- ptrs } instance NFData UnlinkedBCO where rnf UnlinkedBCO{..} = - rnf unlinkedBCOLits `seq` - rnf unlinkedBCOPtrs + rnfSmallArray unlinkedBCOLits `seq` + rnfSmallArray unlinkedBCOPtrs data BCOPtr = BCOPtrName !Name @@ -293,11 +294,10 @@ instance NFData BCONPtr where instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", - ppr (sizeFlatBag lits), text "lits", - ppr (sizeFlatBag ptrs), text "ptrs" ] + ppr (sizeofSmallArray lits), text "lits", + ppr (sizeofSmallArray ptrs), text "ptrs" ] instance Binary FFIInfo where get bh = FFIInfo <$> get bh <*> get bh put_ bh FFIInfo {..} = put_ bh ffiInfoArgs *> put_ bh ffiInfoRet - ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -18,10 +18,9 @@ import Prelude -- See note [Why do we import Prelude here?] import GHCi.ResolvedBCO import GHCi.RemoteTypes import GHCi.BreakArray -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import System.IO (fixIO) -import Control.Monad import Data.Array.Base import Foreign hiding (newArray) import Unsafe.Coerce (unsafeCoerce) @@ -72,9 +71,6 @@ createBCO arr bco linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO linkBCO' arr ResolvedBCO{..} = do let - ptrs = ssElts resolvedBCOPtrs - n_ptrs = sizeSS resolvedBCOPtrs - !(I# arity#) = resolvedBCOArity !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] @@ -83,7 +79,7 @@ linkBCO' arr ResolvedBCO{..} = do bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) literals_barr = barr (getBCOByteArray resolvedBCOLits) - PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + PtrsArr marr <- mkPtrsArray arr resolvedBCOPtrs IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> @@ -92,24 +88,25 @@ linkBCO' arr ResolvedBCO{..} = do -- we recursively link any sub-BCOs while making the ptrs array -mkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr -mkPtrsArray arr n_ptrs ptrs = do - marr <- newPtrsArray (fromIntegral n_ptrs) +mkPtrsArray :: Array Int HValue -> SmallArray ResolvedBCOPtr -> IO PtrsArr +mkPtrsArray arr ptrs = do + let n_ptrs = sizeofSmallArray ptrs + marr <- newPtrsArray n_ptrs let - fill (ResolvedBCORef n) i = + fill i (ResolvedBCORef n) = writePtrsArrayHValue i (arr ! n) marr -- must be lazy! - fill (ResolvedBCOPtr r) i = do + fill i (ResolvedBCOPtr r) = do hv <- localRef r writePtrsArrayHValue i hv marr - fill (ResolvedBCOStaticPtr r) i = do + fill i (ResolvedBCOStaticPtr r) = do writePtrsArrayPtr i (fromRemotePtr r) marr - fill (ResolvedBCOPtrBCO bco) i = do + fill i (ResolvedBCOPtrBCO bco) = do bco <- linkBCO' arr bco writePtrsArrayBCO i bco marr - fill (ResolvedBCOPtrBreakArray r) i = do + fill i (ResolvedBCOPtrBreakArray r) = do BA mba <- localRef r writePtrsArrayMBA i mba marr - zipWithM_ fill ptrs [0..] + flip imapSmallArrayM_ ptrs fill return marr data PtrsArr = PtrsArr (MutableArray# RealWorld HValue) ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -12,7 +12,7 @@ module GHCi.ResolvedBCO #include "MachDeps.h" import Prelude -- See note [Why do we import Prelude here?] -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHCi.RemoteTypes import GHCi.BreakArray @@ -51,13 +51,13 @@ isLittleEndian = True -- data ResolvedBCO = ResolvedBCO { - resolvedBCOIsLE :: Bool, + resolvedBCOIsLE :: !Bool, resolvedBCOArity :: {-# UNPACK #-} !Int, - resolvedBCOInstrs :: BCOByteArray Word16, -- ^ insns - resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap - resolvedBCOLits :: BCOByteArray Word, + resolvedBCOInstrs :: !(BCOByteArray Word16), -- ^ insns + resolvedBCOBitmap :: !(BCOByteArray Word), -- ^ bitmap + resolvedBCOLits :: !(BCOByteArray Word), -- ^ non-ptrs - subword sized entries still take up a full (host) word - resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs + resolvedBCOPtrs :: !(SmallArray ResolvedBCOPtr) -- ^ ptrs } deriving (Generic, Show) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27af92baf3ae319e28fab9902516e77... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27af92baf3ae319e28fab9902516e77... You're receiving this email because of your account on gitlab.haskell.org.