diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 455422b47b4023f89d4df069fff0480518c2cafb..ed953ac5a88e37b1cb983bd2e0d0762cb42c8f07 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -282,19 +282,24 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
-- This helps the native codegen a little bit, and probably has no
-- effect on LLVM. It's convenient to do it here, where we have the
-- information about predecessors.
- --
- -- NB., only do this if the branch does not have a
- -- likeliness annotation.
swapcond_last
- | CmmCondBranch cond t f Nothing <- shortcut_last
+ | CmmCondBranch cond t f l <- shortcut_last
+ , likelyFalse l
, numPreds f > 1
, hasOnePredecessor t
, Just cond' <- maybeInvertCmmExpr cond
- = CmmCondBranch cond' f t Nothing
+ = CmmCondBranch cond' f t (invertLikeliness l)
| otherwise
= shortcut_last
+ likelyFalse (Just False) = True
+ likelyFalse Nothing = True
+ likelyFalse _ = False
+
+ invertLikeliness (Just b) = Just (not b)
+ invertLikeliness Nothing = Nothing
+
-- Number of predecessors for a block
numPreds bid = mapLookup bid backEdges `orElse` 0
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index ebff4402d0861bcc41d4b6b2657c23dad7d4c2d6..aa8855660b9e1f77b72574654f2e37f23ae725d6 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -636,7 +636,8 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
case mb_stk_hwm of
Nothing -> return ()
- Just stk_hwm -> tickyStackCheck >> (emit =<< mkCmmIfGoto (sp_oflo stk_hwm) gc_id)
+ Just stk_hwm -> tickyStackCheck
+ >> (emit =<< mkCmmIfGoto' (sp_oflo stk_hwm) gc_id (Just False) )
-- Emit new label that might potentially be a header
-- of a self-recursive tail call.
@@ -651,14 +652,14 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
then do
tickyHeapCheck
emitAssign hpReg bump_hp
- emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id)
+ emit =<< mkCmmIfThen' hp_oflo (alloc_n <*> mkBranch gc_id) (Just False)
else do
when (checkYield && not (gopt Opt_OmitYields dflags)) $ do
-- Yielding if HpLim == 0
let yielding = CmmMachOp (mo_wordEq dflags)
[CmmReg (CmmGlobal HpLim),
CmmLit (zeroCLit dflags)]
- emit =<< mkCmmIfGoto yielding gc_id
+ emit =<< mkCmmIfGoto' yielding gc_id (Just False)
tscope <- getTickScope
emitOutOfLine gc_id
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 836bf30f29e2cad66f9cd541907674774781d7a7..2184e12a8ca987c93b04768eb7b2131a72b3e776 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -26,6 +26,8 @@ module StgCmmMonad (
getCodeR, getCode, getCodeScoped, getHeapUsage,
mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto,
+ mkCmmIfThenElse', mkCmmIfThen', mkCmmIfGoto',
+
mkCall, mkCmmCall,
forkClosureBody, forkLneBody, forkAlts, codeOnly,
@@ -833,30 +835,50 @@ getCmm code
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
-mkCmmIfThenElse e tbranch fbranch = do
+mkCmmIfThenElse e tbranch fbranch = mkCmmIfThenElse' e tbranch fbranch Nothing
+
+mkCmmIfThenElse' :: CmmExpr -> CmmAGraph -> CmmAGraph
+ -> Maybe Bool -> FCode CmmAGraph
+mkCmmIfThenElse' e tbranch fbranch likely = do
tscp <- getTickScope
endif <- newLabelC
tid <- newLabelC
fid <- newLabelC
- return $ catAGraphs [ mkCbranch e tid fid Nothing
- , mkLabel tid tscp, tbranch, mkBranch endif
- , mkLabel fid tscp, fbranch, mkLabel endif tscp ]
+
+ let
+ (test, then_, else_, likely') = case likely of
+ Just False | Just e' <- maybeInvertCmmExpr e
+ -- currently NCG doesn't know about likely
+ -- annotations. We manually switch then and
+ -- else branch so the likely false branch
+ -- becomes a fallthrough.
+ -> (e', fbranch, tbranch, Just True)
+ _ -> (e, tbranch, fbranch, likely)
+
+ return $ catAGraphs [ mkCbranch test tid fid likely'
+ , mkLabel tid tscp, then_, mkBranch endif
+ , mkLabel fid tscp, else_, mkLabel endif tscp ]
mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
-mkCmmIfGoto e tid = do
+mkCmmIfGoto e tid = mkCmmIfGoto' e tid Nothing
+
+mkCmmIfGoto' :: CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
+mkCmmIfGoto' e tid l = do
endif <- newLabelC
tscp <- getTickScope
- return $ catAGraphs [ mkCbranch e tid endif Nothing, mkLabel endif tscp ]
+ return $ catAGraphs [ mkCbranch e tid endif l, mkLabel endif tscp ]
mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
-mkCmmIfThen e tbranch = do
+mkCmmIfThen e tbranch = mkCmmIfThen' e tbranch Nothing
+
+mkCmmIfThen' :: CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
+mkCmmIfThen' e tbranch l = do
endif <- newLabelC
tid <- newLabelC
tscp <- getTickScope
- return $ catAGraphs [ mkCbranch e tid endif Nothing
+ return $ catAGraphs [ mkCbranch e tid endif l
, mkLabel tid tscp, tbranch, mkLabel endif tscp ]
-
mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmExpr]
-> UpdFrameOffset -> [CmmExpr] -> FCode CmmAGraph
mkCall f (callConv, retConv) results actuals updfr_off extra_stack = do
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index fa47d6ada38376fc9562e78b39a6d491c4e20bf7..7b610c0a0a008c2f6025a4ebad1d7b25649e5159 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -118,8 +118,8 @@ stmtToInstrs stmt = case stmt of
CmmStore addr src -> genStore addr src
CmmBranch id -> genBranch id
- CmmCondBranch arg true false _ -- TODO: likely annotation
- -> genCondBranch arg true false
+ CmmCondBranch arg true false likely
+ -> genCondBranch arg true false likely
CmmSwitch arg ids -> genSwitch arg ids
-- Foreign Call
@@ -925,20 +925,41 @@ genBranch id =
-- | Conditional branch
-genCondBranch :: CmmExpr -> BlockId -> BlockId -> LlvmM StmtData
-genCondBranch cond idT idF = do
+genCondBranch :: CmmExpr -> BlockId -> BlockId -> Maybe Bool -> LlvmM StmtData
+genCondBranch cond idT idF likely = do
let labelT = blockIdToLlvm idT
let labelF = blockIdToLlvm idF
-- See Note [Literals and branch conditions].
- (vc, stmts, top) <- exprToVarOpt i1Option cond
+ (vc, stmts1, top1) <- exprToVarOpt i1Option cond
if getVarType vc == i1
then do
- let s1 = BranchIf vc labelT labelF
- return (stmts `snocOL` s1, top)
+ (vc', (stmts2, top2)) <- case likely of
+ Just b -> genExpectLit (if b then 1 else 0) i1 vc
+ _ -> pure (vc, (nilOL, []))
+ let s1 = BranchIf vc' labelT labelF
+ return (stmts1 `appOL` stmts2 `snocOL` s1, top1 ++ top2)
else do
dflags <- getDynFlags
panic $ "genCondBranch: Cond expr not bool! (" ++ showSDoc dflags (ppr vc) ++ ")"
+
+-- | Generate call to llvm.expect.x intrinsic. Assigning result to a new var.
+genExpectLit :: Integer -> LlvmType -> LlvmVar -> LlvmM (LlvmVar, StmtData)
+genExpectLit expLit expTy var = do
+ dflags <- getDynFlags
+
+ let
+ lit = LMLitVar $ LMIntLit expLit expTy
+
+ llvmExpectName
+ | isInt expTy = fsLit $ "llvm.expect." ++ showSDoc dflags (ppr expTy)
+ | otherwise = panic $ "genExpectedLit: Type not an int!"
+
+ (llvmExpect, stmts, top) <-
+ getInstrinct llvmExpectName expTy [expTy, expTy]
+ (var', call) <- doExpr expTy $ Call StdCall llvmExpect [var, lit] []
+ return (var', (stmts `snocOL` call, top))
+
{- Note [Literals and branch conditions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~