rts: Add isPinnedByteArray# primop
authorBen Gamari <bgamari.foss@gmail.com>
Tue, 17 May 2016 17:05:26 +0000 (19:05 +0200)
committerBen Gamari <ben@smart-cactus.org>
Wed, 18 May 2016 20:02:22 +0000 (22:02 +0200)
Adds a primitive operation to determine whether a particular
`MutableByteArray#` is backed by a pinned buffer.

Test Plan: Validate with included testcase

Reviewers: austin, simonmar

Reviewed By: austin, simonmar

Subscribers: thomie

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

GHC Trac Issues: #12059

compiler/prelude/primops.txt.pp
docs/users_guide/8.2.1-notes.rst
includes/stg/MiscClosures.h
libraries/ghc-prim/changelog.md
rts/PrimOps.cmm
rts/RtsSymbols.c
testsuite/tests/codeGen/should_run/T12059.hs [new file with mode: 0644]
testsuite/tests/codeGen/should_run/T12059.stdout [new file with mode: 0644]
testsuite/tests/codeGen/should_run/all.T
utils/deriveConstants/Main.hs

index d481d1a..53bc8a4 100644 (file)
@@ -1077,6 +1077,11 @@ primop  NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp
    with out_of_line = True
         has_side_effects = True
 
+primop  ByteArrayIsPinnedOp "isPinnedByteArray#" GenPrimOp
+   MutableByteArray# s -> Int#
+   {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move.}
+   with out_of_line = True
+
 primop  ByteArrayContents_Char "byteArrayContents#" GenPrimOp
    ByteArray# -> Addr#
    {Intended for use with pinned arrays; otherwise very unsafe!}
index 957552b..b52f0ed 100644 (file)
@@ -127,6 +127,8 @@ ghc-prim
 
 -  Version number XXXXX (was 0.3.1.0)
 
+-  Added new ``isPinnedbyteArray#`` operation.
+
 haskell98
 ~~~~~~~~~
 
index 3fd4128..337f586 100644 (file)
@@ -347,6 +347,7 @@ 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_shrinkMutableByteArrayzh);
 RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
 RTS_FUN_DECL(stg_casIntArrayzh);
index 45daa64..0c9ca42 100644 (file)
@@ -1,5 +1,15 @@
+## 0.6.0.0
+
+- Shipped with GHC 8.2.1
+
+- Added to `GHC.Prim`:
+
+        isPinnedByteArray# :: MutableByteArray# s -> Int#
+
 ## 0.5.0.0
 
+- Shipped with GHC 8.0.1
+
 - `GHC.Classes`: new `class IP (a :: Symbol) b | a -> b`
 
 - `GHC.Prim`: changed type signatures from
index a802e67..a8e2a1b 100644 (file)
@@ -141,6 +141,17 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
     return (p);
 }
 
+stg_isPinnedByteArrayzh ( gcptr mba )
+// MutableByteArray# s -> Int#
+{
+    W_ bd, flags;
+    bd = Bdescr(mba);
+    // 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);
+}
+
 // shrink size of MutableByteArray in-place
 stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
 // MutableByteArray# s -> Int# -> State# s -> State# s
index 11bc0e6..f420c01 100644 (file)
       SymI_HasProto(stg_casMutVarzh)                                    \
       SymI_HasProto(stg_newPinnedByteArrayzh)                           \
       SymI_HasProto(stg_newAlignedPinnedByteArrayzh)                    \
+      SymI_HasProto(stg_isPinnedByteArrayzh)                            \
       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
new file mode 100644 (file)
index 0000000..0b99bd3
--- /dev/null
@@ -0,0 +1,27 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+-- Test the function of the isPinnedByteArray# primop
+
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = do
+    r <- IO $ \s0 ->
+      case newByteArray# 1024# s0 of
+        (# s1, mba #) ->
+            (# s1, isTrue# (isPinnedByteArray# mba) #)
+    print r
+
+    r <- IO $ \s0 ->
+      case newPinnedByteArray# 1024# s0 of
+        (# s1, mba #) ->
+            (# s1, isTrue# (isPinnedByteArray# mba) #)
+    print r
+
+    r <- IO $ \s0 ->
+      case newAlignedPinnedByteArray# 1024# 16# s0 of
+        (# s1, mba #) ->
+            (# s1, isTrue# (isPinnedByteArray# mba) #)
+    print r
diff --git a/testsuite/tests/codeGen/should_run/T12059.stdout b/testsuite/tests/codeGen/should_run/T12059.stdout
new file mode 100644 (file)
index 0000000..70cea9e
--- /dev/null
@@ -0,0 +1,3 @@
+False
+True
+True
index 1175f22..921f2c3 100644 (file)
@@ -140,3 +140,4 @@ test('T10521b', normal, compile_and_run, [''])
 test('T10870', when(wordsize(32), skip), compile_and_run, [''])
 test('PopCnt', omit_ways(['ghci']), multi_compile_and_run,
                  ['PopCnt', [('PopCnt_cmm.cmm', '')], ''])
+test('T12059', normal, compile_and_run, [''])
index 16f3255..63e2233 100644 (file)
@@ -391,6 +391,7 @@ wanteds os = concat
           ,structField Both "bdescr" "blocks"
           ,structField C    "bdescr" "gen_no"
           ,structField C    "bdescr" "link"
+          ,structField C    "bdescr" "flags"
 
           ,structSize C  "generation"
           ,structField C "generation" "n_new_large_words"