Commit 939a7d63 authored by Simon Marlow's avatar Simon Marlow

Annotate CmmBranch with an optional likely target

Summary:
This allows the code generator to give hints to later code generation
steps about which branch is most likely to be taken.  Right now it
is only taken into account in one place: a special case in
CmmContFlowOpt that swapped branches over to maximise the chance of
fallthrough, which is now disabled when there is a likelihood setting.

Test Plan: validate

Reviewers: austin, simonpj, bgamari, ezyang, tibbe

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1273
parent 65bf7baa
...@@ -137,7 +137,7 @@ hash_block block = ...@@ -137,7 +137,7 @@ hash_block block =
hash_node (CmmStore e e') = hash_e e + hash_e e' hash_node (CmmStore e e') = hash_e e + hash_e e'
hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as
hash_node (CmmBranch _) = 23 -- NB. ignore the label hash_node (CmmBranch _) = 23 -- NB. ignore the label
hash_node (CmmCondBranch p _ _) = hash_e p hash_node (CmmCondBranch p _ _ _) = hash_e p
hash_node (CmmCall e _ _ _ _ _) = hash_e e hash_node (CmmCall e _ _ _ _ _) = hash_e e
hash_node (CmmForeignCall t _ _ _ _ _ _) = hash_tgt t hash_node (CmmForeignCall t _ _ _ _ _ _) = hash_tgt t
hash_node (CmmSwitch e _) = hash_e e hash_node (CmmSwitch e _) = hash_e e
...@@ -247,8 +247,8 @@ eqBlockBodyWith eqBid block block' ...@@ -247,8 +247,8 @@ eqBlockBodyWith eqBid block block'
eqLastWith :: (BlockId -> BlockId -> Bool) -> CmmNode O C -> CmmNode O C -> Bool eqLastWith :: (BlockId -> BlockId -> Bool) -> CmmNode O C -> CmmNode O C -> Bool
eqLastWith eqBid (CmmBranch bid1) (CmmBranch bid2) = eqBid bid1 bid2 eqLastWith eqBid (CmmBranch bid1) (CmmBranch bid2) = eqBid bid1 bid2
eqLastWith eqBid (CmmCondBranch c1 t1 f1) (CmmCondBranch c2 t2 f2) = eqLastWith eqBid (CmmCondBranch c1 t1 f1 l1) (CmmCondBranch c2 t2 f2 l2) =
c1 == c2 && eqBid t1 t2 && eqBid f1 f2 c1 == c2 && l1 == l2 && eqBid t1 t2 && eqBid f1 f2
eqLastWith eqBid (CmmCall t1 c1 g1 a1 r1 u1) (CmmCall t2 c2 g2 a2 r2 u2) = eqLastWith eqBid (CmmCall t1 c1 g1 a1 r1 u1) (CmmCall t2 c2 g2 a2 r2 u2) =
t1 == t2 && eqMaybeWith eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2 t1 == t2 && eqMaybeWith eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2
eqLastWith eqBid (CmmSwitch e1 ids1) (CmmSwitch e2 ids2) = eqLastWith eqBid (CmmSwitch e1 ids1) (CmmSwitch e2 ids2) =
......
...@@ -282,12 +282,15 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id } ...@@ -282,12 +282,15 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
-- This helps the native codegen a little bit, and probably has no -- 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 -- effect on LLVM. It's convenient to do it here, where we have the
-- information about predecessors. -- information about predecessors.
--
-- NB., only do this if the branch does not have a
-- likeliness annotation.
swapcond_last swapcond_last
| CmmCondBranch cond t f <- shortcut_last | CmmCondBranch cond t f Nothing <- shortcut_last
, numPreds f > 1 , numPreds f > 1
, hasOnePredecessor t , hasOnePredecessor t
, Just cond' <- maybeInvertCmmExpr cond , Just cond' <- maybeInvertCmmExpr cond
= CmmCondBranch cond' f t = CmmCondBranch cond' f t Nothing
| otherwise | otherwise
= shortcut_last = shortcut_last
...@@ -355,11 +358,14 @@ replaceLabels env g ...@@ -355,11 +358,14 @@ replaceLabels env g
txnode :: CmmNode e x -> CmmNode e x txnode :: CmmNode e x -> CmmNode e x
txnode (CmmBranch bid) = CmmBranch (lookup bid) txnode (CmmBranch bid) = CmmBranch (lookup bid)
txnode (CmmCondBranch p t f) = mkCmmCondBranch (exp p) (lookup t) (lookup f) txnode (CmmCondBranch p t f l) =
txnode (CmmSwitch e ids) = CmmSwitch (exp e) (mapSwitchTargets lookup ids) mkCmmCondBranch (exp p) (lookup t) (lookup f) l
txnode (CmmCall t k rg a res r) = CmmCall (exp t) (liftM lookup k) rg a res r txnode (CmmSwitch e ids) =
txnode fc@CmmForeignCall{} = fc{ args = map exp (args fc) CmmSwitch (exp e) (mapSwitchTargets lookup ids)
, succ = lookup (succ fc) } txnode (CmmCall t k rg a res r) =
CmmCall (exp t) (liftM lookup k) rg a res r
txnode fc@CmmForeignCall{} =
fc{ args = map exp (args fc), succ = lookup (succ fc) }
txnode other = mapExpDeep exp other txnode other = mapExpDeep exp other
exp :: CmmExpr -> CmmExpr exp :: CmmExpr -> CmmExpr
...@@ -367,8 +373,9 @@ replaceLabels env g ...@@ -367,8 +373,9 @@ replaceLabels env g
exp (CmmStackSlot (Young id) i) = CmmStackSlot (Young (lookup id)) i exp (CmmStackSlot (Young id) i) = CmmStackSlot (Young (lookup id)) i
exp e = e exp e = e
mkCmmCondBranch :: CmmExpr -> Label -> Label -> CmmNode O C mkCmmCondBranch :: CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C
mkCmmCondBranch p t f = if t == f then CmmBranch t else CmmCondBranch p t f mkCmmCondBranch p t f l =
if t == f then CmmBranch t else CmmCondBranch p t f l
-- Build a map from a block to its set of predecessors. -- Build a map from a block to its set of predecessors.
predMap :: [CmmBlock] -> BlockEnv Int predMap :: [CmmBlock] -> BlockEnv Int
......
...@@ -67,7 +67,7 @@ implementSwitchPlan dflags scope expr = go ...@@ -67,7 +67,7 @@ implementSwitchPlan dflags scope expr = go
let lt | signed = cmmSLtWord let lt | signed = cmmSLtWord
| otherwise = cmmULtWord | otherwise = cmmULtWord
scrut = lt dflags expr $ CmmLit $ mkWordCLit dflags i scrut = lt dflags expr $ CmmLit $ mkWordCLit dflags i
lastNode = CmmCondBranch scrut bid1 bid2 lastNode = CmmCondBranch scrut bid1 bid2 Nothing
lastBlock = emptyBlock `blockJoinTail` lastNode lastBlock = emptyBlock `blockJoinTail` lastNode
return (lastBlock, newBlocks1++newBlocks2) return (lastBlock, newBlocks1++newBlocks2)
go (IfEqual i l ids2) go (IfEqual i l ids2)
...@@ -75,7 +75,7 @@ implementSwitchPlan dflags scope expr = go ...@@ -75,7 +75,7 @@ implementSwitchPlan dflags scope expr = go
(bid2, newBlocks2) <- go' ids2 (bid2, newBlocks2) <- go' ids2
let scrut = cmmNeWord dflags expr $ CmmLit $ mkWordCLit dflags i let scrut = cmmNeWord dflags expr $ CmmLit $ mkWordCLit dflags i
lastNode = CmmCondBranch scrut bid2 l lastNode = CmmCondBranch scrut bid2 l Nothing
lastBlock = emptyBlock `blockJoinTail` lastNode lastBlock = emptyBlock `blockJoinTail` lastNode
return (lastBlock, newBlocks2) return (lastBlock, newBlocks2)
......
...@@ -884,7 +884,7 @@ areaToSp _ _ _ _ other = other ...@@ -884,7 +884,7 @@ areaToSp _ _ _ _ other = other
optStackCheck :: CmmNode O C -> CmmNode O C optStackCheck :: CmmNode O C -> CmmNode O C
optStackCheck n = -- Note [Always false stack check] optStackCheck n = -- Note [Always false stack check]
case n of case n of
CmmCondBranch (CmmLit (CmmInt 0 _)) _true false -> CmmBranch false CmmCondBranch (CmmLit (CmmInt 0 _)) _true false _ -> CmmBranch false
other -> other other -> other
......
...@@ -165,7 +165,7 @@ lintCmmLast :: BlockSet -> CmmNode O C -> CmmLint () ...@@ -165,7 +165,7 @@ lintCmmLast :: BlockSet -> CmmNode O C -> CmmLint ()
lintCmmLast labels node = case node of lintCmmLast labels node = case node of
CmmBranch id -> checkTarget id CmmBranch id -> checkTarget id
CmmCondBranch e t f -> do CmmCondBranch e t f _ -> do
dflags <- getDynFlags dflags <- getDynFlags
mapM_ checkTarget [t,f] mapM_ checkTarget [t,f]
_ <- lintCmmExpr e _ <- lintCmmExpr e
......
...@@ -87,7 +87,9 @@ data CmmNode e x where ...@@ -87,7 +87,9 @@ data CmmNode e x where
CmmCondBranch :: { -- conditional branch CmmCondBranch :: { -- conditional branch
cml_pred :: CmmExpr, cml_pred :: CmmExpr,
cml_true, cml_false :: ULabel cml_true, cml_false :: ULabel,
cml_likely :: Maybe Bool -- likely result of the conditional,
-- if known
} -> CmmNode O C } -> CmmNode O C
CmmSwitch CmmSwitch
...@@ -308,7 +310,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where ...@@ -308,7 +310,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where
CmmAssign _ expr -> fold f z expr CmmAssign _ expr -> fold f z expr
CmmStore addr rval -> fold f (fold f z addr) rval CmmStore addr rval -> fold f (fold f z addr) rval
CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
CmmCondBranch expr _ _ -> fold f z expr CmmCondBranch expr _ _ _ -> fold f z expr
CmmSwitch expr _ -> fold f z expr CmmSwitch expr _ -> fold f z expr
CmmCall {cml_target=tgt} -> fold f z tgt CmmCall {cml_target=tgt} -> fold f z tgt
CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
...@@ -323,7 +325,7 @@ instance UserOfRegs GlobalReg (CmmNode e x) where ...@@ -323,7 +325,7 @@ instance UserOfRegs GlobalReg (CmmNode e x) where
CmmAssign _ expr -> fold f z expr CmmAssign _ expr -> fold f z expr
CmmStore addr rval -> fold f (fold f z addr) rval CmmStore addr rval -> fold f (fold f z addr) rval
CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
CmmCondBranch expr _ _ -> fold f z expr CmmCondBranch expr _ _ _ -> fold f z expr
CmmSwitch expr _ -> fold f z expr CmmSwitch expr _ -> fold f z expr
CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt
CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
...@@ -463,7 +465,7 @@ mapExp f (CmmAssign r e) = CmmAssign r (f e) ...@@ -463,7 +465,7 @@ mapExp f (CmmAssign r e) = CmmAssign r (f e)
mapExp f (CmmStore addr e) = CmmStore (f addr) (f e) mapExp f (CmmStore addr e) = CmmStore (f addr) (f e)
mapExp f (CmmUnsafeForeignCall tgt fs as) = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as) mapExp f (CmmUnsafeForeignCall tgt fs as) = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as)
mapExp _ l@(CmmBranch _) = l mapExp _ l@(CmmBranch _) = l
mapExp f (CmmCondBranch e ti fi) = CmmCondBranch (f e) ti fi mapExp f (CmmCondBranch e ti fi l) = CmmCondBranch (f e) ti fi l
mapExp f (CmmSwitch e ids) = CmmSwitch (f e) ids mapExp f (CmmSwitch e ids) = CmmSwitch (f e) ids
mapExp f n@CmmCall {cml_target=tgt} = n{cml_target = f tgt} mapExp f n@CmmCall {cml_target=tgt} = n{cml_target = f tgt}
mapExp f (CmmForeignCall tgt fs as succ ret_args updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ ret_args updfr intrbl mapExp f (CmmForeignCall tgt fs as succ ret_args updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ ret_args updfr intrbl
...@@ -493,7 +495,7 @@ mapExpM f (CmmUnwind r e) = CmmUnwind r `fmap` f e ...@@ -493,7 +495,7 @@ mapExpM f (CmmUnwind r e) = CmmUnwind r `fmap` f e
mapExpM f (CmmAssign r e) = CmmAssign r `fmap` f e mapExpM f (CmmAssign r e) = CmmAssign r `fmap` f e
mapExpM f (CmmStore addr e) = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e] mapExpM f (CmmStore addr e) = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e]
mapExpM _ (CmmBranch _) = Nothing mapExpM _ (CmmBranch _) = Nothing
mapExpM f (CmmCondBranch e ti fi) = (\x -> CmmCondBranch x ti fi) `fmap` f e mapExpM f (CmmCondBranch e ti fi l) = (\x -> CmmCondBranch x ti fi l) `fmap` f e
mapExpM f (CmmSwitch e tbl) = (\x -> CmmSwitch x tbl) `fmap` f e mapExpM f (CmmSwitch e tbl) = (\x -> CmmSwitch x tbl) `fmap` f e
mapExpM f (CmmCall tgt mb_id r o i s) = (\x -> CmmCall x mb_id r o i s) `fmap` f tgt mapExpM f (CmmCall tgt mb_id r o i s) = (\x -> CmmCall x mb_id r o i s) `fmap` f tgt
mapExpM f (CmmUnsafeForeignCall tgt fs as) mapExpM f (CmmUnsafeForeignCall tgt fs as)
...@@ -547,7 +549,7 @@ foldExp f (CmmAssign _ e) z = f e z ...@@ -547,7 +549,7 @@ foldExp f (CmmAssign _ e) z = f e z
foldExp f (CmmStore addr e) z = f addr $ f e z foldExp f (CmmStore addr e) z = f addr $ f e z
foldExp f (CmmUnsafeForeignCall t _ as) z = foldr f (foldExpForeignTarget f t z) as foldExp f (CmmUnsafeForeignCall t _ as) z = foldr f (foldExpForeignTarget f t z) as
foldExp _ (CmmBranch _) z = z foldExp _ (CmmBranch _) z = z
foldExp f (CmmCondBranch e _ _) z = f e z foldExp f (CmmCondBranch e _ _ _) z = f e z
foldExp f (CmmSwitch e _) z = f e z foldExp f (CmmSwitch e _) z = f e z
foldExp f (CmmCall {cml_target=tgt}) z = f tgt z foldExp f (CmmCall {cml_target=tgt}) z = f tgt z
foldExp f (CmmForeignCall {tgt=tgt, args=args}) z = foldr f (foldExpForeignTarget f tgt z) args foldExp f (CmmForeignCall {tgt=tgt, args=args}) z = foldr f (foldExpForeignTarget f tgt z) args
...@@ -559,7 +561,7 @@ foldExpDeep f = foldExp (wrapRecExpf f) ...@@ -559,7 +561,7 @@ foldExpDeep f = foldExp (wrapRecExpf f)
mapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C mapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C
mapSuccessors f (CmmBranch bid) = CmmBranch (f bid) mapSuccessors f (CmmBranch bid) = CmmBranch (f bid)
mapSuccessors f (CmmCondBranch p y n) = CmmCondBranch p (f y) (f n) mapSuccessors f (CmmCondBranch p y n l) = CmmCondBranch p (f y) (f n) l
mapSuccessors f (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets f ids) mapSuccessors f (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets f ids)
mapSuccessors _ n = n mapSuccessors _ n = n
......
...@@ -1268,7 +1268,7 @@ cmmRawIf cond then_id = do ...@@ -1268,7 +1268,7 @@ cmmRawIf cond then_id = do
-- branching to true_id if so, and falling through otherwise. -- branching to true_id if so, and falling through otherwise.
emitCond (BoolTest e) then_id = do emitCond (BoolTest e) then_id = do
else_id <- newBlockId else_id <- newBlockId
emit (mkCbranch e then_id else_id) emit (mkCbranch e then_id else_id Nothing)
emitLabel else_id emitLabel else_id
emitCond (BoolNot (BoolTest (CmmMachOp op args))) then_id emitCond (BoolNot (BoolTest (CmmMachOp op args))) then_id
| Just op' <- maybeInvertComparison op | Just op' <- maybeInvertComparison op
......
...@@ -295,7 +295,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap ...@@ -295,7 +295,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
add_if_branch_to_pp block rst = add_if_branch_to_pp block rst =
case lastNode block of case lastNode block of
CmmBranch id -> add_if_pp id rst CmmBranch id -> add_if_pp id rst
CmmCondBranch _ ti fi -> add_if_pp ti (add_if_pp fi rst) CmmCondBranch _ ti fi _ -> add_if_pp ti (add_if_pp fi rst)
CmmSwitch _ ids -> foldr add_if_pp rst $ switchTargetsToList ids CmmSwitch _ ids -> foldr add_if_pp rst $ switchTargetsToList ids
_ -> rst _ -> rst
...@@ -382,7 +382,7 @@ replaceBranches env cmmg ...@@ -382,7 +382,7 @@ replaceBranches env cmmg
last :: CmmNode O C -> CmmNode O C last :: CmmNode O C -> CmmNode O C
last (CmmBranch id) = CmmBranch (lookup id) last (CmmBranch id) = CmmBranch (lookup id)
last (CmmCondBranch e ti fi) = CmmCondBranch e (lookup ti) (lookup fi) last (CmmCondBranch e ti fi l) = CmmCondBranch e (lookup ti) (lookup fi) l
last (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets lookup ids) last (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets lookup ids)
last l@(CmmCall {}) = l { cml_cont = Nothing } last l@(CmmCall {}) = l { cml_cont = Nothing }
-- NB. remove the continuation of a CmmCall, since this -- NB. remove the continuation of a CmmCall, since this
......
...@@ -35,7 +35,7 @@ import OrdList ...@@ -35,7 +35,7 @@ import OrdList
import Control.Monad import Control.Monad
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Prelude (($),Int,Eq(..)) -- avoid importing (<*>) import Prelude (($),Int,Bool,Eq(..)) -- avoid importing (<*>)
#include "HsVersions.h" #include "HsVersions.h"
...@@ -221,8 +221,9 @@ mkJumpExtra dflags conv e actuals updfr_off extra_stack = ...@@ -221,8 +221,9 @@ mkJumpExtra dflags conv e actuals updfr_off extra_stack =
lastWithArgsAndExtraStack dflags Jump Old conv actuals updfr_off extra_stack $ lastWithArgsAndExtraStack dflags Jump Old conv actuals updfr_off extra_stack $
toCall e Nothing updfr_off 0 toCall e Nothing updfr_off 0
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph mkCbranch :: CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
mkCbranch pred ifso ifnot = mkLast (CmmCondBranch pred ifso ifnot) mkCbranch pred ifso ifnot likely =
mkLast (CmmCondBranch pred ifso ifnot likely)
mkSwitch :: CmmExpr -> SwitchTargets -> CmmAGraph mkSwitch :: CmmExpr -> SwitchTargets -> CmmAGraph
mkSwitch e tbl = mkLast $ CmmSwitch e tbl mkSwitch e tbl = mkLast $ CmmSwitch e tbl
......
...@@ -249,7 +249,7 @@ pprStmt stmt = ...@@ -249,7 +249,7 @@ pprStmt stmt =
= pprCall fn cconv hresults hargs = pprCall fn cconv hresults hargs
CmmBranch ident -> pprBranch ident CmmBranch ident -> pprBranch ident
CmmCondBranch expr yes no -> pprCondBranch expr yes no CmmCondBranch expr yes no _ -> pprCondBranch expr yes no
CmmCall { cml_target = expr } -> mkJMP_ (pprExpr expr) <> semi CmmCall { cml_target = expr } -> mkJMP_ (pprExpr expr) <> semi
CmmSwitch arg ids -> sdocWithDynFlags $ \dflags -> CmmSwitch arg ids -> sdocWithDynFlags $ \dflags ->
pprSwitch dflags arg ids pprSwitch dflags arg ids
...@@ -1042,7 +1042,7 @@ te_Stmt (CmmUnsafeForeignCall target rs es) ...@@ -1042,7 +1042,7 @@ te_Stmt (CmmUnsafeForeignCall target rs es)
= do te_Target target = do te_Target target
mapM_ te_temp rs mapM_ te_temp rs
mapM_ te_Expr es mapM_ te_Expr es
te_Stmt (CmmCondBranch e _ _) = te_Expr e te_Stmt (CmmCondBranch e _ _ _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e te_Stmt (CmmSwitch e _) = te_Expr e
te_Stmt (CmmCall { cml_target = e }) = te_Expr e te_Stmt (CmmCall { cml_target = e }) = te_Expr e
te_Stmt _ = return () te_Stmt _ = return ()
......
...@@ -220,9 +220,12 @@ pprNode node = pp_node <+> pp_debug ...@@ -220,9 +220,12 @@ pprNode node = pp_node <+> pp_debug
CmmBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi CmmBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi
-- if (expr) goto t; else goto f; -- if (expr) goto t; else goto f;
CmmCondBranch expr t f -> CmmCondBranch expr t f l ->
hsep [ ptext (sLit "if") hsep [ ptext (sLit "if")
, parens(ppr expr) , parens(ppr expr)
, case l of
Nothing -> empty
Just b -> parens (ptext (sLit "likely:") <+> ppr b)
, ptext (sLit "goto") , ptext (sLit "goto")
, ppr t <> semi , ppr t <> semi
, ptext (sLit "else goto") , ptext (sLit "else goto")
......
...@@ -876,7 +876,8 @@ emitEnter fun = do ...@@ -876,7 +876,8 @@ emitEnter fun = do
; tscope <- getTickScope ; tscope <- getTickScope
; emit $ ; emit $
copyout <*> copyout <*>
mkCbranch (cmmIsTagged dflags (CmmReg nodeReg)) lret lcall <*> mkCbranch (cmmIsTagged dflags (CmmReg nodeReg))
lret lcall Nothing <*>
outOfLine lcall (the_call,tscope) <*> outOfLine lcall (the_call,tscope) <*>
mkLabel lret tscope <*> mkLabel lret tscope <*>
copyin copyin
......
...@@ -226,9 +226,10 @@ slowCall fun stg_args ...@@ -226,9 +226,10 @@ slowCall fun stg_args
(mkIntExpr dflags n_args) (mkIntExpr dflags n_args)
tscope <- getTickScope tscope <- getTickScope
emit (mkCbranch (cmmIsTagged dflags funv) is_tagged_lbl slow_lbl emit (mkCbranch (cmmIsTagged dflags funv)
is_tagged_lbl slow_lbl (Just True)
<*> mkLabel is_tagged_lbl tscope <*> mkLabel is_tagged_lbl tscope
<*> mkCbranch correct_arity fast_lbl slow_lbl <*> mkCbranch correct_arity fast_lbl slow_lbl (Just True)
<*> mkLabel fast_lbl tscope <*> mkLabel fast_lbl tscope
<*> fast_code <*> fast_code
<*> mkBranch end_lbl <*> mkBranch end_lbl
......
...@@ -831,7 +831,7 @@ mkCmmIfThenElse e tbranch fbranch = do ...@@ -831,7 +831,7 @@ mkCmmIfThenElse e tbranch fbranch = do
endif <- newLabelC endif <- newLabelC
tid <- newLabelC tid <- newLabelC
fid <- newLabelC fid <- newLabelC
return $ catAGraphs [ mkCbranch e tid fid return $ catAGraphs [ mkCbranch e tid fid Nothing
, mkLabel tid tscp, tbranch, mkBranch endif , mkLabel tid tscp, tbranch, mkBranch endif
, mkLabel fid tscp, fbranch, mkLabel endif tscp ] , mkLabel fid tscp, fbranch, mkLabel endif tscp ]
...@@ -839,14 +839,14 @@ mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph ...@@ -839,14 +839,14 @@ mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
mkCmmIfGoto e tid = do mkCmmIfGoto e tid = do
endif <- newLabelC endif <- newLabelC
tscp <- getTickScope tscp <- getTickScope
return $ catAGraphs [ mkCbranch e tid endif, mkLabel endif tscp ] return $ catAGraphs [ mkCbranch e tid endif Nothing, mkLabel endif tscp ]
mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThen e tbranch = do mkCmmIfThen e tbranch = do
endif <- newLabelC endif <- newLabelC
tid <- newLabelC tid <- newLabelC
tscp <- getTickScope tscp <- getTickScope
return $ catAGraphs [ mkCbranch e tid endif return $ catAGraphs [ mkCbranch e tid endif Nothing
, mkLabel tid tscp, tbranch, mkLabel endif tscp ] , mkLabel tid tscp, tbranch, mkLabel endif tscp ]
......
...@@ -558,7 +558,7 @@ mk_float_switch :: Width -> CmmExpr -> BlockId ...@@ -558,7 +558,7 @@ mk_float_switch :: Width -> CmmExpr -> BlockId
-> FCode CmmAGraph -> FCode CmmAGraph
mk_float_switch rep scrut deflt _bounds [(lit,blk)] mk_float_switch rep scrut deflt _bounds [(lit,blk)]
= do dflags <- getDynFlags = do dflags <- getDynFlags
return $ mkCbranch (cond dflags) deflt blk return $ mkCbranch (cond dflags) deflt blk Nothing
where where
cond dflags = CmmMachOp ne [scrut, CmmLit cmm_lit] cond dflags = CmmMachOp ne [scrut, CmmLit cmm_lit]
where where
......
...@@ -119,7 +119,7 @@ stmtToInstrs stmt = case stmt of ...@@ -119,7 +119,7 @@ stmtToInstrs stmt = case stmt of
CmmStore addr src -> genStore addr src CmmStore addr src -> genStore addr src
CmmBranch id -> genBranch id CmmBranch id -> genBranch id
CmmCondBranch arg true false CmmCondBranch arg true false _ -- TODO: likely annotation
-> genCondBranch arg true false -> genCondBranch arg true false
CmmSwitch arg ids -> genSwitch arg ids CmmSwitch arg ids -> genSwitch arg ids
......
...@@ -1046,12 +1046,12 @@ cmmStmtConFold stmt ...@@ -1046,12 +1046,12 @@ cmmStmtConFold stmt
args' <- mapM (cmmExprConFold DataReference) args args' <- mapM (cmmExprConFold DataReference) args
return $ CmmUnsafeForeignCall target' regs args' return $ CmmUnsafeForeignCall target' regs args'
CmmCondBranch test true false CmmCondBranch test true false likely
-> do test' <- cmmExprConFold DataReference test -> do test' <- cmmExprConFold DataReference test
return $ case test' of return $ case test' of
CmmLit (CmmInt 0 _) -> CmmBranch false CmmLit (CmmInt 0 _) -> CmmBranch false
CmmLit (CmmInt _ _) -> CmmBranch true CmmLit (CmmInt _ _) -> CmmBranch true
_other -> CmmCondBranch test' true false _other -> CmmCondBranch test' true false likely
CmmSwitch expr ids CmmSwitch expr ids
-> do expr' <- cmmExprConFold DataReference expr -> do expr' <- cmmExprConFold DataReference expr
......
...@@ -160,7 +160,8 @@ stmtToInstrs stmt = do ...@@ -160,7 +160,8 @@ stmtToInstrs stmt = do
-> genCCall target result_regs args -> genCCall target result_regs args
CmmBranch id -> genBranch id CmmBranch id -> genBranch id
CmmCondBranch arg true false -> do b1 <- genCondJump true arg CmmCondBranch arg true false _ -> do
b1 <- genCondJump true arg
b2 <- genBranch false b2 <- genBranch false
return (b1 `appOL` b2) return (b1 `appOL` b2)
CmmSwitch arg ids -> do dflags <- getDynFlags CmmSwitch arg ids -> do dflags <- getDynFlags
......
...@@ -148,7 +148,8 @@ stmtToInstrs stmt = do ...@@ -148,7 +148,8 @@ stmtToInstrs stmt = do
-> genCCall target result_regs args -> genCCall target result_regs args
CmmBranch id -> genBranch id CmmBranch id -> genBranch id
CmmCondBranch arg true false -> do b1 <- genCondJump true arg CmmCondBranch arg true false _ -> do
b1 <- genCondJump true arg
b2 <- genBranch false b2 <- genBranch false
return (b1 `appOL` b2) return (b1 `appOL` b2)
CmmSwitch arg ids -> do dflags <- getDynFlags CmmSwitch arg ids -> do dflags <- getDynFlags
......
...@@ -177,7 +177,8 @@ stmtToInstrs stmt = do ...@@ -177,7 +177,8 @@ stmtToInstrs stmt = do
-> genCCall dflags is32Bit target result_regs args -> genCCall dflags is32Bit target result_regs args
CmmBranch id -> genBranch id CmmBranch id -> genBranch id
CmmCondBranch arg true false -> do b1 <- genCondJump true arg CmmCondBranch arg true false _ -> do
b1 <- genCondJump true arg
b2 <- genBranch false b2 <- genBranch false
return (b1 `appOL` b2) return (b1 `appOL` b2)
CmmSwitch arg ids -> do dflags <- getDynFlags CmmSwitch arg ids -> do dflags <- getDynFlags
......
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