Skip to content
Snippets Groups Projects

Enable use with nonmoving collector

Open Teo Camarasu requested to merge teo/ghc-debug:nonmoving-heap into master
Files
3
@@ -20,6 +20,7 @@ import Data.IORef
import Data.Bits
import Data.List (sort)
import Data.Binary
import Data.Foldable (foldl')
newtype BlockCache = BlockCache (HM.HashMap Word64 RawBlock)
@@ -31,9 +32,11 @@ emptyBlockCache :: BlockCache
emptyBlockCache = BlockCache HM.empty
addBlock :: RawBlock -> BlockCache -> BlockCache
addBlock rb@(RawBlock (BlockPtr bp) _ _) (BlockCache bc) =
BlockCache (HM.insert bp rb bc)
addBlock rb bc = foldl' addBlock' bc $ rb:(nonHeadBlocks rb) -- See Note[Block groups and the block cache]
addBlock' :: BlockCache -> RawBlock -> BlockCache
addBlock' (BlockCache bc) rb@(RawBlock (BlockPtr bp) _ _) =
BlockCache (HM.insert bp rb bc)
addBlocks :: [RawBlock] -> BlockCache -> BlockCache
addBlocks bc bs = Prelude.foldr addBlock bs bc
@@ -80,3 +83,15 @@ handleBlockReq do_req ref PopulateBlockCache = do
-- Note [Block groups and the block cache]
--
-- Block groups on the haskell heap normally only consist of one block,
-- but can be longer, eg, for large/pinned objects, compact regions, or for
-- segments on the nonmoving heap.
--
-- The stub always returns an entire block group as a RawBlock, but when
-- inserting into the BlockCache we need to be careful to split this up
-- into the individual blocks making up the group. So, that when applying
-- the block mask to a closure living in a non-head block, we get a cache
-- hit. We also need to be careful that each block contains the rest of the
-- block group as objects may span multiple blocks.
Loading