diff options
author | Ben Gamari <ben@smart-cactus.org> | 2023-03-22 20:29:21 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2023-05-09 08:41:53 -0400 |
commit | 6b29154de6b63597553c5b69b9974c8838a7a80a (patch) | |
tree | 41dfdbc232b7421a7789f239e488a7895a8b3643 /compiler | |
parent | 81cfefd2cfb9d97a19d8e543130f94248e667330 (diff) | |
download | haskell-6b29154de6b63597553c5b69b9974c8838a7a80a.tar.gz |
Make atomicSwapMutVar# an inline primopwip/ioref-swap-xchg
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 1 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 30 |
2 files changed, 20 insertions, 11 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 3d6ad24666..559b8a972d 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -2608,7 +2608,6 @@ primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp MutVar# s v -> v -> State# s -> (# State# s, v #) {Atomically exchange the value of a 'MutVar#'.} with - out_of_line = True has_side_effects = True -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index 048da3c14f..f4a1924f19 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -297,16 +297,12 @@ emitPrimOp cfg primop = -- MutVar's value. emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease) [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ] + emitDirtyMutVar mutv (CmmReg old_val) - platform <- getPlatform - mkdirtyMutVarCCall <- getCode $! emitCCall - [{-no results-}] - (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) - [(baseExpr platform, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)] - emit =<< mkCmmIfThen - (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) - (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) - mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + emitDirtyMutVar mutv (CmmReg (CmmLocal res)) -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes @@ -1562,7 +1558,6 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal - AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal @@ -3332,6 +3327,21 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = whenCheckBounds $ do then emitBoundsCheck idx effective_arr_sz -- aligned => simpler check else assert (idx_w == W8) (emitRangeBoundsCheck idx elem_sz arr_sz) +-- | Write barrier for @MUT_VAR@ modification. +emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode () +emitDirtyMutVar mutvar old_val = do + cfg <- getStgToCmmConfig + platform <- getPlatform + mkdirtyMutVarCCall <- getCode $! emitCCall + [{-no results-}] + (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) + [(baseExpr platform, AddrHint), (mutvar, AddrHint), (old_val, AddrHint)] + + emit =<< mkCmmIfThen + (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) + (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutvar)) + mkdirtyMutVarCCall + --------------------------------------------------------------------------- -- Pushing to the update remembered set --------------------------------------------------------------------------- |