Commit df2ea106 authored by Simon Marlow's avatar Simon Marlow

Compacted arrays are pinned for isByteArrayPinned#

Test Plan: New unit test

Reviewers: andrewthad, niteria, bgamari, erikd

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14900

Differential Revision: https://phabricator.haskell.org/D4485
parent a25b763f
......@@ -160,8 +160,9 @@ stg_isByteArrayPinnedzh ( gcptr ba )
// Pinned byte arrays live in blocks with the BF_PINNED flag set.
// We also consider BF_LARGE objects to be immovable. See #13894.
// See the comment in Storage.c:allocatePinned.
// We also consider BF_COMPACT objects to be immovable. See #14900.
flags = TO_W_(bdescr_flags(bd));
return (flags & (BF_PINNED | BF_LARGE) != 0);
return (flags & (BF_PINNED | BF_LARGE | BF_COMPACT) != 0);
}
stg_isMutableByteArrayPinnedzh ( gcptr mba )
......
{-# LANGUAGE MagicHash, UnboxedTuples #-}
import GHC.Compact
import GHC.Int
import GHC.Prim
import GHC.IO
import GHC.Exts
data BA = ByteArray ByteArray#
newByteArray :: Int -> IO BA
newByteArray (I# sz) = IO $ \s -> case newByteArray# sz s of {
(# s', arr# #) -> case unsafeFreezeByteArray# arr# s of {
(# s'', barr# #) -> (# s', ByteArray barr# #) }}
main :: IO ()
main = do
ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact
ByteArray arr2# <- newByteArray 65000
print (I# (isByteArrayPinned# arr1#))
print (I# (isByteArrayPinned# arr2#))
putStrLn "Finished"
......@@ -388,3 +388,5 @@ test('T14702', [ ignore_stdout
, extra_run_opts('+RTS -A32m -N8 -T -RTS')
]
, compile_and_run, [''])
test('T14900', normal, compile_and_run, ['-package ghc-compact'])
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