diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2022-11-16 09:36:26 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-12-15 03:55:15 -0500 |
| commit | 552b7908d8703e9478cee418721b311e033391dc (patch) | |
| tree | 997a7ea7e757fe7bf96c060a4bddae936f544902 | |
| parent | 2eb0fb87b921efc8f107eb39a3d34dae08082a3c (diff) | |
| download | haskell-552b7908d8703e9478cee418721b311e033391dc.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.
| -rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index 93fdd3f5e2..e17a937a9e 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 |