Commit 569348e8 authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu
Browse files

remove remaining redundancies from ZipCfgCmmRep

  -- LastBranch no longer takes parameters
  -- LastJump and LastReturn no longer carry CmmActuals;
     instead, those are carried by a CopyOut in the same basic block
parent 5c77b95c
......@@ -85,7 +85,7 @@ branchChainElimZ g@(G.LGraph eid _)
lookup id = G.lookupBlockEnv env id `orElse` id
isLoneBranchZ :: CmmBlock -> Either (G.BlockId, G.BlockId) CmmBlock
isLoneBranchZ (G.Block id (G.ZLast (G.LastOther (LastBranch target []))))
isLoneBranchZ (G.Block id (G.ZLast (G.LastOther (LastBranch target))))
| id /= target = Left (id,target)
isLoneBranchZ other = Right other
-- ^ An infinite loop is not a link in a branch chain!
......@@ -94,7 +94,7 @@ replaceLabelsZ :: BlockEnv G.BlockId -> CmmGraph -> CmmGraph
replaceLabelsZ env = replace_eid . G.map_nodes id id last
where
replace_eid (G.LGraph eid blocks) = G.LGraph (lookup eid) blocks
last (LastBranch id args) = LastBranch (lookup id) args
last (LastBranch id) = LastBranch (lookup id)
last (LastCondBranch e ti fi) = LastCondBranch e (lookup ti) (lookup fi)
last (LastSwitch e tbl) = LastSwitch e (map (fmap lookup) tbl)
last (LastCall tgt (Just id)) = LastCall tgt (Just $ lookup id)
......
......@@ -95,8 +95,7 @@ ofZgraph g = ListGraph $ swallow blocks
last id prev' out l n =
let endblock stmt = block' id (stmt : prev') : swallow n in
case l of
LastBranch _ (_:_) -> panic "unrepresentable branch"
LastBranch tgt [] ->
LastBranch tgt ->
case n of
G.Block id' t : bs
| tgt == id', unique_pred id'
......@@ -116,8 +115,8 @@ ofZgraph g = ListGraph $ swallow blocks
tail id (CmmCondBranch e' fid : prev') Nothing t bs
_ -> let instrs' = CmmBranch fid : CmmCondBranch expr tid : prev'
in block' id instrs' : swallow n
LastJump expr params -> endblock $ CmmJump expr params
LastReturn params -> endblock $ CmmReturn params
LastJump expr -> endblock $ with_out out $ CmmJump expr
LastReturn -> endblock $ with_out out $ CmmReturn
LastSwitch arg ids -> endblock $ CmmSwitch arg $ ids
LastCall e cont
| Just (conv, args) <- out
......@@ -137,6 +136,8 @@ ofZgraph g = ListGraph $ swallow blocks
in tail id (delayed : call : prev') Nothing t bs
| otherwise -> panic "unrepairable call"
| otherwise -> panic "call with no CopyOut"
with_out (Just (_conv, actuals)) f = f actuals
with_out Nothing f = pprPanic "unrepairable data flow to" (ppr $ f [])
findCopyIn (G.ZTail (CopyIn _ ress srt) _) = (ress, srt)
findCopyIn (G.ZTail _ t) = findCopyIn t
findCopyIn (G.ZLast _) = panic "missing CopyIn after call"
......
......@@ -67,9 +67,9 @@ middleLiveness m = middle m
lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
lastLiveness l env = last l
where last (LastReturn ress) = gen ress emptyUniqSet
last (LastJump e args) = gen e $ gen args emptyUniqSet
last (LastBranch id args) = gen args $ env id
where last (LastReturn) = emptyUniqSet
last (LastJump e) = gen e $ emptyUniqSet
last (LastBranch id) = env id
last (LastCall tgt (Just k)) = gen tgt $ env k
last (LastCall tgt Nothing) = gen tgt $ emptyUniqSet
last (LastCondBranch e t f) = gen e $ unionUniqSets (env t) (env f)
......
......@@ -246,7 +246,7 @@ addProcPointProtocols procPoints formals g =
let (Block _ t) = lookupBlockEnv (lg_blocks g) id `orElse`
panic "jump out of graph"
in case t of
ZTail (CopyIn {}) (ZLast (LastOther (LastBranch pee [])))
ZTail (CopyIn {}) (ZLast (LastOther (LastBranch pee)))
| elemBlockSet pee procPoints -> Just pee
_ -> Nothing
init_protocols = fold_blocks maybe_add_proto emptyBlockEnv g
......
......@@ -113,9 +113,9 @@ middleDualLiveness live (NotSpillOrReload m) = changeRegs (middleLiveness m) liv
lastDualLiveness :: (BlockId -> DualLive) -> Last -> DualLive
lastDualLiveness env l = last l
where last (LastReturn ress) = changeRegs (gen ress) empty
last (LastJump e args) = changeRegs (gen e . gen args) empty
last (LastBranch id args) = changeRegs (gen args) $ env id
where last (LastReturn) = empty
last (LastJump e) = changeRegs (gen e) empty
last (LastBranch id) = env id
last (LastCall tgt Nothing) = changeRegs (gen tgt) empty
last (LastCall tgt (Just k)) =
-- nothing can be live in registers at this point
......
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module Dataflow (
fixedpoint
......
......@@ -69,13 +69,18 @@ mkComment fs = mkMiddle $ MidComment fs
mkAssign l r = mkMiddle $ MidAssign l r
mkStore l r = mkMiddle $ MidStore l r
mkJump e args = mkLast $ LastJump e args
mkCbranch pred ifso ifnot = mkLast $ LastCondBranch pred ifso ifnot
mkReturn actuals = mkLast $ LastReturn actuals
mkSwitch e tbl = mkLast $ LastSwitch e tbl
mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
cmmArgConv, cmmResConv :: Convention
cmmArgConv = ConventionStandard CmmCallConv Arguments
cmmResConv = ConventionStandard CmmCallConv Arguments
mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
mkFinalCall f conv actuals =
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkLast (LastCall f Nothing)
......
......@@ -47,13 +47,12 @@ pprCmmGraphLikeCmm g = vcat (swallow blocks)
last id prev' out l n =
let endblock stmt = block' id (stmt : prev') : swallow n in
case l of
G.LastBranch tgt [] ->
G.LastBranch tgt ->
case n of
Z.Block id' t : bs
| tgt == id', unique_pred id'
-> tail id prev' out t bs -- optimize out redundant labels
_ -> endblock (ppr $ CmmBranch tgt)
l@(G.LastBranch {}) -> endblock $ with_out out l
l@(G.LastCondBranch expr tid fid) ->
let ft id = text "// fall through to " <> ppr id in
case n of
......@@ -123,6 +122,8 @@ with_out (Just (conv, args)) l = last l
case k of Nothing -> ptext SLIT(" never returns")
Just _ -> empty,
semi ]
last (G.LastReturn) = ppr (CmmReturn args)
last (G.LastJump e) = ppr (CmmJump e args)
last l = ppr (G.CopyOut conv args) $$ ppr l
ppr_target (CmmLit lit) = pprLit lit
ppr_target fn' = parens (ppr fn')
......
......@@ -15,8 +15,8 @@ where
import CmmExpr
import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
, CmmCallTarget(..), CmmActuals, CmmFormalsWithoutKinds, CmmFormals
, CmmStmt(CmmJump, CmmSwitch) -- imported in order to call ppr
, CmmCallTarget(..), CmmActuals, CmmFormals
, CmmStmt(CmmSwitch) -- imported in order to call ppr
)
import PprCmm()
......@@ -33,6 +33,9 @@ import Maybes
import Outputable
import Prelude hiding (zip, unzip, last)
----------------------------------------------------------------------
----- Type synonyms and definitions
type CmmGraph = LGraph Middle Last
type CmmAGraph = AGraph Middle Last
type CmmBlock = Block Middle Last
......@@ -53,35 +56,38 @@ data Middle
CmmFormals -- zero or more results
CmmActuals -- zero or more arguments
| CopyIn -- Move parameters or results from conventional locations to registers
-- Note [CopyIn invariant]
| CopyIn -- Move incoming parameters or results from conventional
-- locations to registers. Note [CopyIn invariant]
Convention
CmmFormals -- eventually [CmmKind] will be used only for foreign
-- calls and will migrate into 'Convention' (helping to
-- drain "the swamp")
-- drain "the swamp"), leaving this as [LocalReg]
C_SRT -- Static things kept alive by this block
| CopyOut Convention CmmActuals
-- Move outgoing parameters or results from registers to
-- conventional locations. Every 'LastReturn',
-- 'LastJump', or 'LastCall' must be dominated by a
-- matching 'CopyOut' in the same basic block.
-- As above, '[CmmKind]' will migrate into the foreign calling
-- convention, leaving the actuals as '[CmmExpr]'.
data Last
= LastReturn CmmActuals -- Return from a function,
-- with these return values.
| LastJump CmmExpr CmmActuals
-- Tail call to another procedure
| LastBranch BlockId CmmFormalsWithoutKinds
-- To another block in the same procedure
-- The parameters are unused at present.
| LastCall { -- A call (native or safe foreign)
cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
cml_next :: Maybe BlockId } -- BlockId of continuation, if call returns
= LastBranch BlockId -- Goto another block in the same procedure
| LastCondBranch { -- conditional branch
cml_pred :: CmmExpr,
cml_true, cml_false :: BlockId
}
| LastReturn -- Return from a function; values in a previous CopyOut node
| LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node
| LastCall { -- A call (native or safe foreign)
cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns
| LastSwitch CmmExpr [Maybe BlockId] -- Table branch
-- The scrutinee is zero-based;
-- zero -> first block
......@@ -91,11 +97,12 @@ data Last
data Convention
= ConventionStandard CCallConv ValueDirection
| ConventionPrivate
-- Used for control transfers within a (pre-CPS) procedure
-- All jump sites known, never pushed on the stack (hence no SRT)
-- You can choose whatever calling convention
-- you please (provided you make sure
-- all the call sites agree)!
-- Used for control transfers within a (pre-CPS) procedure All
-- jump sites known, never pushed on the stack (hence no SRT)
-- You can choose whatever calling convention you please
-- (provided you make sure all the call sites agree)!
-- This data type eventually to be extended to record the convention.
deriving Eq
data ValueDirection = Arguments | Results
......@@ -106,29 +113,31 @@ data ValueDirection = Arguments | Results
{-
Note [CopyIn invariant]
~~~~~~~~~~~~~~~~~~~~~~~
In principle, CopyIn ought to be a First node, but in practice, the
One might wish for CopyIn to be a First node, but in practice, the
possibility raises all sorts of hairy issues with graph splicing,
rewriting, and so on. In the end, NR finds it better to make the
placement of CopyIn a dynamic invariant. This change will complicate
the dataflow fact for the proc-point calculation, but it should make
things easier in many other respects.
placement of CopyIn a dynamic invariant; it should normally be the first
Middle node in the basic block in which it occurs.
-}
----------------------------------------------------------------------
----- Instance declarations for control flow
instance HavingSuccessors Last where
succs = cmmSuccs
fold_succs = fold_cmm_succs
instance LastNode Last where
mkBranchNode id = LastBranch id []
isBranchNode (LastBranch _ []) = True
mkBranchNode id = LastBranch id
isBranchNode (LastBranch _) = True
isBranchNode _ = False
branchNodeTarget (LastBranch id []) = id
branchNodeTarget (LastBranch id) = id
branchNodeTarget _ = panic "asked for target of non-branch"
cmmSuccs :: Last -> [BlockId]
cmmSuccs (LastReturn {}) = []
cmmSuccs (LastJump {}) = []
cmmSuccs (LastBranch id _) = [id]
cmmSuccs (LastBranch id) = [id]
cmmSuccs (LastCall _ (Just id)) = [id]
cmmSuccs (LastCall _ Nothing) = []
cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
......@@ -137,15 +146,15 @@ cmmSuccs (LastSwitch _ edges) = catMaybes edges
fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
fold_cmm_succs _f (LastReturn {}) z = z
fold_cmm_succs _f (LastJump {}) z = z
fold_cmm_succs f (LastBranch id _) z = f id z
fold_cmm_succs f (LastBranch id) z = f id z
fold_cmm_succs f (LastCall _ (Just id)) z = f id z
fold_cmm_succs _f (LastCall _ Nothing) z = z
fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
----------------------------------------------------------------
-- prettyprinting (avoids recursive imports)
----------------------------------------------------------------------
----- Instance declarations for prettyprinting (avoids recursive imports)
instance Outputable Middle where
ppr s = pprMiddle s
......@@ -175,9 +184,8 @@ pprMiddle stmt = (case stmt of
ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
CopyOut conv args ->
if null args then empty
else ptext SLIT("CopyOut") <+> doubleQuotes(ppr conv) <+>
parens (commafy (map pprHinted args))
ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
parens (commafy (map pprHinted args))
-- // text
MidComment s -> text "//" <+> ftext s
......@@ -230,12 +238,12 @@ pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
pprLast :: Last -> SDoc
pprLast stmt = (case stmt of
LastBranch ident args -> genBranchWithArgs ident args
LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
LastCondBranch expr t f -> genFullCondBranch expr t f
LastJump expr params -> ppr $ CmmJump expr params
LastReturn results -> hcat [ ptext SLIT("return"), space
, parens ( commafy $ map pprHinted results )
, semi ]
LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
, ptext SLIT("(...)"), semi]
LastReturn -> hcat [ ptext SLIT("return"), space
, ptext SLIT("(...)"), semi]
LastSwitch arg ids -> ppr $ CmmSwitch arg ids
LastCall tgt k -> genBareCall tgt k
) <>
......@@ -251,20 +259,16 @@ pprLast stmt = (case stmt of
genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
genBareCall fn k =
hcat [ ptext SLIT("foreign"), space
, doubleQuotes(ptext SLIT("<convention from CopyOut>")), space
, target fn, parens ( ptext SLIT("<parameters from CopyOut>") ), space
hcat [ ptext SLIT("call"), space
, pprFun fn, ptext SLIT("(...)"), space
, case k of Nothing -> ptext SLIT("never returns")
Just k -> ptext SLIT("returns to") <+> ppr k
, semi ]
where
target t@(CmmLit _) = ppr t
target fn' = parens (ppr fn')
genBranchWithArgs :: (Outputable id, Outputable arg) => id -> [arg] -> SDoc
genBranchWithArgs ident [] = ptext SLIT("goto") <+> ppr ident <> semi
genBranchWithArgs ident args = ptext SLIT("goto") <+> ppr ident <+>
parens (commafy (map ppr args)) <> semi
pprFun :: CmmExpr -> SDoc
pprFun f@(CmmLit _) = ppr f
pprFun f = parens (ppr f)
genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
genFullCondBranch expr t f =
......
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