Commit 21bc3ec7 authored by Michael D. Adams's avatar Michael D. Adams

Formatting changes for CPS code.

parent dd1dfdbf
......@@ -34,6 +34,90 @@ import Monad
import IO
import Data.List
-----------------------------------------------------------------------------
-- |Top level driver for the CPS pass
-----------------------------------------------------------------------------
cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
-> [Cmm] -- ^ Input C-- with Proceedures
-> IO [Cmm] -- ^ Output CPS transformed C--
cmmCPS dflags abstractC = do
when (dopt Opt_DoCmmLinting dflags) $
do showPass dflags "CmmLint"
case firstJust $ map cmmLint abstractC of
Just err -> do printDump err
ghcExit dflags 1
Nothing -> return ()
showPass dflags "CPS"
-- TODO: more lint checking
-- check for use of branches to non-existant blocks
-- check for use of Sp, SpLim, R1, R2, etc.
uniqSupply <- mkSplitUniqSupply 'p'
let supplies = listSplitUniqSupply uniqSupply
let doCpsProc s (Cmm c) =
Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
let continuationC = zipWith doCpsProc supplies abstractC
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
-- TODO: add option to dump Cmm to file
return continuationC
-----------------------------------------------------------------------------
-- |CPS a single CmmTop (proceedure)
-- Only 'CmmProc' are transformed 'CmmData' will be left alone.
-----------------------------------------------------------------------------
cpsProc :: UniqSupply
-> CmmTop -- ^Input proceedure
-> [CmmTop] -- ^Output proceedure and continuations
cpsProc uniqSupply x@(CmmData _ _) = [x]
cpsProc uniqSupply x@(CmmProc info_table ident params blocks) = cps_procs
where
uniqes :: [[Unique]]
uniqes = map uniqsFromSupply $ listSplitUniqSupply uniqSupply
-- Break the block at each function call.
-- The part after the function call will have to become a continuation.
broken_blocks :: [BrokenBlock]
broken_blocks =
concat $ zipWith3 breakBlock uniqes blocks
(FunctionEntry ident params:repeat ControlEntry)
-- Calculate live variables for each broken block.
--
-- Nothing can be live on entry to the first block
-- so we could take the tail, but for now we wont
-- to help future proof the code.
live :: BlockEntryLiveness
live = cmmLiveness $ map cmmBlockFromBrokenBlock broken_blocks
-- Calculate which blocks must be made into full fledged procedures.
proc_points :: UniqSet BlockId
proc_points = calculateProcPoints broken_blocks
-- Construct a map so we can lookup a broken block by its 'BlockId'.
block_env :: BlockEnv BrokenBlock
block_env = blocksToBlockEnv broken_blocks
-- Group the blocks into continuations based on the set of proc-points.
continuations :: [Continuation]
continuations = map (gatherBlocksIntoContinuation proc_points block_env)
(uniqSetToList proc_points)
-- Select the stack format on entry to each continuation.
--
-- This is an association list instead of a UniqFM because
-- CLabel's don't have a 'Uniqueable' instance.
formats :: [(CLabel, StackFormat)]
formats = selectStackFormat live continuations
-- Do the actual CPS transform.
cps_procs :: [CmmTop]
cps_procs = map (continuationToProc formats) continuations
--------------------------------------------------------------------------------
-- The format for the call to a continuation
......@@ -97,10 +181,15 @@ collectNonProcPointTargets proc_points blocks current_targets block =
-- TODO: remove redundant uniqSetToList
new_targets = current_targets `unionUniqSets` (mkUniqSet targets)
procPointToContinuation ::
-- TODO: insert proc point code here
-- * Branches and switches to proc points may cause new blocks to be created
-- (or proc points could leave behind phantom blocks that just jump to them)
-- * Proc points might get some live variables passed as arguments
gatherBlocksIntoContinuation ::
UniqSet BlockId -> BlockEnv BrokenBlock
-> BlockId -> Continuation
procPointToContinuation proc_points blocks start =
gatherBlocksIntoContinuation proc_points blocks start =
Continuation is_entry info_table clabel params body
where
children = (collectNonProcPointTargets proc_points blocks (unitUniqSet start) start) `delOneFromUniqSet` start
......@@ -251,144 +340,3 @@ unpack_continuation (StackFormat curr_id curr_frame_size curr_offsets)
(CmmLoad (CmmRegOff spReg (wORD_SIZE*offset)) (cmmRegRep reg))
| (reg, offset) <- curr_offsets]
-----------------------------------------------------------------------------
-- Breaking basic blocks on function calls
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- Takes a basic block and breaks it up into a list of broken blocks
--
-- Takes a basic block and returns a list of basic blocks that
-- each have at most 1 CmmCall in them which must occur at the end.
-- Also returns with each basic block, the variables that will
-- be arguments to the continuation of the block once the call (if any)
-- returns.
breakBlock :: [Unique] -> CmmBasicBlock -> BlockEntryInfo -> [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 or return"
[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" ++ (showSDoc $ ppr stmts))
(CmmCall target results arguments saves:stmts) -> block : rest
where
new_id = BlockId $ head uniques
block = BrokenBlock current_id entry accum_stmts
(new_id:exits)
(FinalCall new_id target results arguments saves)
rest = breakBlock' (tail uniques) new_id
(ContinuationEntry results) [] [] stmts
(s@(CmmCondBranch test target):stmts) ->
breakBlock' uniques current_id entry
(target:exits) (accum_stmts++[s]) stmts
(s:stmts) ->
breakBlock' uniques current_id entry
exits (accum_stmts++[s]) stmts
--------------------------------
-- Convert from a BrokenBlock
-- to a CmmBasicBlock so the
-- liveness analysis can run
-- on it.
--------------------------------
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]
-----------------------------------------------------------------------------
-- CPS a single CmmTop (proceedure)
-----------------------------------------------------------------------------
cpsProc :: UniqSupply -> CmmTop -> [CmmTop]
cpsProc uniqSupply x@(CmmData _ _) = [x]
cpsProc uniqSupply x@(CmmProc info_table ident params blocks) = cps_procs
where
uniqes :: [[Unique]]
uniqes = map uniqsFromSupply $ listSplitUniqSupply uniqSupply
-- Break the block at each function call
broken_blocks :: [BrokenBlock]
broken_blocks = concat $ zipWith3 breakBlock uniqes blocks
(FunctionEntry ident params:repeat ControlEntry)
-- Calculate live variables for each broken block
live :: BlockEntryLiveness
live = cmmLiveness $ map cmmBlockFromBrokenBlock broken_blocks
-- nothing can be live on entry to the first block so we could take the tail
proc_points :: UniqSet BlockId
proc_points = calculateProcPoints broken_blocks
-- TODO: insert proc point code here
-- * Branches and switches to proc points may cause new blocks to be created
-- (or proc points could leave behind phantom blocks that just jump to them)
-- * Proc points might get some live variables passed as arguments
continuations :: [Continuation]
continuations = map (procPointToContinuation proc_points (blocksToBlockEnv broken_blocks)) (uniqSetToList proc_points)
-- Select the stack format on entry to each block
formats :: [(CLabel, StackFormat)]
formats = selectStackFormat live continuations
-- Do the actual CPS transform
cps_procs :: [CmmTop]
cps_procs = map (continuationToProc formats) continuations
--------------------------------------------------------------------------------
cmmCPS :: DynFlags
-> [Cmm] -- C-- with Proceedures
-> IO [Cmm] -- Output: CPS transformed C--
cmmCPS dflags abstractC = do
when (dopt Opt_DoCmmLinting dflags) $
do showPass dflags "CmmLint"
case firstJust $ map cmmLint abstractC of
Just err -> do printDump err
ghcExit dflags 1
Nothing -> return ()
showPass dflags "CPS"
-- TODO: check for use of branches to non-existant blocks
-- TODO: check for use of Sp, SpLim, R1, R2, etc.
-- TODO: find out if it is valid to create a new unique source like this
uniqSupply <- mkSplitUniqSupply 'p'
let supplies = listSplitUniqSupply uniqSupply
let continuationC = zipWith (\s (Cmm c) -> Cmm $ concat $ zipWith (cpsProc) (listSplitUniqSupply s) c) supplies abstractC
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
-- TODO: add option to dump Cmm to file
return continuationC
module CmmLive (
CmmLive, BlockEntryLiveness,
CmmLive,
BlockEntryLiveness,
cmmLiveness,
cmmFormalsToLiveLocals
cmmFormalsToLiveLocals,
) where
#include "HsVersions.h"
......@@ -14,20 +15,24 @@ import Panic
import UniqFM
import UniqSet
import Data.List
-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------
-- The variables live on entry to a block
-- | The variables live on entry to a block
type CmmLive = UniqSet LocalReg
-- A mapping from block labels to the variables live on entry
-- | A mapping from block labels to the variables live on entry
type BlockEntryLiveness = BlockEnv CmmLive
-- | A mapping from block labels to the blocks that target it
type BlockSources = BlockEnv (UniqSet BlockId)
-- | A mapping from block labels to the statements in the block
type BlockStmts = BlockEnv [CmmStmt]
-----------------------------------------------------------------------------
-- cmmLiveness and helpers
-- | Calculated liveness info for a list of 'CmmBasicBlock'
-----------------------------------------------------------------------------
cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
cmmLiveness blocks =
......@@ -36,8 +41,14 @@ cmmLiveness blocks =
(map blockId blocks)
(listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
where
sources :: BlockSources
sources = cmmBlockSources blocks
blocks' = cmmBlockNames blocks
blocks' :: BlockStmts
blocks' = listToUFM $ map block_name blocks
block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
block_name b = (blockId b, blockStmts b)
{-
-- For debugging, annotate each block with a comment indicating
......@@ -51,27 +62,24 @@ cmmLivenessComment live (BasicBlock ident stmts) =
-}
--------------------------------
-- cmmBlockSources
--
-- Calculates a table of blocks
-- that might need updating after
-- a given block is updated
--------------------------------
cmmBlockSources :: [CmmBasicBlock] -> BlockEnv (UniqSet BlockId)
-----------------------------------------------------------------------------
-- | Calculates a table of where one can lookup the blocks that might
-- need updating after a given block is updated in the liveness analysis
-----------------------------------------------------------------------------
cmmBlockSources :: [CmmBasicBlock] -> BlockSources
cmmBlockSources blocks = foldr aux emptyUFM blocks
where
aux :: CmmBasicBlock
-> BlockEnv (UniqSet BlockId)
-> BlockEnv (UniqSet BlockId)
-> BlockSources
-> BlockSources
aux block sourcesUFM =
foldUniqSet (add_source_edges $ blockId block)
sourcesUFM
(branch_targets $ blockStmts block)
add_source_edges :: BlockId -> BlockId
-> BlockEnv (UniqSet BlockId)
-> BlockEnv (UniqSet BlockId)
-> BlockSources
-> BlockSources
add_source_edges source target ufm =
addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
......@@ -83,40 +91,22 @@ cmmBlockSources blocks = foldr aux emptyUFM blocks
target (CmmSwitch _ blocks) = mapMaybe id blocks
target _ = []
--------------------------------
-- cmmBlockNames
--
-- Calculates a table that maps
-- block names to the list
-- of statements inside them
--------------------------------
cmmBlockNames :: [CmmBasicBlock] -> BlockEnv [CmmStmt]
cmmBlockNames blocks = listToUFM $ map block_name blocks where
block_name b = (blockId b, blockStmts b)
--------------------------------
-- cmmBlockDependants
-----------------------------------------------------------------------------
-- | Given the table calculated by 'cmmBlockSources', list all blocks
-- that depend on the result of a particular block.
--
-- Given the table calculated
-- by cmmBlockSources created,
-- list all blocks that depend
-- on the result of a particular
-- block.
--------------------------------
cmmBlockDependants :: BlockEnv (UniqSet BlockId) -> BlockId -> [BlockId]
-- Used by the call to 'fixedpoint'.
-----------------------------------------------------------------------------
cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
cmmBlockDependants sources ident =
uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
--------------------------------
-- cmmBlockUpdate
--
-- Given the table from
-- cmmBlockNames and a block
-- that was updated, calculate
-- an updated BlockEntryLiveness
--------------------------------
-----------------------------------------------------------------------------
-- | Given the table of type 'BlockStmts' and a block that was updated,
-- calculate an updated BlockEntryLiveness
-----------------------------------------------------------------------------
cmmBlockUpdate ::
BlockEnv [CmmStmt]
BlockStmts
-> BlockId
-> Maybe BlockId
-> BlockEntryLiveness
......@@ -126,12 +116,18 @@ cmmBlockUpdate blocks node _ state =
then Nothing
else Just $ addToUFM state node new_live
where
new_live = cmmStmtListLive state block
new_live, old_live :: CmmLive
new_live = cmmStmtListLive state block_stmts
old_live = lookupWithDefaultUFM state missing_live node
block = lookupWithDefaultUFM blocks missing_block node
block_stmts :: [CmmStmt]
block_stmts = lookupWithDefaultUFM blocks missing_block node
missing_live = panic "unknown block id during liveness analysis"
missing_block = panic "unknown block id during liveness analysis"
-----------------------------------------------------------------------------
-- Section:
-----------------------------------------------------------------------------
-- CmmBlockLive, cmmStmtListLive and helpers
-----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment