diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-01-07 02:44:39 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-01-25 05:22:20 -0500 |
commit | 6e2d9ee25bce06ae51d2f1cf8df4f7422106a383 (patch) | |
tree | 4bb0aa9527bc0bed4fb2e991eb02d0f031d514bf /compiler/cmm/CmmImplementSwitchPlans.hs | |
parent | c3fde723633d1788e4ded8c6f59eb7cef1ae95fd (diff) | |
download | haskell-6e2d9ee25bce06ae51d2f1cf8df4f7422106a383.tar.gz |
Module hierarchy: Cmm (cf #13009)
Diffstat (limited to 'compiler/cmm/CmmImplementSwitchPlans.hs')
-rw-r--r-- | compiler/cmm/CmmImplementSwitchPlans.hs | 116 |
1 files changed, 0 insertions, 116 deletions
diff --git a/compiler/cmm/CmmImplementSwitchPlans.hs b/compiler/cmm/CmmImplementSwitchPlans.hs deleted file mode 100644 index 83c29cf6b5..0000000000 --- a/compiler/cmm/CmmImplementSwitchPlans.hs +++ /dev/null @@ -1,116 +0,0 @@ -{-# LANGUAGE GADTs #-} -module CmmImplementSwitchPlans - ( cmmImplementSwitchPlans - ) -where - -import GhcPrelude - -import Hoopl.Block -import BlockId -import Cmm -import CmmUtils -import CmmSwitch -import UniqSupply -import DynFlags - --- --- This module replaces Switch statements as generated by the Stg -> Cmm --- transformation, which might be huge and sparse and hence unsuitable for --- assembly code, by proper constructs (if-then-else trees, dense jump tables). --- --- The actual, abstract strategy is determined by createSwitchPlan in --- CmmSwitch and returned as a SwitchPlan; here is just the implementation in --- terms of Cmm code. See Note [Cmm Switches, the general plan] in CmmSwitch. --- --- This division into different modules is both to clearly separate concerns, --- but also because createSwitchPlan needs access to the constructors of --- SwitchTargets, a data type exported abstractly by CmmSwitch. --- - --- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for --- code generation. -cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph -cmmImplementSwitchPlans dflags g - -- Switch generation done by backend (LLVM/C) - | targetSupportsSwitch (hscTarget dflags) = return g - | otherwise = do - blocks' <- concat `fmap` mapM (visitSwitches dflags) (toBlockList g) - return $ ofBlockList (g_entry g) blocks' - -visitSwitches :: DynFlags -> CmmBlock -> UniqSM [CmmBlock] -visitSwitches dflags block - | (entry@(CmmEntry _ scope), middle, CmmSwitch vanillaExpr ids) <- blockSplit block - = do - let plan = createSwitchPlan ids - -- See Note [Floating switch expressions] - (assignSimple, simpleExpr) <- floatSwitchExpr dflags vanillaExpr - - (newTail, newBlocks) <- implementSwitchPlan dflags scope simpleExpr plan - - let block' = entry `blockJoinHead` middle `blockAppend` assignSimple `blockAppend` newTail - - return $ block' : newBlocks - - | otherwise - = return [block] - --- Note [Floating switch expressions] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - --- When we translate a sparse switch into a search tree we would like --- to compute the value we compare against only once. - --- For this purpose we assign the switch expression to a local register --- and then use this register when constructing the actual binary tree. - --- This is important as the expression could contain expensive code like --- memory loads or divisions which we REALLY don't want to duplicate. - --- This happened in parts of the handwritten RTS Cmm code. See also #16933 - --- See Note [Floating switch expressions] -floatSwitchExpr :: DynFlags -> CmmExpr -> UniqSM (Block CmmNode O O, CmmExpr) -floatSwitchExpr _ reg@(CmmReg {}) = return (emptyBlock, reg) -floatSwitchExpr dflags expr = do - (assign, expr') <- cmmMkAssign dflags expr <$> getUniqueM - return (BMiddle assign, expr') - - --- Implementing a switch plan (returning a tail block) -implementSwitchPlan :: DynFlags -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock]) -implementSwitchPlan dflags scope expr = go - where - go (Unconditionally l) - = return (emptyBlock `blockJoinTail` CmmBranch l, []) - go (JumpTable ids) - = return (emptyBlock `blockJoinTail` CmmSwitch expr ids, []) - go (IfLT signed i ids1 ids2) - = do - (bid1, newBlocks1) <- go' ids1 - (bid2, newBlocks2) <- go' ids2 - - let lt | signed = cmmSLtWord - | otherwise = cmmULtWord - scrut = lt dflags expr $ CmmLit $ mkWordCLit dflags i - lastNode = CmmCondBranch scrut bid1 bid2 Nothing - lastBlock = emptyBlock `blockJoinTail` lastNode - return (lastBlock, newBlocks1++newBlocks2) - go (IfEqual i l ids2) - = do - (bid2, newBlocks2) <- go' ids2 - - let scrut = cmmNeWord dflags expr $ CmmLit $ mkWordCLit dflags i - lastNode = CmmCondBranch scrut bid2 l Nothing - lastBlock = emptyBlock `blockJoinTail` lastNode - return (lastBlock, newBlocks2) - - -- Same but returning a label to branch to - go' (Unconditionally l) - = return (l, []) - go' p - = do - bid <- mkBlockId `fmap` getUniqueM - (last, newBlocks) <- go p - let block = CmmEntry bid scope `blockJoinHead` last - return (bid, block: newBlocks) |