diff options
-rw-r--r-- | libraries/ghc-prim/changelog.md | 7 | ||||
-rw-r--r-- | rts/PrimOps.cmm | 5 | ||||
-rw-r--r-- | testsuite/tests/rts/T13894.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/rts/T14900.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/rts/T14900.stdout | 4 |
5 files changed, 18 insertions, 6 deletions
diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index f62aa2474b..0e909da691 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -21,6 +21,13 @@ - The `threadLabel#` primop was added, allowing the user to query the label of a given `ThreadId#`. +- `isByteArrayPinned#` now only considers an array pinned if it was explicitly pinned + by the user. This is required to avoid ghc issue [#22255](https://gitlab.haskell.org/ghc/ghc/-/issues/22255) + which showed that the old behaviour could cause segfaults when used in combination + with compact regions. + We are working on ways to allow users and library authors to get back the + performance benefits of the old behaviour where possible. + ## 0.9.0 *August 2022* - Shipped with GHC 9.4.1 diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 0868fdaa9e..adb48c97d9 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -209,7 +209,10 @@ stg_isByteArrayPinnedzh ( gcptr ba ) // 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 | BF_COMPACT) != 0); + + // We used to also consider BF_LARGE pinned, but stopped doing so + // because it interacted badly with compact regions. See #22255 + return (flags & BF_PINNED != 0); } stg_isMutableByteArrayPinnedzh ( gcptr mba ) diff --git a/testsuite/tests/rts/T13894.hs b/testsuite/tests/rts/T13894.hs index e09e90802c..226ba18aa7 100644 --- a/testsuite/tests/rts/T13894.hs +++ b/testsuite/tests/rts/T13894.hs @@ -1,5 +1,5 @@ --- Test that isByteArray# returns True for large but not explicitly pinned byte --- arrays +-- Test that isByteArray# returns False for large but not explicitly pinned byte +-- arrays, see #22255 {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} @@ -15,4 +15,4 @@ main = do (# s1, arr# #) -> case isMutableByteArrayPinned# arr# of n# -> (# s1, isTrue# n# #) - unless pinned $ putStrLn "BAD" + when pinned $ putStrLn "BAD" diff --git a/testsuite/tests/rts/T14900.hs b/testsuite/tests/rts/T14900.hs index 613f66d3a9..e1de9a6a89 100644 --- a/testsuite/tests/rts/T14900.hs +++ b/testsuite/tests/rts/T14900.hs @@ -13,6 +13,8 @@ newByteArray (I# sz) = IO $ \s -> case newByteArray# sz s of { (# s', arr# #) -> case unsafeFreezeByteArray# arr# s of { (# s'', barr# #) -> (# s', ByteArray barr# #) }} +-- Currently we expect large/compact regions not to count as pinned. +-- See #22255 for the reasoning. main :: IO () main = do ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact diff --git a/testsuite/tests/rts/T14900.stdout b/testsuite/tests/rts/T14900.stdout index fdc259d094..a74cb09c28 100644 --- a/testsuite/tests/rts/T14900.stdout +++ b/testsuite/tests/rts/T14900.stdout @@ -1,3 +1,3 @@ -1 -1 +0 +0 Finished |