Commit 310371ff authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

rts: Add isPinnedByteArray# primop

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
parent 39a2faa0
......@@ -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!}
......
......@@ -127,6 +127,8 @@ ghc-prim
- Version number XXXXX (was 0.3.1.0)
- Added new ``isPinnedbyteArray#`` operation.
haskell98
~~~~~~~~~
......
......@@ -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);
......
## 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
......
......@@ -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
......
......@@ -514,6 +514,7 @@
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) \
......
{-# 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
......@@ -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, [''])
......@@ -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"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment