summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libraries/ghc-prim/changelog.md7
-rw-r--r--rts/PrimOps.cmm5
-rw-r--r--testsuite/tests/rts/T13894.hs6
-rw-r--r--testsuite/tests/rts/T14900.hs2
-rw-r--r--testsuite/tests/rts/T14900.stdout4
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