Commit 8a254d6b authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

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.
parent 3b9d4907
{-# 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'# #))
......@@ -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, [''])
......@@ -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;
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment