Don't consider large byte arrays/compact regions pinned.

Workaround for #22255 which showed how treating large/compact regions
as pinned could cause segfaults.

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

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 )

testsuite/tests/rts/T13894.hs

--- 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"

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

testsuite/tests/rts/T14900.stdout

-1
-1
+0
+0
 Finished