[Git][ghc/ghc][wip/tsan/fixes] 2 commits: compiler: Ensure that array reads have necessary barriers
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Jun 9 09:53:59 UTC 2023
Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC
Commits:
db1049ef by Ben Gamari at 2023-06-09T05:51:45-04:00
compiler: Ensure that array reads have necessary barriers
- - - - -
0570805b by Ben Gamari at 2023-06-09T05:53:49-04:00
Drop dead code
- - - - -
2 changed files:
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/StgToCmm/Prim.hs
Changes:
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -364,18 +364,6 @@ runUniqSM m = do
us <- mkSplitUniqSupply 'u'
return (initUs_ us m)
-
-dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO ()
-dumpGraph logger platform do_linting flag name g = do
- when do_linting $ do_lint g
- dumpWith logger flag name FormatCMM (pdoc platform g)
- where
- do_lint g = case cmmLintGraph platform g of
- Just err -> do { fatalErrorMsg logger err
- ; ghcExit logger 1
- }
- Nothing -> return ()
-
dumpWith :: Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
dumpWith logger flag txt fmt sdoc = do
putDumpFileMaybe logger flag txt fmt sdoc
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -2043,7 +2043,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"
@@ -2055,7 +2055,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"
@@ -2067,7 +2067,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"
@@ -2081,7 +2081,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"
@@ -2093,7 +2093,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
@@ -2149,7 +2149,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
@@ -2158,13 +2159,23 @@ 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])
+ 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
@@ -2994,7 +3005,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
@@ -3010,7 +3021,7 @@ 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))
-- Write barrier needed due to #12469
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db98923f70606b156f3cf82147ff6ca4172aed14...0570805bbc05765ebb1cf6c11bca25fd68563e0c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db98923f70606b156f3cf82147ff6ca4172aed14...0570805bbc05765ebb1cf6c11bca25fd68563e0c
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/20230609/e1e2ecb2/attachment-0001.html>
More information about the ghc-commits
mailing list