|
 |
4a2ee5f |
commit 932cdfd52d94cdfb074878e98767d0ff597262b6
|
|
|
4a2ee5f |
Author: Paolo Capriotti <p.capriotti@gmail.com>
|
|
|
4a2ee5f |
Date: Mon Mar 26 18:56:14 2012 +0100
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
Improve support for LLVM >= 3.0 write barrier. (#5814)
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
MERGED from commit d2d5ee16cf21c5b32333ff57ba0a65f89ff7e988
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
Modified compiler/llvmGen/Llvm/AbsSyn.hs
|
|
|
4a2ee5f |
diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs
|
|
|
4a2ee5f |
index 468b7e4..1b50d29 100644
|
|
|
4a2ee5f |
--- a/compiler/llvmGen/Llvm/AbsSyn.hs
|
|
|
4a2ee5f |
+++ b/compiler/llvmGen/Llvm/AbsSyn.hs
|
|
|
4a2ee5f |
@@ -59,13 +59,24 @@ data LlvmFunction = LlvmFunction {
|
|
|
4a2ee5f |
funcBody :: LlvmBlocks
|
|
|
4a2ee5f |
}
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
-type LlvmFunctions = [LlvmFunction]
|
|
|
4a2ee5f |
-
|
|
|
4a2ee5f |
-data LlvmSyncOrdering = SyncAcquire
|
|
|
4a2ee5f |
- | SyncRelease
|
|
|
4a2ee5f |
- | SyncAcqRel
|
|
|
4a2ee5f |
- | SyncSeqCst
|
|
|
4a2ee5f |
- deriving (Show, Eq)
|
|
|
4a2ee5f |
+type LlvmFunctions = [LlvmFunction]
|
|
|
4a2ee5f |
+
|
|
|
4a2ee5f |
+-- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
|
|
|
4a2ee5f |
+-- 3.0). Please see the LLVM documentation for a better description.
|
|
|
4a2ee5f |
+data LlvmSyncOrdering
|
|
|
4a2ee5f |
+ -- | Some partial order of operations exists.
|
|
|
4a2ee5f |
+ = SyncUnord
|
|
|
4a2ee5f |
+ -- | A single total order for operations at a single address exists.
|
|
|
4a2ee5f |
+ | SyncMonotonic
|
|
|
4a2ee5f |
+ -- | Acquire synchronization operation.
|
|
|
4a2ee5f |
+ | SyncAcquire
|
|
|
4a2ee5f |
+ -- | Release synchronization operation.
|
|
|
4a2ee5f |
+ | SyncRelease
|
|
|
4a2ee5f |
+ -- | Acquire + Release synchronization operation.
|
|
|
4a2ee5f |
+ | SyncAcqRel
|
|
|
4a2ee5f |
+ -- | Full sequential Consistency operation.
|
|
|
4a2ee5f |
+ | SyncSeqCst
|
|
|
4a2ee5f |
+ deriving (Show, Eq)
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
-- | Llvm Statements
|
|
|
4a2ee5f |
data LlvmStatement
|
|
|
4a2ee5f |
Modified compiler/llvmGen/Llvm/PpLlvm.hs
|
|
|
4a2ee5f |
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
|
|
|
4a2ee5f |
index f3c8342..0a750c3 100644
|
|
|
4a2ee5f |
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
|
|
|
4a2ee5f |
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
|
|
|
4a2ee5f |
@@ -166,7 +166,7 @@ ppLlvmStatement :: LlvmStatement -> Doc
|
|
|
4a2ee5f |
ppLlvmStatement stmt
|
|
|
4a2ee5f |
= case stmt of
|
|
|
4a2ee5f |
Assignment dst expr -> ppAssignment dst (ppLlvmExpression expr)
|
|
|
4a2ee5f |
- Fence st ord -> ppFence st ord
|
|
|
4a2ee5f |
+ Fence st ord -> ppFence st ord
|
|
|
4a2ee5f |
Branch target -> ppBranch target
|
|
|
4a2ee5f |
BranchIf cond ifT ifF -> ppBranchIf cond ifT ifF
|
|
|
4a2ee5f |
Comment comments -> ppLlvmComments comments
|
|
|
4a2ee5f |
@@ -258,14 +258,16 @@ ppAssignment var expr = (text $ getName var) <+> equals <+> expr
|
|
|
4a2ee5f |
ppFence :: Bool -> LlvmSyncOrdering -> Doc
|
|
|
4a2ee5f |
ppFence st ord =
|
|
|
4a2ee5f |
let singleThread = case st of True -> text "singlethread"
|
|
|
4a2ee5f |
- False -> empty
|
|
|
4a2ee5f |
+ False -> empty
|
|
|
4a2ee5f |
in text "fence" <+> singleThread <+> ppSyncOrdering ord
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
ppSyncOrdering :: LlvmSyncOrdering -> Doc
|
|
|
4a2ee5f |
-ppSyncOrdering SyncAcquire = text "acquire"
|
|
|
4a2ee5f |
-ppSyncOrdering SyncRelease = text "release"
|
|
|
4a2ee5f |
-ppSyncOrdering SyncAcqRel = text "acq_rel"
|
|
|
4a2ee5f |
-ppSyncOrdering SyncSeqCst = text "seq_cst"
|
|
|
4a2ee5f |
+ppSyncOrdering SyncUnord = text "unordered"
|
|
|
4a2ee5f |
+ppSyncOrdering SyncMonotonic = text "monotonic"
|
|
|
4a2ee5f |
+ppSyncOrdering SyncAcquire = text "acquire"
|
|
|
4a2ee5f |
+ppSyncOrdering SyncRelease = text "release"
|
|
|
4a2ee5f |
+ppSyncOrdering SyncAcqRel = text "acq_rel"
|
|
|
4a2ee5f |
+ppSyncOrdering SyncSeqCst = text "seq_cst"
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
ppLoad :: LlvmVar -> Doc
|
|
|
4a2ee5f |
ppLoad var = text "load" <+> texts var
|
|
|
4a2ee5f |
Modified compiler/llvmGen/LlvmCodeGen/CodeGen.hs
|
|
|
4a2ee5f |
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
|
|
|
4a2ee5f |
index c505cc0..4a8d37f 100644
|
|
|
4a2ee5f |
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
|
|
|
4a2ee5f |
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
|
|
|
4a2ee5f |
@@ -136,11 +136,13 @@ stmtToInstrs env stmt = case stmt of
|
|
|
4a2ee5f |
-> return (env, unitOL $ Return Nothing, [])
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
+-- | Memory barrier instruction for LLVM >= 3.0
|
|
|
4a2ee5f |
barrier :: LlvmEnv -> UniqSM StmtData
|
|
|
4a2ee5f |
barrier env = do
|
|
|
4a2ee5f |
- let s = Fence False SyncAcqRel
|
|
|
4a2ee5f |
+ let s = Fence False SyncSeqCst
|
|
|
4a2ee5f |
return (env, unitOL s, [])
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
+-- | Memory barrier instruction for LLVM < 3.0
|
|
|
4a2ee5f |
oldBarrier :: LlvmEnv -> UniqSM StmtData
|
|
|
4a2ee5f |
oldBarrier env = do
|
|
|
4a2ee5f |
let fname = fsLit "llvm.memory.barrier"
|
|
|
4a2ee5f |
@@ -172,7 +174,8 @@ genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
|
|
|
4a2ee5f |
genCall env (CmmPrim MO_WriteBarrier) _ _ _
|
|
|
4a2ee5f |
| platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
|
|
|
4a2ee5f |
= return (env, nilOL, [])
|
|
|
4a2ee5f |
- | otherwise = barrier env
|
|
|
4a2ee5f |
+ | getLlvmVer env > 29 = barrier env
|
|
|
4a2ee5f |
+ | otherwise = oldBarrier env
|
|
|
4a2ee5f |
|
|
|
4a2ee5f |
-- Handle popcnt function specifically since GHC only really has i32 and i64
|
|
|
4a2ee5f |
-- types and things like Word8 are backed by an i32 and just present a logical
|