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 { ...@@ -62,13 +62,24 @@ data LlvmFunction = LlvmFunction {
funcBody :: LlvmBlocks funcBody :: LlvmBlocks
} }
type LlvmFunctions = [LlvmFunction] type LlvmFunctions = [LlvmFunction]
data LlvmSyncOrdering = SyncAcquire -- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
| SyncRelease -- 3.0). Please see the LLVM documentation for a better description.
| SyncAcqRel data LlvmSyncOrdering
| SyncSeqCst -- | Some partial order of operations exists.
deriving (Show, Eq) = 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 -- | Llvm Statements
data LlvmStatement data LlvmStatement
......
...@@ -211,7 +211,7 @@ ppLlvmStatement stmt = ...@@ -211,7 +211,7 @@ ppLlvmStatement stmt =
let ind = (text " " <>) let ind = (text " " <>)
in case stmt of in case stmt of
Assignment dst expr -> ind $ ppAssignment dst (ppLlvmExpression expr) 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 Branch target -> ind $ ppBranch target
BranchIf cond ifT ifF -> ind $ ppBranchIf cond ifT ifF BranchIf cond ifT ifF -> ind $ ppBranchIf cond ifT ifF
Comment comments -> ind $ ppLlvmComments comments Comment comments -> ind $ ppLlvmComments comments
...@@ -305,14 +305,16 @@ ppAssignment var expr = (text $ getName var) <+> equals <+> expr ...@@ -305,14 +305,16 @@ ppAssignment var expr = (text $ getName var) <+> equals <+> expr
ppFence :: Bool -> LlvmSyncOrdering -> Doc ppFence :: Bool -> LlvmSyncOrdering -> Doc
ppFence st ord = ppFence st ord =
let singleThread = case st of True -> text "singlethread" let singleThread = case st of True -> text "singlethread"
False -> empty False -> empty
in text "fence" <+> singleThread <+> ppSyncOrdering ord in text "fence" <+> singleThread <+> ppSyncOrdering ord
ppSyncOrdering :: LlvmSyncOrdering -> Doc ppSyncOrdering :: LlvmSyncOrdering -> Doc
ppSyncOrdering SyncAcquire = text "acquire" ppSyncOrdering SyncUnord = text "unordered"
ppSyncOrdering SyncRelease = text "release" ppSyncOrdering SyncMonotonic = text "monotonic"
ppSyncOrdering SyncAcqRel = text "acq_rel" ppSyncOrdering SyncAcquire = text "acquire"
ppSyncOrdering SyncSeqCst = text "seq_cst" ppSyncOrdering SyncRelease = text "release"
ppSyncOrdering SyncAcqRel = text "acq_rel"
ppSyncOrdering SyncSeqCst = text "seq_cst"
ppLoad :: LlvmVar -> Doc ppLoad :: LlvmVar -> Doc
ppLoad var = text "load" <+> texts var ppLoad var = text "load" <+> texts var
......
...@@ -137,11 +137,13 @@ stmtToInstrs env stmt = case stmt of ...@@ -137,11 +137,13 @@ stmtToInstrs env stmt = case stmt of
-> return (env, unitOL $ Return Nothing, []) -> return (env, unitOL $ Return Nothing, [])
-- | Memory barrier instruction for LLVM >= 3.0
barrier :: LlvmEnv -> UniqSM StmtData barrier :: LlvmEnv -> UniqSM StmtData
barrier env = do barrier env = do
let s = Fence False SyncAcqRel let s = Fence False SyncSeqCst
return (env, unitOL s, []) return (env, unitOL s, [])
-- | Memory barrier instruction for LLVM < 3.0
oldBarrier :: LlvmEnv -> UniqSM StmtData oldBarrier :: LlvmEnv -> UniqSM StmtData
oldBarrier env = do oldBarrier env = do
let fname = fsLit "llvm.memory.barrier" let fname = fsLit "llvm.memory.barrier"
...@@ -173,7 +175,8 @@ genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual] ...@@ -173,7 +175,8 @@ genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
genCall env (CmmPrim MO_WriteBarrier) _ _ _ genCall env (CmmPrim MO_WriteBarrier) _ _ _
| platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC] | platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
= return (env, nilOL, []) = 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 -- 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 -- 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