[Git][ghc/ghc][wip/backports-9.8] 3 commits: codeGen: Ensure that TSAN is aware of writeArray# write barriers
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Tue Aug 8 22:05:17 UTC 2023
Ben Gamari pushed to branch wip/backports-9.8 at Glasgow Haskell Compiler / GHC
Commits:
92b1ea6e by Ben Gamari at 2023-08-08T18:03:04-04:00
codeGen: Ensure that TSAN is aware of writeArray# write barriers
By using a proper release store instead of a fence.
(cherry picked from commit aca20a5d4fde1c6429c887624bb95c9b54b7af73)
- - - - -
bab51767 by Ben Gamari at 2023-08-08T18:03:19-04:00
codeGen: Ensure that array reads have necessary barriers
This was the cause of #23541.
(cherry picked from commit 453c0531f2edf49b75c73bc45944600d8d7bf767)
- - - - -
5f585906 by Ben Gamari at 2023-08-08T18:04:36-04:00
Update Haddock submodule to fix #23368
This submodule update adds the following three commits:
bbf1c8ae - Check for puns
0550694e - Remove fake exports for (~), List, and Tuple<n>
5877bceb - Fix pretty-printing of Solo and MkSolo
These commits fix the issues with Haddock HTML rendering reported in
ticket #23368.
Fixes #23368
- - - - -
2 changed files:
- compiler/GHC/StgToCmm/Prim.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -2083,7 +2083,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"
@@ -2095,7 +2095,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"
@@ -2107,7 +2107,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"
@@ -2121,7 +2121,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"
@@ -2133,7 +2133,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
@@ -2141,7 +2141,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"
@@ -2155,7 +2155,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"
@@ -2177,8 +2177,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_WriteBarrier []
- 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:
@@ -2190,7 +2189,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
@@ -2199,24 +2199,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
@@ -3029,7 +3045,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
@@ -3045,11 +3061,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_WriteBarrier [] -- #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)))
------------------------------------------------------------------------------
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 342b0b39bc4a9ac6ddfa616bf7e965263ce78b50
+Subproject commit 9b6840977177e34771c652caeb4243bce89e5b97
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ba21aeb365f93cddb17ff4a782c480f8c6388ca...5f5859069cad98a6239e7845c645542c9608aa3d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ba21aeb365f93cddb17ff4a782c480f8c6388ca...5f5859069cad98a6239e7845c645542c9608aa3d
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/20230808/0d28a1f6/attachment-0001.html>
More information about the ghc-commits
mailing list