summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-03-15 16:03:21 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-22 09:22:29 -0400
commite82d32d6654ef708d580e3ed6f0cc1130daa6cb9 (patch)
tree8407e051d52b4676be3a8b57d3e44b6333fbcde6
parent2907949c169a0764676da8e5a4516c705f36932a (diff)
downloadhaskell-e82d32d6654ef708d580e3ed6f0cc1130daa6cb9.tar.gz
compiler: Introduce mutableByteArrayContents# primop
As noted in #19540, a number of users within and outside of GHC rely on unsafeCoerceUnlifted to work around the fact that this was missing
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp4
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs4
2 files changed, 8 insertions, 0 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 27b7f55132..c11cc05a40 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -1655,6 +1655,10 @@ primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
ByteArray# -> Addr#
{Intended for use with pinned arrays; otherwise very unsafe!}
+primop MutableByteArrayContents_Char "mutableByteArrayContents#" GenPrimOp
+ MutableByteArray# s -> Addr#
+ {Intended for use with pinned arrays; otherwise very unsafe!}
+
primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
MutableByteArray# s -> MutableByteArray# s -> Int#
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index b10462a10b..484863d37a 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -335,6 +335,10 @@ emitPrimOp dflags primop = case primop of
ByteArrayContents_Char -> \[arg] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) (cmmOffsetB platform arg (arrWordsHdrSize profile))
+-- #define mutableByteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
+ MutableByteArrayContents_Char -> \[arg] -> opIntoRegs $ \[res] ->
+ emitAssign (CmmLocal res) (cmmOffsetB platform arg (arrWordsHdrSize profile))
+
-- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
StableNameToIntOp -> \[arg] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform))