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