diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2022-11-16 09:36:26 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2022-12-05 18:44:08 -0500 |
| commit | a9834736a90aefdd32cfc15be507e22b57eedc07 (patch) | |
| tree | e5a41521221a727d5c24690260e137438691633e | |
| parent | 4f85f747b06a3be1591b52c1f15ff6588b8e5764 (diff) | |
| download | haskell-wip/T22468.tar.gz | |
compiler: Ensure that MutVar operations have necessary barrierswip/T22468
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 |