compiler/cmm/CmmBrokenBlock.hs

   1 module CmmBrokenBlock (
   2   BrokenBlock(..),
   3   BlockEntryInfo(..),
   4   FinalStmt(..),
   5   breakBlock,
   6   cmmBlockFromBrokenBlock,
   7   blocksToBlockEnv,
   8   ) where
   9
  10 #include "HsVersions.h"
  11
  12 import Cmm
  13 import CLabel
  14
  15 import ClosureInfo
  16
  17 import Maybes
  18 import Panic
  19 import Unique
  20 import UniqFM
  21
  22 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
  23 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
  24 -- It also collects information about the block for later use
  25 -- by the CPS algorithm.
  26
  27 -----------------------------------------------------------------------------
  28 -- Data structures
  29 -----------------------------------------------------------------------------
  30
  31 -- |Similar to a 'CmmBlock' with a little extra information
  32 -- to help the CPS analysis.
  33 data BrokenBlock
  34   = BrokenBlock {
  35       brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
  36       brokenBlockEntry :: BlockEntryInfo,
  37                                 -- ^ Ways this block can be entered
  38
  39       brokenBlockStmts :: [CmmStmt],
  40                                 -- ^ Body like a CmmBasicBlock
  41                                 -- (but without the last statement)
  42
  43       brokenBlockTargets :: [BlockId],
  44                                 -- ^ Blocks that this block could
  45                                 -- branch to either by conditional
  46                                 -- branches or via the last statement
  47
  48       brokenBlockExit :: FinalStmt
  49                                 -- ^ The final statement of the block
  50     }
  51
  52 -- | How a block could be entered
  53 data BlockEntryInfo
  54   = FunctionEntry               -- ^ Block is the beginning of a function
  55       CmmInfo                   -- ^ Function header info
  56       CLabel                    -- ^ The function name
  57       CmmFormals                -- ^ Aguments to function
  58
  59   | ContinuationEntry           -- ^ Return point of a function call
  60       CmmFormals                -- ^ return values (argument to continuation)
  61       C_SRT                     -- ^ SRT for the continuation's info table
  62
  63   | ControlEntry                -- ^ Any other kind of block.
  64                                 -- Only entered due to control flow.
  65
  66   -- TODO: Consider adding ProcPointEntry
  67   -- no return values, but some live might end up as
  68   -- params or possibly in the frame
  69
  70
  71 -- | Final statement in a 'BlokenBlock'.
  72 -- Constructors and arguments match those in 'Cmm',
  73 -- but are restricted to branches, returns, jumps, calls and switches
  74 data FinalStmt
  75   = FinalBranch                 -- ^ Same as 'CmmBranch'
  76       BlockId                   -- ^ Target must be a ControlEntry
  77
  78   | FinalReturn                 -- ^ Same as 'CmmReturn'
  79       CmmActuals                -- ^ Return values
  80
  81   | FinalJump                   -- ^ Same as 'CmmJump'
  82       CmmExpr                   -- ^ The function to call
  83       CmmActuals                -- ^ Arguments of the call
  84
  85   | FinalCall                   -- ^ Same as 'CmmForeignCall'
  86                                 -- followed by 'CmmGoto'
  87       BlockId                   -- ^ Target of the 'CmmGoto'
  88                                 -- (must be a 'ContinuationEntry')
  89       CmmCallTarget             -- ^ The function to call
  90       CmmHintFormals                -- ^ Results from call
  91                                 -- (redundant with ContinuationEntry)
  92       CmmActuals                -- ^ Arguments to call
  93
  94   | FinalSwitch                 -- ^ Same as a 'CmmSwitch'
  95       CmmExpr                   -- ^ Scrutinee (zero based)
  96       [Maybe BlockId]           -- ^ Targets
  97
  98 -----------------------------------------------------------------------------
  99 -- Operations for broken blocks
 100 -----------------------------------------------------------------------------
 101
 102 -----------------------------------------------------------------------------
 103 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
 104 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
 105
 106 breakBlock ::
 107     [Unique]                    -- ^ An infinite list of uniques
 108                                 -- to create names of the new blocks with
 109     -> CmmBasicBlock            -- ^ Input block to break apart
 110     -> BlockEntryInfo           -- ^ Info for the first created 'BrokenBlock'
 111     -> [BrokenBlock]
 112 breakBlock uniques (BasicBlock ident stmts) entry =
 113     breakBlock' uniques ident entry [] [] stmts
 114     where
 115       breakBlock' uniques current_id entry exits accum_stmts stmts =
 116           case stmts of
 117             [] -> panic "block doesn't end in jump, goto, return or switch"
 118
 119             -- Last statement.  Make the 'BrokenBlock'
 120             [CmmJump target arguments] ->
 121                 [BrokenBlock current_id entry accum_stmts
 122                              exits
 123                              (FinalJump target arguments)]
 124             [CmmReturn arguments] ->
 125                 [BrokenBlock current_id entry accum_stmts
 126                              exits
 127                              (FinalReturn arguments)]
 128             [CmmBranch target] ->
 129                 [BrokenBlock current_id entry accum_stmts
 130                              (target:exits)
 131                              (FinalBranch target)]
 132             [CmmSwitch expr targets] ->
 133                 [BrokenBlock current_id entry accum_stmts
 134                              (mapMaybe id targets ++ exits)
 135                              (FinalSwitch expr targets)]
 136
 137             -- These shouldn't happen in the middle of a block.
 138             -- They would cause dead code.
 139             (CmmJump _ _:_) -> panic "jump in middle of block"
 140             (CmmReturn _:_) -> panic "return in middle of block"
 141             (CmmBranch _:_) -> panic "branch in middle of block"
 142             (CmmSwitch _ _:_) -> panic "switch in middle of block"
 143
 144             -- Detect this special case to remain an inverse of
 145             -- 'cmmBlockFromBrokenBlock'
 146             {- TODO: Interferes with proc point detection
 147             [CmmCall target results arguments,
 148              CmmBranch next_id] -> [block]
 149               where
 150                 block = do_call current_id entry accum_stmts exits next_id
 151                                 target results arguments
 152              -}
 153
 154             -- Break the block on safe calls (the main job of this function)
 155             (CmmCall target results arguments (CmmSafe srt):stmts) ->
 156                 block : rest
 157                 where
 158                   next_id = BlockId $ head uniques
 159                   block = do_call current_id entry accum_stmts exits next_id
 160                                   target results arguments
 161                   rest = breakBlock' (tail uniques) next_id
 162                                      (ContinuationEntry (map fst results) srt)
 163                                      [] [] stmts
 164
 165             -- Default case.  Just keep accumulating statements
 166             -- and branch targets.
 167             (s:stmts) ->
 168                 breakBlock' uniques current_id entry
 169                             (cond_branch_target s++exits)
 170                             (accum_stmts++[s])
 171                             stmts
 172
 173       do_call current_id entry accum_stmts exits next_id
 174               target results arguments =
 175           BrokenBlock current_id entry accum_stmts (next_id:exits)
 176                       (FinalCall next_id target results arguments)
 177
 178       cond_branch_target (CmmCondBranch _ target) = [target]
 179       cond_branch_target _ = []
 180
 181 -----------------------------------------------------------------------------
 182 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
 183 -- Needed by liveness analysis
 184 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
 185 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
 186     BasicBlock ident (stmts++exit_stmt)
 187     where
 188       exit_stmt =
 189           case exit of
 190             FinalBranch target -> [CmmBranch target]
 191             FinalReturn arguments -> [CmmReturn arguments]
 192             FinalJump target arguments -> [CmmJump target arguments]
 193             FinalSwitch expr targets -> [CmmSwitch expr targets]
 194             FinalCall branch_target call_target results arguments ->
 195                 [CmmCall call_target results arguments (panic "needed SRT from cmmBlockFromBrokenBlock"),
 196                  CmmBranch branch_target]
 197
 198 -----------------------------------------------------------------------------
 199 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
 200 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
 201 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks