Commit d2d5ee16 authored by dterei's avatar dterei
Browse files

Improve support for LLVM >= 3.0 write barrier. (#5814)

parent 766da942
......@@ -62,13 +62,24 @@ data LlvmFunction = LlvmFunction {
funcBody :: LlvmBlocks
}
type LlvmFunctions = [LlvmFunction]
data LlvmSyncOrdering = SyncAcquire
| SyncRelease
| SyncAcqRel
| SyncSeqCst
deriving (Show, Eq)
type LlvmFunctions = [LlvmFunction]
-- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
-- 3.0). Please see the LLVM documentation for a better description.
data LlvmSyncOrdering
-- | Some partial order of operations exists.
= SyncUnord
-- | A single total order for operations at a single address exists.
| SyncMonotonic
-- | Acquire synchronization operation.
| SyncAcquire
-- | Release synchronization operation.
| SyncRelease
-- | Acquire + Release synchronization operation.
| SyncAcqRel
-- | Full sequential Consistency operation.
| SyncSeqCst
deriving (Show, Eq)
-- | Llvm Statements
data LlvmStatement
......
......@@ -211,7 +211,7 @@ ppLlvmStatement stmt =
let ind = (text " " <>)
in case stmt of
Assignment dst expr -> ind $ ppAssignment dst (ppLlvmExpression expr)
Fence st ord -> ind $ ppFence st ord
Fence st ord -> ind $ ppFence st ord
Branch target -> ind $ ppBranch target
BranchIf cond ifT ifF -> ind $ ppBranchIf cond ifT ifF
Comment comments -> ind $ ppLlvmComments comments
......@@ -305,14 +305,16 @@ ppAssignment var expr = (text $ getName var) <+> equals <+> expr
ppFence :: Bool -> LlvmSyncOrdering -> Doc
ppFence st ord =
let singleThread = case st of True -> text "singlethread"
False -> empty
False -> empty
in text "fence" <+> singleThread <+> ppSyncOrdering ord
ppSyncOrdering :: LlvmSyncOrdering -> Doc
ppSyncOrdering SyncAcquire = text "acquire"
ppSyncOrdering SyncRelease = text "release"
ppSyncOrdering SyncAcqRel = text "acq_rel"
ppSyncOrdering SyncSeqCst = text "seq_cst"
ppSyncOrdering SyncUnord = text "unordered"
ppSyncOrdering SyncMonotonic = text "monotonic"
ppSyncOrdering SyncAcquire = text "acquire"
ppSyncOrdering SyncRelease = text "release"
ppSyncOrdering SyncAcqRel = text "acq_rel"
ppSyncOrdering SyncSeqCst = text "seq_cst"
ppLoad :: LlvmVar -> Doc
ppLoad var = text "load" <+> texts var
......
......@@ -137,11 +137,13 @@ stmtToInstrs env stmt = case stmt of
-> return (env, unitOL $ Return Nothing, [])
-- | Memory barrier instruction for LLVM >= 3.0
barrier :: LlvmEnv -> UniqSM StmtData
barrier env = do
let s = Fence False SyncAcqRel
let s = Fence False SyncSeqCst
return (env, unitOL s, [])
-- | Memory barrier instruction for LLVM < 3.0
oldBarrier :: LlvmEnv -> UniqSM StmtData
oldBarrier env = do
let fname = fsLit "llvm.memory.barrier"
......@@ -173,7 +175,8 @@ genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
genCall env (CmmPrim MO_WriteBarrier) _ _ _
| platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
= return (env, nilOL, [])
| otherwise = barrier env
| getLlvmVer env > 29 = barrier env
| otherwise = oldBarrier env
-- Handle popcnt function specifically since GHC only really has i32 and i64
-- types and things like Word8 are backed by an i32 and just present a logical
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment