Commit 932cdfd5 authored by pcapriotti's avatar pcapriotti
Browse files

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

MERGED from commit d2d5ee16
parent 102a5380
......@@ -59,13 +59,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
......
......@@ -166,7 +166,7 @@ ppLlvmStatement :: LlvmStatement -> Doc
ppLlvmStatement stmt
= case stmt of
Assignment dst expr -> ppAssignment dst (ppLlvmExpression expr)
Fence st ord -> ppFence st ord
Fence st ord -> ppFence st ord
Branch target -> ppBranch target
BranchIf cond ifT ifF -> ppBranchIf cond ifT ifF
Comment comments -> ppLlvmComments comments
......@@ -258,14 +258,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
......
......@@ -136,11 +136,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"
......@@ -172,7 +174,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