Make pinned a per object property.wip/andreask/pin_array_info

We now store if a byte array is pinned in the info table.
This allows us to pin large byte arrays inplace.

13 files changed, 258 insertions, 8 deletions

diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 1fc7bd5f23..ce3f31e92e 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -1735,14 +1735,48 @@ primop  NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp
    with out_of_line = True
         has_side_effects = True
 
+primop  UnsafePinMutableByteArrayOp "unsafePinMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> State# s -> (# State# s, MutableByteArray# s #)
+   {Returns a pinned version of the given mutable byte array.
+
+   * If possible the byte array will be pinned in place.
+   * If not a pinned array will be allocated and the contents of the given array will
+     be copied into it.
+
+   If pinning was in-place or not can be checked by calling sameByteArray# with
+   the the argument and result of unsafePinMutableByteArray#.
+
+   Generally the argument will be pinned in place if:
+   * The argument array is large enough to be considered a large object by the RTS.
+   * The argument array is part of a compact region.
+   * The argument array is already pinned (making this a no-op).
+   But the circumstances which allow a byte array to be pinned in place might
+   change in future releases of GHC.
+
+   This function is considered unsafe as it can change the pinnedness of the argument
+   which can break code using compact region. If this is a concern it's always possible
+   to explicitly allocate a new array and copy over the contents.}
+   with out_of_line = True
+        has_side_effects = True
+
 primop  MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp
    MutableByteArray# s -> Int#
+   {Determine whether a 'MutableByteArray#' is guaranteed not to move.}
+   with out_of_line = True
+
+primop  MutableByteArrayIsGcPinnedOp "isMutableByteArrayGcPinned#" GenPrimOp
+   MutableByteArray# s -> Int#
    {Determine whether a 'MutableByteArray#' is guaranteed not to move
    during GC.}
    with out_of_line = True
 
 primop  ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp
    ByteArray# -> Int#
+   {Determine whether a 'ByteArray#' is guaranteed not to move.}
+   with out_of_line = True
+
+primop  ByteArrayIsGcPinnedOp "isByteArrayGcPinned#" GenPrimOp
+   ByteArray# -> Int#
    {Determine whether a 'ByteArray#' is guaranteed not to move during GC.}
    with out_of_line = True
 
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 96f78b6789..25a61d226c 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -66,6 +66,7 @@ module GHC.Cmm.CLabel (
         mkBadAlignmentLabel,
         mkOutOfBoundsAccessLabel,
         mkArrWords_infoLabel,
+        mkArrWordsPinned_infoLabel,
         mkSRTInfoLabel,
 
         mkTopTickyCtrLabel,
@@ -645,6 +646,7 @@ mkDirty_MUT_VAR_Label,
     mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,
     mkMAP_DIRTY_infoLabel,
     mkArrWords_infoLabel,
+    mkArrWordsPinned_infoLabel,
     mkTopTickyCtrLabel,
     mkCAFBlackHoleInfoTableLabel,
     mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,
@@ -663,6 +665,7 @@ mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsL
 mkTopTickyCtrLabel              = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "top_ct")                CmmData
 mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
 mkArrWords_infoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS")         CmmInfo
+mkArrWordsPinned_infoLabel      = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS_PINNED")         CmmInfo
 mkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
 mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
 mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 7366c529c8..8ca6cd1b68 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1550,10 +1550,13 @@ emitPrimOp cfg primop =
   NewPinnedByteArrayOp_Char -> alwaysExternal
   NewAlignedPinnedByteArrayOp_Char -> alwaysExternal
   MutableByteArrayIsPinnedOp -> alwaysExternal
+  MutableByteArrayIsGcPinnedOp -> alwaysExternal
+  UnsafePinMutableByteArrayOp -> alwaysExternal
   DoubleDecode_2IntOp -> alwaysExternal
   DoubleDecode_Int64Op -> alwaysExternal
   FloatDecode_IntOp -> alwaysExternal
   ByteArrayIsPinnedOp -> alwaysExternal
+  ByteArrayIsGcPinnedOp -> alwaysExternal
   ShrinkMutableByteArrayOp_Char -> alwaysExternal
   ResizeMutableByteArrayOp_Char -> alwaysExternal
   ShrinkSmallMutableArrayOp_Char -> alwaysExternal
diff --git a/docs/users_guide/exts/ffi.rst b/docs/users_guide/exts/ffi.rst
index b490ac662d..05009085aa 100644
--- a/docs/users_guide/exts/ffi.rst
+++ b/docs/users_guide/exts/ffi.rst
@@ -1102,23 +1102,51 @@ to the floating point state, so that if you really need to use
 Pinned Byte Arrays
 ~~~~~~~~~~~~~~~~~~
 
-A pinned byte array is one that the garbage collector is not allowed
+A pinned byte array is one that is not allowed
 to move. Consequently, it has a stable address that can be safely
 requested with ``byteArrayContents#``. Not that being pinned doesn't
 prevent the byteArray from being gc'ed in the same fashion a regular
 byte array would be.
 There are a handful of primitive functions in :base-ref:`GHC.Exts.`
 used to enforce or check for pinnedness: ``isByteArrayPinned#``,
-``isMutableByteArrayPinned#``, and ``newPinnedByteArray#``. A
-byte array can be pinned as a result of three possible causes:
+``isMutableByteArrayPinned#``, ``unsafePinMutableByteArray#`` and
+``newPinnedByteArray#``. A byte array can be pinned as a result of two
+possible causes:
 
 1. It was allocated by ``newPinnedByteArray#``.
+2. It was pinned by a call to ``unsafePinMutableByteArray``.
+
+Every regular pinned byte array is also gc pinned. Since it never being
+allowed to move implies it's also not allowed to move during gc.
+
+GcPinned Byte Arrays
+~~~~~~~~~~~~~~~~~~~~
+These are very similar to regular pinned byte arrays. Just like
+regular pinned byte arrays they are never moved during gc.
+
+The main difference is that they are allowed to be moved for other (non-gc)
+reasons. Currently the only reason this might happen is the construction of
+compact regions. But other reasons might be added in future released. For example
+we might start to compact large objects inside the heap in future releases.
+
+A byte array can be gc pinned as a result of three possible causes:
+
+1. It's a regular pinned byte arrays.
 2. It is large. Currently, GHC defines large object to be one
    that is at least as large as 80% of a 4KB block (i.e. at
    least 3277 bytes).
 3. It has been copied into a compact region. The documentation
    for ``ghc-compact`` and ``compact`` describes this process.
 
+However ``byteArrayContents#`` can still be unsafe on these arrays.
+For example such arrays might be copied into compact regions which
+will invalidate any pointer into the payload of the copied arrays.
+This happened in #22255.
+
+If a regular pinned version of such an array is needed ``unsafePinMutableByteArray#``
+can be used. It will try to turn the array into a pinned one without copying if
+possible and only creating a pinned copy if this can't be avoided.
+
 .. [1] Prior to GHC 8.10, when passing an ``ArrayArray#`` argument
   to a foreign function, the foreign function would see a pointer
   to the ``StgMutArrPtrs`` rather than just the payload.
diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md
index f62aa2474b..32e44c7d84 100644
--- a/libraries/ghc-prim/changelog.md
+++ b/libraries/ghc-prim/changelog.md
@@ -1,3 +1,16 @@
+## 0.11.0
+
+- Added to `GHC.Prim`:
+
+        isByteArrayGcPinned# :: ByteArray# -> Int#
+        isMutableByteArrayGcPinned# :: MutableByteArray# s -> Int#
+        unsafePinMutableByteArray# :: MutableByteArray# s -> s -> (# s, MutableByteArray# s #)
+
+  These operations allow users to distinguish between objects which are never
+  moved and those not moved during GC. The former might be moved only by user
+  request. For example when compacting a data structure. It also allows for a more
+  convenient/efficient way to get a pinned version of an already allocated byte array.
+
 ## 0.10.0
 
 - Shipped with GHC 9.6.1
diff --git a/rts/Compact.cmm b/rts/Compact.cmm
index ecb694cf5c..664a91a655 100644
--- a/rts/Compact.cmm
+++ b/rts/Compact.cmm
@@ -143,7 +143,10 @@ eval:
     }
 
     case ARR_WORDS: {
-
+        // Lives in large object block/compact region but explicitly marked pinned.
+        if(info == stg_ARR_WORDS_PINNED_info) {
+            jump stg_raisezh(base_GHCziIOziException_cannotCompactPinned_closure);
+        }
         (should) = ccall shouldCompact(compact "ptr", p "ptr");
         if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); }
         if (should == SHOULDCOMPACT_PINNED) {
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index fe74b3fa81..ea60d4d62a 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1,4 +1,4 @@
-/* -*- tab-width: 8 -*- */
+ /* -*- tab-width: 8 -*- */
 /* -----------------------------------------------------------------------------
  *
  * (c) The GHC Team, 1998-2012
@@ -58,6 +58,7 @@ import CLOSURE stable_ptr_table;
 import CLOSURE stg_AP_STACK_info;
 import CLOSURE stg_AP_info;
 import CLOSURE stg_ARR_WORDS_info;
+import CLOSURE stg_ARR_WORDS_PINNED_info;
 import CLOSURE stg_BCO_info;
 import CLOSURE stg_C_FINALIZER_LIST_info;
 import CLOSURE stg_DEAD_WEAK_info;
@@ -159,7 +160,7 @@ stg_newPinnedByteArrayzh ( W_ n )
     TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0);
 
     /* No write barrier needed since this is a new allocation. */
-    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+    SET_HDR(p, stg_ARR_WORDS_PINNED_info, CCCS);
     StgArrBytes_bytes(p) = n;
     return (p);
 }
@@ -194,7 +195,7 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
     TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0);
 
     /* No write barrier needed since this is a new allocation. */
-    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+    SET_HDR(p, stg_ARR_WORDS_PINNED_info, CCCS);
     StgArrBytes_bytes(p) = n;
     return (p);
 }
@@ -202,6 +203,40 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
 stg_isByteArrayPinnedzh ( gcptr ba )
 // ByteArray# s -> Int#
 {
+    return (GET_INFO(ba) == stg_ARR_WORDS_PINNED_info);
+}
+
+stg_unsafePinMutableByteArrayzh ( gcptr ba )
+{
+    //It's already pinned, return as-is.
+    if(GET_INFO(ba) == stg_ARR_WORDS_PINNED_info) {
+        return (ba);
+    } else {
+    // If the object is large or in a compact region allow
+    // pinning in-place.
+        W_ bd, flags;
+        bd = Bdescr(ba);
+        flags = TO_W_(bdescr_flags(bd));
+        if(flags & (BF_PINNED | BF_LARGE | BF_COMPACT) != 0) {
+            SET_INFO(ba,stg_ARR_WORDS_PINNED_info);
+            return (ba);
+    // Otherwise we have no choice but to create a copy.
+        } else {
+            W_ n;
+            //Otherwise allocate a new array and copy the contents.
+            n = StgArrBytes_bytes(ba);
+            (P_ pinned) = call stg_newPinnedByteArrayzh(n);
+            prim %memcpy(BYTE_ARR_CTS(pinned), BYTE_ARR_CTS(ba),
+                        n, SIZEOF_W);
+            return(pinned);//
+        };
+    };
+}
+
+// Doesn't move during GC so safe for FFI
+stg_isByteArrayGcPinnedzh ( gcptr ba )
+// ByteArray# s -> Int#
+{
     W_ bd, flags;
     bd = Bdescr(ba);
     // Pinned byte arrays live in blocks with the BF_PINNED flag set.
@@ -218,6 +253,12 @@ stg_isMutableByteArrayPinnedzh ( gcptr mba )
     jump stg_isByteArrayPinnedzh(mba);
 }
 
+stg_isMutableByteArrayGcPinnedzh ( gcptr mba )
+// MutableByteArray# s -> Int#
+{
+    jump stg_isByteArrayGcPinnedzh(mba);
+}
+
 /* Note [LDV profiling and resizing arrays]
  * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  * As far as the LDV profiler is concerned arrays are "inherently used" which
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index fb52996846..89c503c623 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -775,6 +775,7 @@ extern char **environ;
       SymI_HasDataProto(stg_newPinnedByteArrayzh)                           \
       SymI_HasDataProto(stg_newAlignedPinnedByteArrayzh)                    \
       SymI_HasDataProto(stg_isByteArrayPinnedzh)                            \
+      SymI_HasDataProto(stg_unsafePinMutableByteArrayzh)                    \
       SymI_HasDataProto(stg_isMutableByteArrayPinnedzh)                     \
       SymI_HasDataProto(stg_shrinkMutableByteArrayzh)                       \
       SymI_HasDataProto(stg_resizzeMutableByteArrayzh)                      \
@@ -881,6 +882,7 @@ extern char **environ;
       SymI_HasDataProto(stg_TVAR_DIRTY_info)                                \
       SymI_HasDataProto(stg_IND_STATIC_info)                                \
       SymI_HasDataProto(stg_ARR_WORDS_info)                                 \
+      SymI_HasDataProto(stg_ARR_WORDS_PINNED_info)                          \
       SymI_HasDataProto(stg_MUT_ARR_PTRS_DIRTY_info)                        \
       SymI_HasDataProto(stg_MUT_ARR_PTRS_FROZEN_CLEAN_info)                 \
       SymI_HasDataProto(stg_MUT_ARR_PTRS_FROZEN_DIRTY_info)                 \
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 013db8731b..8b0471fbd7 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -870,6 +870,9 @@ CLOSURE(stg_STM_AWOKEN_closure,stg_STM_AWOKEN);
 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
 { foreign "C" barf("ARR_WORDS object (%p) entered!", R1) never returns; }
 
+INFO_TABLE(stg_ARR_WORDS_PINNED, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
+{ foreign "C" barf("ARR_WORDS_PINNED object (%p) entered!", R1) never returns; }
+
 INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")
 { foreign "C" barf("MUT_ARR_PTRS_CLEAN object (%p) entered!", R1) never returns; }
 
diff --git a/rts/include/stg/MiscClosures.h b/rts/include/stg/MiscClosures.h
index 257d59a607..d93fc519e2 100644
--- a/rts/include/stg/MiscClosures.h
+++ b/rts/include/stg/MiscClosures.h
@@ -186,7 +186,7 @@ RTS_ENTRY(stg_TSO);
 RTS_ENTRY(stg_STACK);
 RTS_ENTRY(stg_RUBBISH_ENTRY);
 RTS_ENTRY(stg_ARR_WORDS);
-RTS_ENTRY(stg_MUT_ARR_WORDS);
+RTS_ENTRY(stg_ARR_WORDS_PINNED);
 RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN);
 RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY);
 RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_CLEAN);
@@ -452,6 +452,7 @@ RTS_FUN_DECL(stg_newByteArrayzh);
 RTS_FUN_DECL(stg_newPinnedByteArrayzh);
 RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
 RTS_FUN_DECL(stg_isByteArrayPinnedzh);
+RTS_FUN_DECL(stg_unsafePinMutableByteArrayzh);
 RTS_FUN_DECL(stg_isMutableByteArrayPinnedzh);
 RTS_FUN_DECL(stg_shrinkMutableByteArrayzh);
 RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
diff --git a/testsuite/tests/primops/should_run/PinByteArray.hs b/testsuite/tests/primops/should_run/PinByteArray.hs
new file mode 100644
index 0000000000..2936baa7dd
--- /dev/null
+++ b/testsuite/tests/primops/should_run/PinByteArray.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
+module Main where
+
+import Data.Kind
+import System.Mem (performGC)
+import GHC.Exts
+import GHC.IO
+import GHC.Prim
+-- import GHC.ForeignPtr
+import GHC.Compact
+import Control.Exception
+
+data U (a :: UnliftedType) = U { unu :: a }
+
+primIO :: (State# RealWorld -> (# State# RealWorld, (a :: UnliftedType) #)) -> IO (U a)
+primIO act = IO $ \s -> case act s of (# s, r #) -> (# s, U r #)
+
+isPinned (U b) = isTrue# (isMutableByteArrayPinned# b)
+
+sameArray (U a) (U b) = isTrue# (sameMutableByteArray# a b)
+
+main :: IO ()
+main = do
+    unpinned <- primIO (newByteArray# 10#)
+    large <- primIO (newByteArray# 10000#)
+    pinned <- primIO (newPinnedByteArray# 1#)
+    compact_region <- compact $ large
+    let ar_compact = getCompact compact_region
+    let arrs = [unpinned,large,pinned,ar_compact]
+
+    putStr "Small:"
+    print $ isPinned unpinned
+    putStr "Large:"
+    print $ isPinned large
+    putStr "Compacted:"
+    print $ isPinned ar_compact
+    putStr "Pinned:"
+    print $ isPinned pinned
+
+    -- Try to compact the three types of arrays.
+    !_ <- compact unpinned -- Expected to work
+    !_ <- compact large -- Expected to work
+    !_ <- compact ar_compact -- Expected to work
+    -- This one should fail.
+    catch (compact pinned >> return ()) (\(e :: CompactionFailed) -> print "Failed to compact pinned array as expected." >> return ())
+
+    -- Call unsafePinMutableByteArray# on all arrays.
+    [pinned_unpinned, pinned_large, pinned_pinned, pinned_compact] <- mapM (\(U arr) -> primIO (unsafePinMutableByteArray# arr)) arrs
+
+    putStrLn "Pinnedness of original array references after unsafePinMutableByteArray#"
+    -- The large one should be pinned now
+    putStr "Small:"
+    print $ isPinned unpinned
+    putStr "Large:"
+    print $ isPinned large
+    putStrLn "Compacted:"
+    print $ isPinned ar_compact
+    putStrLn "Pinned:"
+    print $ isPinned pinned
+
+    putStrLn "Pinnedness of arrays returned from unsafePinMutableByteArray#"
+    -- These should all be pinned now
+    putStr "Small:"
+    print $ isPinned pinned_unpinned
+    putStr "Large:"
+    print $ isPinned pinned_large
+    putStr "Compacted:"
+    print $ isPinned pinned_compact
+    putStr "Pinned:"
+    print $ isPinned pinned_pinned
+
+    putStrLn "Have references been pinned in-place?"
+    -- The large and pinned array should have been pinned in place.
+    putStr "Small:"
+    print $ sameArray unpinned pinned_unpinned
+    putStr "Large:"
+    print $ sameArray large pinned_large
+    putStr "Compacted:"
+    print $ sameArray ar_compact pinned_compact
+    putStr "Pinned:"
+    print $ sameArray pinned pinned_pinned
+
+    -- The large array should have been pinned in place and therefore should fail to compact.
+    catch (compact large >> return ()) (\(e :: CompactionFailed) -> print "Failed to compact large array post-pin(expected to fail)." >> return ())
+    catch (compact ar_compact >> return ()) (\(e :: CompactionFailed) -> print "Failed to compact ar_compact array post-pin(expected to fail)." >> return ())
+
+    return ()
diff --git a/testsuite/tests/primops/should_run/PinByteArray.stdout b/testsuite/tests/primops/should_run/PinByteArray.stdout
new file mode 100644
index 0000000000..8b26483675
--- /dev/null
+++ b/testsuite/tests/primops/should_run/PinByteArray.stdout
@@ -0,0 +1,24 @@
+Small:False
+Large:False
+Compacted:False
+Pinned:True
+"Failed to compact pinned array as expected."
+Pinnedness of original array references after unsafePinMutableByteArray#
+Small:False
+Large:True
+Compacted:
+True
+Pinned:
+True
+Pinnedness of arrays returned from unsafePinMutableByteArray#
+Small:True
+Large:True
+Compacted:True
+Pinned:True
+Have references been pinned in-place?
+Small:False
+Large:True
+Compacted:True
+Pinned:True
+"Failed to compact large array post-pin(expected to fail)."
+"Failed to compact ar_compact array post-pin(expected to fail)."
diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T
index 65c24b1d00..a69fd83d75 100644
--- a/testsuite/tests/primops/should_run/all.T
+++ b/testsuite/tests/primops/should_run/all.T
@@ -59,3 +59,5 @@ test('UnliftedTVar2', normal, compile_and_run, [''])
 test('UnliftedWeakPtr', normal, compile_and_run, [''])
 
 test('T21624', normal, compile_and_run, [''])
+
+test('PinByteArray', normal, compile_and_run, [''])