never executed always true always false
1 {-# LANGUAGE GADTs #-}
2 module GHC.Cmm.Switch.Implement
3 ( cmmImplementSwitchPlans
4 )
5 where
6
7 import GHC.Prelude
8
9 import GHC.Driver.Backend
10 import GHC.Platform
11 import GHC.Cmm.Dataflow.Block
12 import GHC.Cmm.BlockId
13 import GHC.Cmm
14 import GHC.Cmm.Utils
15 import GHC.Cmm.Switch
16 import GHC.Types.Unique.Supply
17 import GHC.Utils.Monad (concatMapM)
18
19 --
20 -- This module replaces Switch statements as generated by the Stg -> Cmm
21 -- transformation, which might be huge and sparse and hence unsuitable for
22 -- assembly code, by proper constructs (if-then-else trees, dense jump tables).
23 --
24 -- The actual, abstract strategy is determined by createSwitchPlan in
25 -- GHC.Cmm.Switch and returned as a SwitchPlan; here is just the implementation in
26 -- terms of Cmm code. See Note [Cmm Switches, the general plan] in GHC.Cmm.Switch.
27 --
28 -- This division into different modules is both to clearly separate concerns,
29 -- but also because createSwitchPlan needs access to the constructors of
30 -- SwitchTargets, a data type exported abstractly by GHC.Cmm.Switch.
31 --
32
33 -- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for
34 -- code generation.
35 cmmImplementSwitchPlans :: Backend -> Platform -> CmmGraph -> UniqSM CmmGraph
36 cmmImplementSwitchPlans backend platform g
37 -- Switch generation done by backend (LLVM/C)
38 | backendSupportsSwitch backend = return g
39 | otherwise = do
40 blocks' <- concatMapM (visitSwitches platform) (toBlockList g)
41 return $ ofBlockList (g_entry g) blocks'
42
43 visitSwitches :: Platform -> CmmBlock -> UniqSM [CmmBlock]
44 visitSwitches platform block
45 | (entry@(CmmEntry _ scope), middle, CmmSwitch vanillaExpr ids) <- blockSplit block
46 = do
47 let plan = createSwitchPlan ids
48 -- See Note [Floating switch expressions]
49 (assignSimple, simpleExpr) <- floatSwitchExpr platform vanillaExpr
50
51 (newTail, newBlocks) <- implementSwitchPlan platform scope simpleExpr plan
52
53 let block' = entry `blockJoinHead` middle `blockAppend` assignSimple `blockAppend` newTail
54
55 return $ block' : newBlocks
56
57 | otherwise
58 = return [block]
59
60 -- Note [Floating switch expressions]
61 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
62
63 -- When we translate a sparse switch into a search tree we would like
64 -- to compute the value we compare against only once.
65
66 -- For this purpose we assign the switch expression to a local register
67 -- and then use this register when constructing the actual binary tree.
68
69 -- This is important as the expression could contain expensive code like
70 -- memory loads or divisions which we REALLY don't want to duplicate.
71
72 -- This happened in parts of the handwritten RTS Cmm code. See also #16933
73
74 -- See Note [Floating switch expressions]
75 floatSwitchExpr :: Platform -> CmmExpr -> UniqSM (Block CmmNode O O, CmmExpr)
76 floatSwitchExpr _ reg@(CmmReg {}) = return (emptyBlock, reg)
77 floatSwitchExpr platform expr = do
78 (assign, expr') <- cmmMkAssign platform expr <$> getUniqueM
79 return (BMiddle assign, expr')
80
81
82 -- Implementing a switch plan (returning a tail block)
83 implementSwitchPlan :: Platform -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock])
84 implementSwitchPlan platform scope expr = go
85 where
86 width = typeWidth $ cmmExprType platform expr
87
88 go (Unconditionally l)
89 = return (emptyBlock `blockJoinTail` CmmBranch l, [])
90 go (JumpTable ids)
91 = return (emptyBlock `blockJoinTail` CmmSwitch expr ids, [])
92 go (IfLT signed i ids1 ids2)
93 = do
94 (bid1, newBlocks1) <- go' ids1
95 (bid2, newBlocks2) <- go' ids2
96
97 let lt | signed = MO_S_Lt
98 | otherwise = MO_U_Lt
99 scrut = CmmMachOp (lt width) [expr, CmmLit $ CmmInt i width]
100 lastNode = CmmCondBranch scrut bid1 bid2 Nothing
101 lastBlock = emptyBlock `blockJoinTail` lastNode
102 return (lastBlock, newBlocks1++newBlocks2)
103 go (IfEqual i l ids2)
104 = do
105 (bid2, newBlocks2) <- go' ids2
106
107 let scrut = CmmMachOp (MO_Ne width) [expr, CmmLit $ CmmInt i width]
108 lastNode = CmmCondBranch scrut bid2 l Nothing
109 lastBlock = emptyBlock `blockJoinTail` lastNode
110 return (lastBlock, newBlocks2)
111
112 -- Same but returning a label to branch to
113 go' (Unconditionally l)
114 = return (l, [])
115 go' p
116 = do
117 bid <- mkBlockId `fmap` getUniqueM
118 (last, newBlocks) <- go p
119 let block = CmmEntry bid scope `blockJoinHead` last
120 return (bid, block: newBlocks)