Commit 766da942 authored by Ben Gamari's avatar Ben Gamari Committed by dterei
Browse files

llvmGen: Use new fence instruction


Signed-off-by: dterei's avatarDavid Terei <davidterei@gmail.com>
parent 6b086342
......@@ -20,6 +20,9 @@ module Llvm (
LlvmBlocks, LlvmBlock(..), LlvmBlockId,
LlvmParamAttr(..), LlvmParameter,
-- * Fence synchronization
LlvmSyncOrdering(..),
-- * Call Handling
LlvmCallConvention(..), LlvmCallType(..), LlvmParameterListType(..),
LlvmLinkageType(..), LlvmFuncAttr(..),
......
......@@ -64,6 +64,11 @@ data LlvmFunction = LlvmFunction {
type LlvmFunctions = [LlvmFunction]
data LlvmSyncOrdering = SyncAcquire
| SyncRelease
| SyncAcqRel
| SyncSeqCst
deriving (Show, Eq)
-- | Llvm Statements
data LlvmStatement
......@@ -74,6 +79,11 @@ data LlvmStatement
-}
= Assignment LlvmVar LlvmExpression
{- |
Memory fence operation
-}
| Fence Bool LlvmSyncOrdering
{- |
Always branch to the target label
-}
......
......@@ -211,6 +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
Branch target -> ind $ ppBranch target
BranchIf cond ifT ifF -> ind $ ppBranchIf cond ifT ifF
Comment comments -> ind $ ppLlvmComments comments
......@@ -301,6 +302,17 @@ ppCmpOp op left right =
ppAssignment :: LlvmVar -> Doc -> Doc
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
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"
ppLoad :: LlvmVar -> Doc
ppLoad var = text "load" <+> texts var
......
......@@ -137,16 +137,13 @@ stmtToInstrs env stmt = case stmt of
-> return (env, unitOL $ Return Nothing, [])
-- | Foreign Calls
genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
-> CmmReturnInfo -> UniqSM StmtData
barrier :: LlvmEnv -> UniqSM StmtData
barrier env = do
let s = Fence False SyncAcqRel
return (env, unitOL s, [])
-- Write barrier needs to be handled specially as it is implemented as an LLVM
-- intrinsic function.
genCall env (CmmPrim MO_WriteBarrier) _ _ _
| platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
= return (env, nilOL, [])
| otherwise = do
oldBarrier :: LlvmEnv -> UniqSM StmtData
oldBarrier env = do
let fname = fsLit "llvm.memory.barrier"
let funSig = LlvmFunctionDecl fname ExternallyVisible CC_Ccc LMVoid
FixedArgs (tysToParams [i1, i1, i1, i1, i1]) llvmFunAlign
......@@ -167,6 +164,17 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _
lmTrue :: LlvmVar
lmTrue = mkIntLit i1 (-1)
-- | Foreign Calls
genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
-> CmmReturnInfo -> UniqSM StmtData
-- Write barrier needs to be handled specially as it is implemented as an LLVM
-- intrinsic function.
genCall env (CmmPrim MO_WriteBarrier) _ _ _
| platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
= return (env, nilOL, [])
| otherwise = barrier 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
-- i8 range. So we must handle conversions from i32 to i8 explicitly as LLVM
......
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