From 8bae799da7444d5debe0ce2e3f3f73692991a59d Mon Sep 17 00:00:00 2001 From: "Michael D. Adams" Date: Thu, 24 May 2007 16:01:28 +0000 Subject: [PATCH] Renamed CmmCPSData to CmmBrokenBlock and documented it --- compiler/cmm/CmmBrokenBlock.hs | 179 ++++++++++++++++++++++++++++++++++++++++ compiler/cmm/CmmCPS.hs | 8 +- compiler/cmm/CmmCPSData.hs | 74 ----------------- compiler/cmm/CmmProcPoint.hs | 2 +- 4 files changed, 186 insertions(+), 77 deletions(-) create mode 100644 compiler/cmm/CmmBrokenBlock.hs delete mode 100644 compiler/cmm/CmmCPSData.hs diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs new file mode 100644 index 0000000..2468260 --- /dev/null +++ b/compiler/cmm/CmmBrokenBlock.hs @@ -0,0 +1,179 @@ +module CmmBrokenBlock ( + BrokenBlock(..), + BlockEntryInfo(..), + FinalStmt(..), + breakBlock, + cmmBlockFromBrokenBlock, + blocksToBlockEnv, + ) where + +#include "HsVersions.h" + +import Cmm +import CLabel + +import Maybes +import Panic +import Unique +import UniqFM + +----------------------------------------------------------------------------- +-- Data structures +----------------------------------------------------------------------------- + +-- |Similar to a 'CmmBlock' with a little extra information +-- to help the CPS analysis. +data BrokenBlock + = BrokenBlock { + brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock' + brokenBlockEntry :: BlockEntryInfo, + -- ^ Ways this block can be entered + + brokenBlockStmts :: [CmmStmt], + -- ^ Body like a CmmBasicBlock + -- (but without the last statement) + + brokenBlockTargets :: [BlockId], + -- ^ Blocks that this block could + -- branch to one either by conditional + -- branches or via the last statement + + brokenBlockExit :: FinalStmt + -- ^ The final statement of the block + } + +-- | How a block could be entered +data BlockEntryInfo + = FunctionEntry -- ^ Block is the beginning of a function + CLabel -- ^ The function name + CmmFormals -- ^ Aguments to function + + | ContinuationEntry -- ^ Return point of a function call + CmmFormals -- ^ return values (argument to continuation) + + | ControlEntry -- ^ Any other kind of block. + -- Only entered due to control flow. + + -- TODO: Consider adding ProcPointEntry + -- no return values, but some live might end up as + -- params or possibly in the frame + + +-- | Final statement in a 'BlokenBlock'. +-- Constructors and arguments match those in 'Cmm', +-- but are restricted to branches, returns, jumps, calls and switches +data FinalStmt + = FinalBranch -- ^ Same as 'CmmBranch' + BlockId -- ^ Target must be a ControlEntry + + | FinalReturn -- ^ Same as 'CmmReturn' + CmmActuals -- ^ Return values + + | FinalJump -- ^ Same as 'CmmJump' + CmmExpr -- ^ The function to call + CmmActuals -- ^ Arguments of the call + + | FinalCall -- ^ Same as 'CmmForeignCall' + -- followed by 'CmmGoto' + BlockId -- ^ Target of the 'CmmGoto' + -- (must be a 'ContinuationEntry') + CmmCallTarget -- ^ The function to call + CmmFormals -- ^ Results from call + -- (redundant with ContinuationEntry) + CmmActuals -- ^ Arguments to call + (Maybe [GlobalReg]) -- ^ registers that must be saved (TODO) + + | FinalSwitch -- ^ Same as a 'CmmSwitch' + CmmExpr -- ^ Scrutinee (zero based) + [Maybe BlockId] -- ^ Targets + +----------------------------------------------------------------------------- +-- Operations for broken blocks +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- +-- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock' +-- by splitting on each 'CmmCall' in the 'CmmBasicBlock'. + +breakBlock :: + [Unique] -- ^ An infinite list of uniques + -- to create names of the new blocks with + -> CmmBasicBlock -- ^ Input block to break apart + -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock' + -> [BrokenBlock] +breakBlock uniques (BasicBlock ident stmts) entry = + breakBlock' uniques ident entry [] [] stmts + where + breakBlock' uniques current_id entry exits accum_stmts stmts = + case stmts of + [] -> panic "block doesn't end in jump, goto, return or switch" + [CmmJump target arguments] -> + [BrokenBlock current_id entry accum_stmts + exits + (FinalJump target arguments)] + [CmmReturn arguments] -> + [BrokenBlock current_id entry accum_stmts + exits + (FinalReturn arguments)] + [CmmBranch target] -> + [BrokenBlock current_id entry accum_stmts + (target:exits) + (FinalBranch target)] + [CmmSwitch expr targets] -> + [BrokenBlock current_id entry accum_stmts + (mapMaybe id targets ++ exits) + (FinalSwitch expr targets)] + (CmmJump _ _:_) -> panic "jump in middle of block" + (CmmReturn _:_) -> panic "return in middle of block" + (CmmBranch _:_) -> panic "branch in middle of block" + (CmmSwitch _ _:_) -> panic "switch in middle of block" + + -- Detect this special case to remain an inverse of + -- 'cmmBlockFromBrokenBlock' + [CmmCall target results arguments saves, + CmmBranch next_id] -> [block] + where + block = do_call current_id entry accum_stmts exits next_id + target results arguments saves + (CmmCall target results arguments saves:stmts) -> block : rest + where + next_id = BlockId $ head uniques + block = do_call current_id entry accum_stmts exits next_id + target results arguments saves + rest = breakBlock' (tail uniques) next_id + (ContinuationEntry results) [] [] stmts + (s:stmts) -> + breakBlock' uniques current_id entry + (cond_branch_target s++exits) + (accum_stmts++[s]) + stmts + + do_call current_id entry accum_stmts exits next_id + target results arguments saves = + BrokenBlock current_id entry accum_stmts (next_id:exits) + (FinalCall next_id target results arguments saves) + + cond_branch_target (CmmCondBranch _ target) = [target] + cond_branch_target _ = [] + +----------------------------------------------------------------------------- +-- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock +-- Needed by liveness analysis +cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock +cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) = + BasicBlock ident (stmts++exit_stmt) + where + exit_stmt = + case exit of + FinalBranch target -> [CmmBranch target] + FinalReturn arguments -> [CmmReturn arguments] + FinalJump target arguments -> [CmmJump target arguments] + FinalSwitch expr targets -> [CmmSwitch expr targets] + FinalCall branch_target call_target results arguments saves -> + [CmmCall call_target results arguments saves, + CmmBranch branch_target] + +----------------------------------------------------------------------------- +-- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId' +blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock +blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs index 10f0efc..b00a50f 100644 --- a/compiler/cmm/CmmCPS.hs +++ b/compiler/cmm/CmmCPS.hs @@ -1,4 +1,8 @@ -module CmmCPS (cmmCPS) where +module CmmCPS ( + -- | Converts C-- with full proceedures and parameters + -- to a CPS transformed C-- with the stack made manifest. + cmmCPS +) where #include "HsVersions.h" @@ -8,7 +12,7 @@ import PprCmm import Dataflow (fixedpoint) import CmmLive -import CmmCPSData +import CmmBrokenBlock import CmmProcPoint import MachOp diff --git a/compiler/cmm/CmmCPSData.hs b/compiler/cmm/CmmCPSData.hs deleted file mode 100644 index 7ea1d40..0000000 --- a/compiler/cmm/CmmCPSData.hs +++ /dev/null @@ -1,74 +0,0 @@ -module CmmCPSData ( - blocksToBlockEnv, - BrokenBlock(..), - BlockEntryInfo(..), - FinalStmt(..) - ) where - -#include "HsVersions.h" - -import Cmm -import CLabel - -import UniqFM - --- A minor helper (TODO document) -blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock -blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks - -data BrokenBlock - = BrokenBlock { - brokenBlockId :: BlockId, -- Like a CmmBasicBlock - brokenBlockEntry :: BlockEntryInfo, - -- How this block can be entered - - brokenBlockStmts :: [CmmStmt], - -- Like a CmmBasicBlock - -- (but without the last statement) - - brokenBlockTargets :: [BlockId], - -- Blocks that this block could - -- branch to one either by conditional - -- branches or via the last statement - - brokenBlockExit :: FinalStmt - -- How the block can be left - } - -data BlockEntryInfo - = FunctionEntry -- Beginning of a function - CLabel -- The function name - CmmFormals -- Aguments to function - - | ContinuationEntry -- Return point of a call - CmmFormals -- return values (argument to continuation) - -- TODO: - -- | ProcPointEntry -- no return values, but some live might end up as params or possibly in the frame - - | ControlEntry -- A label in the input - --- Final statement in a BlokenBlock --- Constructors and arguments match those in Cmm, --- but are restricted to branches, returns, jumps, calls and switches -data FinalStmt - = FinalBranch - BlockId -- next block (must be a ControlEntry) - - | FinalReturn - CmmActuals -- return values - - | FinalJump - CmmExpr -- the function to call - CmmActuals -- arguments to call - - | FinalCall - BlockId -- next block after call (must be a ContinuationEntry) - CmmCallTarget -- the function to call - CmmFormals -- results from call (redundant with ContinuationEntry) - CmmActuals -- arguments to call - (Maybe [GlobalReg]) -- registers that must be saved (TODO) - - | FinalSwitch - CmmExpr [Maybe BlockId] -- Table branch - - -- TODO: | ProcPointExit (needed?) diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs index c814862..729f424 100644 --- a/compiler/cmm/CmmProcPoint.hs +++ b/compiler/cmm/CmmProcPoint.hs @@ -5,7 +5,7 @@ module CmmProcPoint ( #include "HsVersions.h" import Cmm -import CmmCPSData +import CmmBrokenBlock import Dataflow import UniqSet -- 1.7.10.4