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