Rename isPinnedByteArray# to isByteArrayPinned#

Reviewers: simonmar, duncan, erikd, austin

Reviewed By: austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2290

GHC Trac Issues: #12059

7 files changed, 48 insertions, 11 deletions

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 53bc8a47d7..bfeb7852c6 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1077,9 +1077,15 @@ primop  NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp
    with out_of_line = True
         has_side_effects = True
 
-primop  ByteArrayIsPinnedOp "isPinnedByteArray#" GenPrimOp
+primop  MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp
    MutableByteArray# s -> Int#
-   {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move.}
+   {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move
+   during GC.}
+   with out_of_line = True
+
+primop  ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp
+   ByteArray# -> Int#
+   {Determine whether a {\tt ByteArray\#} is guaranteed not to move during GC.}
    with out_of_line = True
 
 primop  ByteArrayContents_Char "byteArrayContents#" GenPrimOp
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index 60f17cfbbb..b671f6db7d 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -131,7 +131,7 @@ ghc-prim
 
 -  Version number XXXXX (was 0.3.1.0)
 
--  Added new ``isPinnedbyteArray#`` operation.
+-  Added new ``isByteArrayPinned#`` and ``isMutableByteArrayPinned#`` operation.
 
 haskell98
 ~~~~~~~~~
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 337f586f76..731893efd0 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -347,7 +347,8 @@ RTS_FUN_DECL(stg_casArrayzh);
 RTS_FUN_DECL(stg_newByteArrayzh);
 RTS_FUN_DECL(stg_newPinnedByteArrayzh);
 RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
-RTS_FUN_DECL(stg_isPinnedByteArrayzh);
+RTS_FUN_DECL(stg_isByteArrayPinnedzh);
+RTS_FUN_DECL(stg_isMutableByteArrayPinnedzh);
 RTS_FUN_DECL(stg_shrinkMutableByteArrayzh);
 RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
 RTS_FUN_DECL(stg_casIntArrayzh);
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index a8e2a1b66c..160bccd2f9 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -141,17 +141,23 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
     return (p);
 }
 
-stg_isPinnedByteArrayzh ( gcptr mba )
-// MutableByteArray# s -> Int#
+stg_isByteArrayPinnedzh ( gcptr ba )
+// ByteArray# s -> Int#
 {
     W_ bd, flags;
-    bd = Bdescr(mba);
+    bd = Bdescr(ba);
     // pinned byte arrays live in blocks with the BF_PINNED flag set.
     // See the comment in Storage.c:allocatePinned.
     flags = TO_W_(bdescr_flags(bd));
     return (flags & BF_PINNED != 0);
 }
 
+stg_isMutableByteArrayPinnedzh ( gcptr mba )
+// MutableByteArray# s -> Int#
+{
+    jump stg_isByteArrayPinnedzh(mba);
+}
+
 // shrink size of MutableByteArray in-place
 stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
 // MutableByteArray# s -> Int# -> State# s -> State# s
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index f420c01ee1..e66b4d81cb 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -514,7 +514,8 @@
       SymI_HasProto(stg_casMutVarzh)                                    \
       SymI_HasProto(stg_newPinnedByteArrayzh)                           \
       SymI_HasProto(stg_newAlignedPinnedByteArrayzh)                    \
-      SymI_HasProto(stg_isPinnedByteArrayzh)                            \
+      SymI_HasProto(stg_isByteArrayPinnedzh)                            \
+      SymI_HasProto(stg_isMutableByteArrayPinnedzh)                     \
       SymI_HasProto(stg_shrinkMutableByteArrayzh)                       \
       SymI_HasProto(stg_resizzeMutableByteArrayzh)                      \
       SymI_HasProto(newSpark)                                           \
diff --git a/testsuite/tests/codeGen/should_run/T12059.hs b/testsuite/tests/codeGen/should_run/T12059.hs
index 0b99bd36a4..3d815fcd1c 100644
--- a/testsuite/tests/codeGen/should_run/T12059.hs
+++ b/testsuite/tests/codeGen/should_run/T12059.hs
@@ -8,20 +8,41 @@ import GHC.IO
 
 main :: IO ()
 main = do
+    -- Unpinned MutableByteArray
     r <- IO $ \s0 ->
       case newByteArray# 1024# s0 of
         (# s1, mba #) ->
-            (# s1, isTrue# (isPinnedByteArray# mba) #)
+           (# s1, isTrue# (isMutableByteArrayPinned# mba) #)
     print r
 
+    -- Pinned MutableByteArray
     r <- IO $ \s0 ->
       case newPinnedByteArray# 1024# s0 of
         (# s1, mba #) ->
-            (# s1, isTrue# (isPinnedByteArray# mba) #)
+           (# s1, isTrue# (isMutableByteArrayPinned# mba) #)
     print r
 
+    -- Pinned, Aligned MutableByteArray
     r <- IO $ \s0 ->
       case newAlignedPinnedByteArray# 1024# 16# s0 of
         (# s1, mba #) ->
-            (# s1, isTrue# (isPinnedByteArray# mba) #)
+           (# s1, isTrue# (isMutableByteArrayPinned# mba) #)
+    print r
+
+    -- Unpinned ByteArray
+    r <- IO $ \s0 ->
+      case newByteArray# 1024# s0 of
+        (# s1, mba #) ->
+          case unsafeFreezeByteArray# mba s1 of
+             (# s2, ba #) ->
+                (# s2, isTrue# (isByteArrayPinned# ba) #)
+    print r
+
+    -- Pinned ByteArray
+    r <- IO $ \s0 ->
+      case newPinnedByteArray# 1024# s0 of
+        (# s1, mba #) ->
+          case unsafeFreezeByteArray# mba s1 of
+             (# s2, ba #) ->
+                (# s2, isTrue# (isByteArrayPinned# ba) #)
     print r
diff --git a/testsuite/tests/codeGen/should_run/T12059.stdout b/testsuite/tests/codeGen/should_run/T12059.stdout
index 70cea9e2ea..8a39f7a810 100644
--- a/testsuite/tests/codeGen/should_run/T12059.stdout
+++ b/testsuite/tests/codeGen/should_run/T12059.stdout
@@ -1,3 +1,5 @@
 False
 True
 True
+False
+True
\ No newline at end of file