[Git][ghc/ghc][master] 2 commits: codeGen: Ensure that TSAN is aware of writeArray# write barriers
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Aug 2 10:04:32 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
aca20a5d by Ben Gamari at 2023-08-02T06:03:55-04:00
codeGen: Ensure that TSAN is aware of writeArray# write barriers
By using a proper release store instead of a fence.
- - - - -
453c0531 by Ben Gamari at 2023-08-02T06:03:55-04:00
codeGen: Ensure that array reads have necessary barriers
This was the cause of #23541.
- - - - -
1 changed file:
- compiler/GHC/StgToCmm/Prim.hs
Changes:
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -2087,7 +2087,7 @@ doIndexOffAddrOp :: Maybe MachOp
-> [CmmExpr]
-> FCode ()
doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
- = mkBasicIndexedRead NaturallyAligned 0 maybe_post_read_cast rep res addr rep idx
+ = mkBasicIndexedRead False NaturallyAligned 0 maybe_post_read_cast rep res addr rep idx
doIndexOffAddrOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexOffAddrOp"
@@ -2099,7 +2099,7 @@ doIndexOffAddrOpAs :: Maybe MachOp
-> FCode ()
doIndexOffAddrOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]
= let alignment = alignmentFromTypes rep idx_rep
- in mkBasicIndexedRead alignment 0 maybe_post_read_cast rep res addr idx_rep idx
+ in mkBasicIndexedRead False alignment 0 maybe_post_read_cast rep res addr idx_rep idx
doIndexOffAddrOpAs _ _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexOffAddrOpAs"
@@ -2111,7 +2111,7 @@ doIndexByteArrayOp :: Maybe MachOp
doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
= do profile <- getProfile
doByteArrayBoundsCheck idx addr rep rep
- mkBasicIndexedRead NaturallyAligned (arrWordsHdrSize profile) maybe_post_read_cast rep res addr rep idx
+ mkBasicIndexedRead False NaturallyAligned (arrWordsHdrSize profile) maybe_post_read_cast rep res addr rep idx
doIndexByteArrayOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexByteArrayOp"
@@ -2125,7 +2125,7 @@ doIndexByteArrayOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]
= do profile <- getProfile
doByteArrayBoundsCheck idx addr idx_rep rep
let alignment = alignmentFromTypes rep idx_rep
- mkBasicIndexedRead alignment (arrWordsHdrSize profile) maybe_post_read_cast rep res addr idx_rep idx
+ mkBasicIndexedRead False alignment (arrWordsHdrSize profile) maybe_post_read_cast rep res addr idx_rep idx
doIndexByteArrayOpAs _ _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexByteArrayOpAs"
@@ -2137,7 +2137,7 @@ doReadPtrArrayOp res addr idx
= do profile <- getProfile
platform <- getPlatform
doPtrArrayBoundsCheck idx addr
- mkBasicIndexedRead NaturallyAligned (arrPtrsHdrSize profile) Nothing (gcWord platform) res addr (gcWord platform) idx
+ mkBasicIndexedRead True NaturallyAligned (arrPtrsHdrSize profile) Nothing (gcWord platform) res addr (gcWord platform) idx
doWriteOffAddrOp :: Maybe MachOp
-> CmmType
@@ -2145,7 +2145,7 @@ doWriteOffAddrOp :: Maybe MachOp
-> [CmmExpr]
-> FCode ()
doWriteOffAddrOp castOp idx_ty [] [addr,idx, val]
- = mkBasicIndexedWrite 0 addr idx_ty idx (maybeCast castOp val)
+ = mkBasicIndexedWrite False 0 addr idx_ty idx (maybeCast castOp val)
doWriteOffAddrOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doWriteOffAddrOp"
@@ -2159,7 +2159,7 @@ doWriteByteArrayOp castOp idx_ty [] [addr,idx, rawVal]
platform <- getPlatform
let val = maybeCast castOp rawVal
doByteArrayBoundsCheck idx addr idx_ty (cmmExprType platform val)
- mkBasicIndexedWrite (arrWordsHdrSize profile) addr idx_ty idx val
+ mkBasicIndexedWrite False (arrWordsHdrSize profile) addr idx_ty idx val
doWriteByteArrayOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doWriteByteArrayOp"
@@ -2181,8 +2181,7 @@ doWritePtrArrayOp addr idx val
-- This write barrier is to ensure that the heap writes to the object
-- referred to by val have happened before we write val into the array.
-- See #12469 for details.
- emitPrimCall [] MO_ReleaseFence []
- mkBasicIndexedWrite hdr_size addr ty idx val
+ mkBasicIndexedWrite True hdr_size addr ty idx val
emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
-- the write barrier. We must write a byte into the mark table:
@@ -2194,7 +2193,8 @@ doWritePtrArrayOp addr idx val
(CmmMachOp (mo_wordUShr platform) [idx, mkIntExpr platform (pc_MUT_ARR_PTRS_CARD_BITS (platformConstants platform))])
) (CmmLit (CmmInt 1 W8))
-mkBasicIndexedRead :: AlignmentSpec
+mkBasicIndexedRead :: Bool -- Should this imply an acquire barrier
+ -> AlignmentSpec
-> ByteOff -- Initial offset in bytes
-> Maybe MachOp -- Optional result cast
-> CmmType -- Type of element we are accessing
@@ -2203,24 +2203,40 @@ mkBasicIndexedRead :: AlignmentSpec
-> CmmType -- Type of element by which we are indexing
-> CmmExpr -- Index
-> FCode ()
-mkBasicIndexedRead alignment off Nothing ty res base idx_ty idx
- = do platform <- getPlatform
- emitAssign (CmmLocal res) (cmmLoadIndexOffExpr platform alignment off ty base idx_ty idx)
-mkBasicIndexedRead alignment off (Just cast) ty res base idx_ty idx
+mkBasicIndexedRead barrier alignment off mb_cast ty res base idx_ty idx
= do platform <- getPlatform
- emitAssign (CmmLocal res) (CmmMachOp cast [
- cmmLoadIndexOffExpr platform alignment off ty base idx_ty idx])
-
-mkBasicIndexedWrite :: ByteOff -- Initial offset in bytes
+ let addr = cmmIndexOffExpr platform off (typeWidth idx_ty) base idx
+ result <-
+ if barrier
+ then do
+ res <- newTemp ty
+ emitPrimCall [res] (MO_AtomicRead (typeWidth ty) MemOrderAcquire) [addr]
+ return $ CmmReg (CmmLocal res)
+ else
+ return $ CmmLoad addr ty alignment
+
+ let casted =
+ case mb_cast of
+ Just cast -> CmmMachOp cast [result]
+ Nothing -> result
+ emitAssign (CmmLocal res) casted
+
+mkBasicIndexedWrite :: Bool -- Should this imply a release barrier
+ -> ByteOff -- Initial offset in bytes
-> CmmExpr -- Base address
-> CmmType -- Type of element by which we are indexing
-> CmmExpr -- Index
-> CmmExpr -- Value to write
-> FCode ()
-mkBasicIndexedWrite off base idx_ty idx val
+mkBasicIndexedWrite barrier off base idx_ty idx val
= do platform <- getPlatform
let alignment = alignmentFromTypes (cmmExprType platform val) idx_ty
- emitStore' alignment (cmmIndexOffExpr platform off (typeWidth idx_ty) base idx) val
+ addr = cmmIndexOffExpr platform off (typeWidth idx_ty) base idx
+ if barrier
+ then let w = typeWidth idx_ty
+ op = MO_AtomicWrite w MemOrderRelease
+ in emitPrimCall [] op [addr, val]
+ else emitStore' alignment addr val
-- ----------------------------------------------------------------------------
-- Misc utils
@@ -3033,7 +3049,7 @@ doReadSmallPtrArrayOp res addr idx = do
profile <- getProfile
platform <- getPlatform
doSmallPtrArrayBoundsCheck idx addr
- mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing (gcWord platform) res addr
+ mkBasicIndexedRead True NaturallyAligned (smallArrPtrsHdrSize profile) Nothing (gcWord platform) res addr
(gcWord platform) idx
doWriteSmallPtrArrayOp :: CmmExpr
@@ -3049,11 +3065,11 @@ doWriteSmallPtrArrayOp addr idx val = do
-- Update remembered set for non-moving collector
tmp <- newTemp ty
- mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx
+ mkBasicIndexedRead False NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx
whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp))
- emitPrimCall [] MO_ReleaseFence [] -- #12469
- mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val
+ -- Write barrier needed due to #12469
+ mkBasicIndexedWrite True (smallArrPtrsHdrSize profile) addr ty idx val
emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))
------------------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28211215b76ea88d3969a9e308ce083dad389986...453c0531f2edf49b75c73bc45944600d8d7bf767
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28211215b76ea88d3969a9e308ce083dad389986...453c0531f2edf49b75c73bc45944600d8d7bf767
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230802/a4b0e77a/attachment-0001.html>
More information about the ghc-commits
mailing list