3 -- This module is pure representation and should be imported only by
4 -- clients that need to manipulate representation and know what
5 -- they're doing. Clients that need to create flow graphs should
6 -- instead import MkZipCfgCmm.
9 ( CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle(..), Last(..), Convention(..)
14 #include "HsVersions.h"
17 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
18 , CmmCallTarget(..), CmmActuals, CmmFormals
19 , CmmStmt(CmmSwitch) -- imported in order to call ppr
28 import qualified ZipDataflow as DF
34 import Prelude hiding (zip, unzip, last)
36 ----------------------------------------------------------------------
37 ----- Type synonyms and definitions
39 type CmmGraph = LGraph Middle Last
40 type CmmAGraph = AGraph Middle Last
41 type CmmBlock = Block Middle Last
42 type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
43 type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
46 = MidComment FastString
48 | MidAssign CmmReg CmmExpr -- Assign to register
50 | MidStore CmmExpr CmmExpr -- Assign to memory location. Size is
51 -- given by cmmExprRep of the rhs.
53 | MidUnsafeCall -- An "unsafe" foreign call;
54 CmmCallTarget -- just a fat machine instructoin
55 CmmFormals -- zero or more results
56 CmmActuals -- zero or more arguments
58 | CopyIn -- Move incoming parameters or results from conventional
59 -- locations to registers. Note [CopyIn invariant]
61 CmmFormals -- eventually [CmmKind] will be used only for foreign
62 -- calls and will migrate into 'Convention' (helping to
63 -- drain "the swamp"), leaving this as [LocalReg]
64 C_SRT -- Static things kept alive by this block
66 | CopyOut Convention CmmActuals
67 -- Move outgoing parameters or results from registers to
68 -- conventional locations. Every 'LastReturn',
69 -- 'LastJump', or 'LastCall' must be dominated by a
70 -- matching 'CopyOut' in the same basic block.
71 -- As above, '[CmmKind]' will migrate into the foreign calling
72 -- convention, leaving the actuals as '[CmmExpr]'.
75 = LastBranch BlockId -- Goto another block in the same procedure
77 | LastCondBranch { -- conditional branch
79 cml_true, cml_false :: BlockId
82 | LastReturn -- Return from a function; values in a previous CopyOut node
84 | LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node
86 | LastCall { -- A call (native or safe foreign); args in CopyOut node
87 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
88 cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns
90 | LastSwitch CmmExpr [Maybe BlockId] -- Table branch
91 -- The scrutinee is zero-based;
92 -- zero -> first block
93 -- one -> second block etc
94 -- Undefined outside range, and when there's a Nothing
97 = ConventionStandard CCallConv ValueDirection
99 -- Used for control transfers within a (pre-CPS) procedure All
100 -- jump sites known, never pushed on the stack (hence no SRT)
101 -- You can choose whatever calling convention you please
102 -- (provided you make sure all the call sites agree)!
103 -- This data type eventually to be extended to record the convention.
107 data ValueDirection = Arguments | Results
108 -- Arguments go with procedure definitions, jumps, and arguments to calls
109 -- Results go with returns and with results of calls.
113 Note [CopyIn invariant]
114 ~~~~~~~~~~~~~~~~~~~~~~~
115 One might wish for CopyIn to be a First node, but in practice, the
116 possibility raises all sorts of hairy issues with graph splicing,
117 rewriting, and so on. In the end, NR finds it better to make the
118 placement of CopyIn a dynamic invariant; it should normally be the first
119 Middle node in the basic block in which it occurs.
122 ----------------------------------------------------------------------
123 ----- Instance declarations for control flow
125 instance HavingSuccessors Last where
127 fold_succs = fold_cmm_succs
129 instance LastNode Last where
130 mkBranchNode id = LastBranch id
131 isBranchNode (LastBranch _) = True
132 isBranchNode _ = False
133 branchNodeTarget (LastBranch id) = id
134 branchNodeTarget _ = panic "asked for target of non-branch"
136 cmmSuccs :: Last -> [BlockId]
137 cmmSuccs (LastReturn {}) = []
138 cmmSuccs (LastJump {}) = []
139 cmmSuccs (LastBranch id) = [id]
140 cmmSuccs (LastCall _ (Just id)) = [id]
141 cmmSuccs (LastCall _ Nothing) = []
142 cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
143 cmmSuccs (LastSwitch _ edges) = catMaybes edges
145 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
146 fold_cmm_succs _f (LastReturn {}) z = z
147 fold_cmm_succs _f (LastJump {}) z = z
148 fold_cmm_succs f (LastBranch id) z = f id z
149 fold_cmm_succs f (LastCall _ (Just id)) z = f id z
150 fold_cmm_succs _f (LastCall _ Nothing) z = z
151 fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
152 fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
155 ----------------------------------------------------------------------
156 ----- Instance declarations for prettyprinting (avoids recursive imports)
158 instance Outputable Middle where
161 instance Outputable Last where
164 instance Outputable Convention where
167 instance DF.DebugNodes Middle Last
169 instance Outputable CmmGraph where
175 pprMiddle :: Middle -> SDoc
176 pprMiddle stmt = (case stmt of
178 CopyIn conv args _ ->
179 if null args then ptext SLIT("empty CopyIn")
180 else commafy (map pprHinted args) <+> equals <+>
181 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
184 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
185 parens (commafy (map pprHinted args))
188 MidComment s -> text "//" <+> ftext s
191 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
194 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
196 rep = ppr ( cmmExprRep expr )
198 -- call "ccall" foo(x, y)[r1, r2];
200 MidUnsafeCall (CmmCallee fn cconv) results args ->
201 hcat [ if null results
203 else parens (commafy $ map ppr results) <>
205 ptext SLIT("call"), space,
206 doubleQuotes(ppr cconv), space,
207 target fn, parens ( commafy $ map ppr args ),
210 target t@(CmmLit _) = ppr t
211 target fn' = parens (ppr fn')
213 MidUnsafeCall (CmmPrim op) results args ->
214 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
216 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
218 if debugPpr then empty
221 CopyIn {} -> text "CopyIn"
222 CopyOut {} -> text "CopyOut"
223 MidComment {} -> text "MidComment"
224 MidAssign {} -> text "MidAssign"
225 MidStore {} -> text "MidStore"
226 MidUnsafeCall {} -> text "MidUnsafeCall"
229 pprHinted :: Outputable a => (a, MachHint) -> SDoc
230 pprHinted (a, NoHint) = ppr a
231 pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
232 pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
233 pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
235 pprLast :: Last -> SDoc
236 pprLast stmt = (case stmt of
237 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
238 LastCondBranch expr t f -> genFullCondBranch expr t f
239 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
240 , ptext SLIT("(...)"), semi]
241 LastReturn -> hcat [ ptext SLIT("return"), space
242 , ptext SLIT("(...)"), semi]
243 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
244 LastCall tgt k -> genBareCall tgt k
246 if debugPpr then empty
249 LastBranch {} -> text "LastBranch"
250 LastCondBranch {} -> text "LastCondBranch"
251 LastJump {} -> text "LastJump"
252 LastReturn {} -> text "LastReturn"
253 LastSwitch {} -> text "LastSwitch"
254 LastCall {} -> text "LastCall"
256 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
258 hcat [ ptext SLIT("call"), space
259 , pprFun fn, ptext SLIT("(...)"), space
260 , case k of Nothing -> ptext SLIT("never returns")
261 Just k -> ptext SLIT("returns to") <+> ppr k
265 pprFun :: CmmExpr -> SDoc
266 pprFun f@(CmmLit _) = ppr f
267 pprFun f = parens (ppr f)
269 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
270 genFullCondBranch expr t f =
271 hsep [ ptext SLIT("if")
275 , ptext SLIT("else goto")
279 pprConvention :: Convention -> SDoc
280 pprConvention (ConventionStandard c _) = ppr c
281 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
283 commafy :: [SDoc] -> SDoc
284 commafy xs = hsep $ punctuate comma xs