summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2022-11-16 09:36:26 -0500
committerMatthew Pickering <matthewtpickering@gmail.com>2022-12-15 09:38:30 +0000
commit59a296f6f959fe912d19491d9a4dc7476259bd44 (patch)
tree72ab600f5c9ae3f6a2d4809418b481247067a4e1
parent5e9ac6946d7082502fe05546d32429e2f3aca9b6 (diff)
downloadhaskell-59a296f6f959fe912d19491d9a4dc7476259bd44.tar.gz
compiler: Ensure that MutVar operations have necessary barriers
Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. (cherry picked from commit a9834736a90aefdd32cfc15be507e22b57eedc07)
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs9
1 files changed, 5 insertions, 4 deletions
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 2e646ef4fb..81f4f03a1c 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -283,9 +283,10 @@ emitPrimOp cfg primop =
emitAssign (CmmLocal res) currentTSOExpr
ReadMutVarOp -> \[mutv] -> opIntoRegs $ \[res] ->
- emitAssign (CmmLocal res) (cmmLoadIndexW platform mutv (fixedHdrSizeW profile) (gcWord platform))
+ emitPrimCall [res] (MO_AtomicRead (wordWidth platform) MemOrderAcquire)
+ [ cmmOffsetW platform mutv (fixedHdrSizeW profile) ]
- WriteMutVarOp -> \[mutv, var] -> opIntoRegs $ \res@[] -> do
+ WriteMutVarOp -> \[mutv, var] -> opIntoRegs $ \[] -> do
old_val <- CmmLocal <$> newTemp (cmmExprType platform var)
emitAssign old_val (cmmLoadIndexW platform mutv (fixedHdrSizeW profile) (gcWord platform))
@@ -294,8 +295,8 @@ emitPrimOp cfg primop =
-- Note that this also must come after we read the old value to ensure
-- that the read of old_val comes before another core's write to the
-- MutVar's value.
- emitPrimCall res MO_WriteBarrier []
- emitStore (cmmOffsetW platform mutv (fixedHdrSizeW profile)) var
+ emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease)
+ [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ]
platform <- getPlatform
mkdirtyMutVarCCall <- getCode $! emitCCall