[commit: ghc] master: Rename isPinnedByteArray# to isByteArrayPinned# (4dbacbc)
git at git.haskell.org
git at git.haskell.org
Sat Jun 4 07:33:06 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/4dbacbc89a999bf371d51194b4662a209ac907f1/ghc
>---------------------------------------------------------------
commit 4dbacbc89a999bf371d51194b4662a209ac907f1
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Fri Jun 3 22:22:42 2016 +0200
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
>---------------------------------------------------------------
4dbacbc89a999bf371d51194b4662a209ac907f1
compiler/prelude/primops.txt.pp | 10 +++++++--
docs/users_guide/8.2.1-notes.rst | 2 +-
includes/stg/MiscClosures.h | 3 ++-
rts/PrimOps.cmm | 12 ++++++++---
rts/RtsSymbols.c | 3 ++-
testsuite/tests/codeGen/should_run/T12059.hs | 27 +++++++++++++++++++++---
testsuite/tests/codeGen/should_run/T12059.stdout | 2 ++
7 files changed, 48 insertions(+), 11 deletions(-)
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 53bc8a4..bfeb785 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 60f17cf..b671f6d 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 337f586..731893e 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 a8e2a1b..160bccd 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 f420c01..e66b4d8 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 0b99bd3..3d815fc 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 70cea9e..8a39f7a 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
More information about the ghc-commits
mailing list