diff options
| -rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 1 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 30 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 11 | ||||
| -rw-r--r-- | rts/RtsSymbols.c | 1 | ||||
| -rw-r--r-- | rts/include/stg/MiscClosures.h | 1 |
5 files changed, 20 insertions, 24 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 --------------------------------------------------------------------------- diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 9e86a8e0a2..60d0dc2ccc 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -689,17 +689,6 @@ stg_newMutVarzh ( gcptr init ) return (mv); } -stg_atomicSwapMutVarzh ( gcptr mv, gcptr new ) - /* MutVar# s a -> a -> State# s -> (# State#, a #) */ -{ - W_ old; - (old) = prim %xchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, new); - if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) { - ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", old "ptr"); - } - return (old); -} - // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index ebf73a2b69..dee6c57f5e 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -633,7 +633,6 @@ extern char **environ; SymI_HasDataProto(stg_writeIOPortzh) \ SymI_HasDataProto(stg_newIOPortzh) \ SymI_HasDataProto(stg_noDuplicatezh) \ - SymI_HasDataProto(stg_atomicSwapMutVarzh) \ SymI_HasDataProto(stg_atomicModifyMutVar2zh) \ SymI_HasDataProto(stg_atomicModifyMutVarzuzh) \ SymI_HasDataProto(stg_casMutVarzh) \ diff --git a/rts/include/stg/MiscClosures.h b/rts/include/stg/MiscClosures.h index da556870f1..8e50336e4a 100644 --- a/rts/include/stg/MiscClosures.h +++ b/rts/include/stg/MiscClosures.h @@ -481,7 +481,6 @@ RTS_FUN_DECL(stg_copySmallMutableArrayzh); RTS_FUN_DECL(stg_casSmallArrayzh); RTS_FUN_DECL(stg_newMutVarzh); -RTS_FUN_DECL(stg_atomicSwapMutVarzh); RTS_FUN_DECL(stg_atomicModifyMutVar2zh); RTS_FUN_DECL(stg_atomicModifyMutVarzuzh); RTS_FUN_DECL(stg_casMutVarzh); |