Cheng Shao pushed to branch wip/faster-linkBCO at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/ByteCode/Asm.hs
    ... ... @@ -87,9 +87,9 @@ bcoFreeNames bco
    87 87 
       where
    88 88 
         bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
    89 89 
             = unionManyUniqDSets (
    90 
    -             mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] :
    91 
    -             mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] :
    92 
    -             map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ]
    90 
    +             mkUniqDSet [ n | BCOPtrName n <- smallArrayToList ptrs ] :
    91 
    +             mkUniqDSet [ n | BCONPtrItbl n <- smallArrayToList nonptrs ] :
    92 
    +             map bco_refs [ bco | BCOPtrBCO bco <- smallArrayToList ptrs ]
    93 93 
               )
    94 94
    95 95 
     -- -----------------------------------------------------------------------------
    ... ... @@ -234,8 +234,8 @@ assembleBCO platform
    234 234 
                                , unlinkedBCOArity = arity
    235 235 
                                , unlinkedBCOInstrs = insns_arr
    236 236 
                                , unlinkedBCOBitmap = bitmap_arr
    237 
    -                           , unlinkedBCOLits = fromSmallArray final_lit_array
    238 
    -                           , unlinkedBCOPtrs = fromSmallArray final_ptr_array
    237 
    +                           , unlinkedBCOLits = final_lit_array
    238 
    +                           , unlinkedBCOPtrs = final_ptr_array
    239 239 
                                }
    240 240
    241 241 
       -- 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
    29 29
    30 30 
     import GHC.Data.FastString
    31 31 
     import GHC.Data.Maybe
    32 
    -import GHC.Data.SizedSeq
    32 
    +import GHC.Data.SmallArray
    33 33
    34 34 
     import GHC.Linker.Types
    35 35
    ... ... @@ -43,7 +43,8 @@ import GHC.Types.Unique.DFM
    43 43
    44 44 
     -- Standard libraries
    45 45 
     import Control.Concurrent
    46 
    -import Data.Array.Unboxed
    46 
    +import Data.Array.Base
    47 
    +import Data.Array.IO.Internals
    47 48 
     import Foreign.Ptr
    48 49 
     import GHC.Exts
    49 50
    ... ... @@ -62,15 +63,16 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix
    62 63 
                (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do
    63 64 
       -- fromIntegral Word -> Word64 should be a no op if Word is Word64
    64 65 
       -- otherwise it will result in a cast to longlong on 32bit systems.
    65 
    -  (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0)
    66 
    -  ptrs <- mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0)
    67 
    -  let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits
    66 
    +  litsMut <- unsafeNewArray_ (0, sizeofSmallArray lits0 - 1)
    67 
    +  flip imapSmallArrayM_ lits0 $ \i lit -> unsafeWrite litsMut i =<< lookupLiteral interp pkgs_loaded bytecode_state lit
    68 
    +  lits <- unsafeFreezeIOUArray litsMut
    69 
    +  ptrs <- mapSmallArrayIO (resolvePtr interp pkgs_loaded bytecode_state bco_ix) ptrs0
    68 70 
       return $ ResolvedBCO { resolvedBCOIsLE   = isLittleEndian
    69 71 
                            , resolvedBCOArity  = arity
    70 72 
                            , resolvedBCOInstrs = insns
    71 73 
                            , resolvedBCOBitmap = bitmap
    72 
    -                       , resolvedBCOLits   = mkBCOByteArray lits'
    73 
    -                       , resolvedBCOPtrs   = addListToSS emptySS ptrs
    74 
    +                       , resolvedBCOLits   = mkBCOByteArray lits
    75 
    +                       , resolvedBCOPtrs   = ptrs
    74 76 
                            }
    75 77
    76 78 
     lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word

  • compiler/GHC/ByteCode/Types.hs
    ... ... @@ -32,6 +32,7 @@ import GHC.Prelude
    32 32
    33 33 
     import GHC.Data.FastString
    34 34 
     import GHC.Data.FlatBag
    35 
    +import GHC.Data.SmallArray
    35 36 
     import GHC.Types.Name
    36 37 
     import GHC.Types.Name.Env
    37 38 
     import GHC.Utils.Binary
    ... ... @@ -250,14 +251,14 @@ data UnlinkedBCO
    250 251 
             unlinkedBCOArity  :: {-# UNPACK #-} !Int,
    251 252 
             unlinkedBCOInstrs :: !(BCOByteArray Word16),      -- insns
    252 253 
             unlinkedBCOBitmap :: !(BCOByteArray Word),      -- bitmap
    253 
    -        unlinkedBCOLits   :: !(FlatBag BCONPtr),       -- non-ptrs
    254 
    -        unlinkedBCOPtrs   :: !(FlatBag BCOPtr)         -- ptrs
    254 
    +        unlinkedBCOLits   :: !(SmallArray BCONPtr),       -- non-ptrs
    255 
    +        unlinkedBCOPtrs   :: !(SmallArray BCOPtr)         -- ptrs
    255 256 
        }
    256 257
    257 258 
     instance NFData UnlinkedBCO where
    258 259 
       rnf UnlinkedBCO{..} =
    259 
    -    rnf unlinkedBCOLits `seq`
    260 
    -    rnf unlinkedBCOPtrs
    260 
    +    rnfSmallArray unlinkedBCOLits `seq`
    261 
    +    rnfSmallArray unlinkedBCOPtrs
    261 262
    262 263 
     data BCOPtr
    263 264 
       = BCOPtrName   !Name
    ... ... @@ -293,11 +294,10 @@ instance NFData BCONPtr where
    293 294 
     instance Outputable UnlinkedBCO where
    294 295 
        ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
    295 296 
           = sep [text "BCO", ppr nm, text "with",
    296 
    -             ppr (sizeFlatBag lits), text "lits",
    297 
    -             ppr (sizeFlatBag ptrs), text "ptrs" ]
    297 
    +             ppr (sizeofSmallArray lits), text "lits",
    298 
    +             ppr (sizeofSmallArray ptrs), text "ptrs" ]
    298 299
    299 300 
     instance Binary FFIInfo where
    300 301 
       get bh = FFIInfo <$> get bh <*> get bh
    301 302
    302 303 
       put_ bh FFIInfo {..} = put_ bh ffiInfoArgs *> put_ bh ffiInfoRet
    303 
    -

  • libraries/ghci/GHCi/CreateBCO.hs
    ... ... @@ -18,10 +18,9 @@ import Prelude -- See note [Why do we import Prelude here?]
    18 18 
     import GHCi.ResolvedBCO
    19 19 
     import GHCi.RemoteTypes
    20 20 
     import GHCi.BreakArray
    21 
    -import GHC.Data.SizedSeq
    21 
    +import GHC.Data.SmallArray
    22 22
    23 23 
     import System.IO (fixIO)
    24 
    -import Control.Monad
    25 24 
     import Data.Array.Base
    26 25 
     import Foreign hiding (newArray)
    27 26 
     import Unsafe.Coerce (unsafeCoerce)
    ... ... @@ -72,9 +71,6 @@ createBCO arr bco
    72 71 
     linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO
    73 72 
     linkBCO' arr ResolvedBCO{..} = do
    74 73 
       let
    75 
    -      ptrs   = ssElts resolvedBCOPtrs
    76 
    -      n_ptrs = sizeSS resolvedBCOPtrs
    77 
    -
    78 74 
           !(I# arity#)  = resolvedBCOArity
    79 75
    80 76 
           !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array]
    ... ... @@ -83,7 +79,7 @@ linkBCO' arr ResolvedBCO{..} = do
    83 79 
           bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap)
    84 80 
           literals_barr = barr (getBCOByteArray resolvedBCOLits)
    85 81
    86 
    -  PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs
    82 
    +  PtrsArr marr <- mkPtrsArray arr resolvedBCOPtrs
    87 83 
       IO $ \s ->
    88 84 
         case unsafeFreezeArray# marr s of { (# s, arr #) ->
    89 85 
         case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io ->
    ... ... @@ -92,24 +88,25 @@ linkBCO' arr ResolvedBCO{..} = do
    92 88
    93 89
    94 90 
     -- we recursively link any sub-BCOs while making the ptrs array
    95 
    -mkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr
    96 
    -mkPtrsArray arr n_ptrs ptrs = do
    97 
    -  marr <- newPtrsArray (fromIntegral n_ptrs)
    91 
    +mkPtrsArray :: Array Int HValue -> SmallArray ResolvedBCOPtr -> IO PtrsArr
    92 
    +mkPtrsArray arr ptrs = do
    93 
    +  let n_ptrs = sizeofSmallArray ptrs
    94 
    +  marr <- newPtrsArray n_ptrs
    98 95 
       let
    99 
    -    fill (ResolvedBCORef n) i =
    96 
    +    fill i (ResolvedBCORef n) =
    100 97 
           writePtrsArrayHValue i (arr ! n) marr  -- must be lazy!
    101 
    -    fill (ResolvedBCOPtr r) i = do
    98 
    +    fill i (ResolvedBCOPtr r) = do
    102 99 
           hv <- localRef r
    103 100 
           writePtrsArrayHValue i hv marr
    104 
    -    fill (ResolvedBCOStaticPtr r) i = do
    101 
    +    fill i (ResolvedBCOStaticPtr r) = do
    105 102 
           writePtrsArrayPtr i (fromRemotePtr r)  marr
    106 
    -    fill (ResolvedBCOPtrBCO bco) i = do
    103 
    +    fill i (ResolvedBCOPtrBCO bco) = do
    107 104 
           bco <- linkBCO' arr bco
    108 105 
           writePtrsArrayBCO i bco marr
    109 
    -    fill (ResolvedBCOPtrBreakArray r) i = do
    106 
    +    fill i (ResolvedBCOPtrBreakArray r) = do
    110 107 
           BA mba <- localRef r
    111 108 
           writePtrsArrayMBA i mba marr
    112 
    -  zipWithM_ fill ptrs [0..]
    109 
    +  flip imapSmallArrayM_ ptrs fill
    113 110 
       return marr
    114 111
    115 112 
     data PtrsArr = PtrsArr (MutableArray# RealWorld HValue)

  • libraries/ghci/GHCi/ResolvedBCO.hs
    ... ... @@ -12,7 +12,7 @@ module GHCi.ResolvedBCO
    12 12 
     #include "MachDeps.h"
    13 13
    14 14 
     import Prelude -- See note [Why do we import Prelude here?]
    15 
    -import GHC.Data.SizedSeq
    15 
    +import GHC.Data.SmallArray
    16 16 
     import GHCi.RemoteTypes
    17 17 
     import GHCi.BreakArray
    18 18
    ... ... @@ -51,13 +51,13 @@ isLittleEndian = True
    51 51 
     --
    52 52 
     data ResolvedBCO
    53 53 
        = ResolvedBCO {
    54 
    -        resolvedBCOIsLE   :: Bool,
    54 
    +        resolvedBCOIsLE   :: !Bool,
    55 55 
             resolvedBCOArity  :: {-# UNPACK #-} !Int,
    56 
    -        resolvedBCOInstrs :: BCOByteArray Word16,       -- ^ insns
    57 
    -        resolvedBCOBitmap :: BCOByteArray Word,         -- ^ bitmap
    58 
    -        resolvedBCOLits   :: BCOByteArray Word,
    56 
    +        resolvedBCOInstrs :: !(BCOByteArray Word16),       -- ^ insns
    57 
    +        resolvedBCOBitmap :: !(BCOByteArray Word),         -- ^ bitmap
    58 
    +        resolvedBCOLits   :: !(BCOByteArray Word),
    59 59 
               -- ^ non-ptrs - subword sized entries still take up a full (host) word
    60 
    -        resolvedBCOPtrs   :: (SizedSeq ResolvedBCOPtr)  -- ^ ptrs
    60 
    +        resolvedBCOPtrs   :: !(SmallArray ResolvedBCOPtr) -- ^ ptrs
    61 61 
        }
    62 62 
        deriving (Generic, Show)
    63 63

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help