diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2019-08-15 14:37:59 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-10-03 12:17:19 -0400 |
commit | 8a254d6bf46e93285894593da38ef8e5bb8bf206 (patch) | |
tree | 25c19eebf40c8100a4e36c0e568db0655841e1f0 | |
parent | 3b9d4907582e6d167cb7e7a8b1011ad3b0bf646b (diff) | |
download | haskell-8a254d6bf46e93285894593da38ef8e5bb8bf206.tar.gz |
Fix new compact block allocation in allocateForCompact
allocateForCompact() is called when nursery of a compact region is
full, to add new blocks to the compact. New blocks added to an existing
region needs a StgCompactNFDataBlock header, not a StgCompactNFData.
This fixes allocateForCompact() so that it now correctly allocates space
for StgCompactNFDataBlock instead of StgCompactNFData as before.
Fixes #17044.
A regression test T17044 added.
-rw-r--r-- | libraries/ghc-compact/tests/T17044.hs | 30 | ||||
-rw-r--r-- | libraries/ghc-compact/tests/all.T | 1 | ||||
-rw-r--r-- | rts/sm/CNF.c | 3 |
3 files changed, 32 insertions, 2 deletions
diff --git a/libraries/ghc-compact/tests/T17044.hs b/libraries/ghc-compact/tests/T17044.hs new file mode 100644 index 0000000000..1e4a73f5a6 --- /dev/null +++ b/libraries/ghc-compact/tests/T17044.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnboxedTuples #-} + +import Data.Traversable (for) +import GHC.Compact +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + c <- compact () + big <- newByteArray 1032128 + bigFrozen <- unsafeFreezeByteArray big + c' <- compactAdd c bigFrozen + + _placeholders <- for [0 :: Int .. 2044] $ \i -> do + getCompact <$> compactAdd c' i + + return () + +data ByteArray = ByteArray ByteArray# + +data MutableByteArray s = MutableByteArray (MutableByteArray# s) + +newByteArray :: Int -> IO (MutableByteArray RealWorld) +newByteArray (I# n#) = IO (\s# -> case newByteArray# n# s# of (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)) + +unsafeFreezeByteArray :: MutableByteArray RealWorld -> IO ByteArray +unsafeFreezeByteArray (MutableByteArray arr#) = IO (\s# -> case unsafeFreezeByteArray# arr# s# of (# s'#, arr'# #) -> (# s'#, ByteArray arr'# #)) diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T index ec0d20fe05..4a1bab9336 100644 --- a/libraries/ghc-compact/tests/all.T +++ b/libraries/ghc-compact/tests/all.T @@ -21,3 +21,4 @@ test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']), compile_and_run, ['']) test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], compile_and_run, ['']) +test('T17044', normal, compile_and_run, ['']) diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c index 0432505cd2..597b7853bc 100644 --- a/rts/sm/CNF.c +++ b/rts/sm/CNF.c @@ -488,8 +488,7 @@ allocateForCompact (Capability *cap, // We know it doesn't fit in the nursery // if it is a large object, allocate a new block if (sizeW > LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - next_size = BLOCK_ROUND_UP(sizeW*sizeof(W_) + - sizeof(StgCompactNFData)); + next_size = BLOCK_ROUND_UP(sizeW*sizeof(W_) + sizeof(StgCompactNFDataBlock)); block = compactAppendBlock(cap, str, next_size); bd = Bdescr((P_)block); to = bd->free; |