diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2023-03-15 20:50:38 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2023-05-09 08:41:53 -0400 |
| commit | 81cfefd2cfb9d97a19d8e543130f94248e667330 (patch) | |
| tree | f2b2bc724572fbcaca8c5370c38214f7a5aeb649 /compiler | |
| parent | b970e64fb2dd6d65e6e14a7e57bbc0e2eef663a7 (diff) | |
| download | haskell-81cfefd2cfb9d97a19d8e543130f94248e667330.tar.gz | |
compiler: Implement atomicSwapIORef with xchg
As requested by @treeowl in CLC#139.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 7 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/StgToJS/Prim.hs | 2 |
3 files changed, 10 insertions, 0 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index c6f205c6a5..3d6ad24666 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -2604,6 +2604,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +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#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index d222c783b3..048da3c14f 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -1562,6 +1562,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal diff --git a/compiler/GHC/StgToJS/Prim.hs b/compiler/GHC/StgToJS/Prim.hs index 1bed788899..36f12e3409 100644 --- a/compiler/GHC/StgToJS/Prim.hs +++ b/compiler/GHC/StgToJS/Prim.hs @@ -801,6 +801,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) |