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
154 ----------------------------------------------------------------------
155 ----- Instance declarations for register use
157 instance UserOfLocalRegs Middle where
158 foldRegsUsed f z m = middle m
159 where middle (MidComment {}) = z
160 middle (MidAssign _lhs expr) = foldRegsUsed f z expr
161 middle (MidStore addr rval) = foldRegsUsed f (foldRegsUsed f z addr) rval
162 middle (MidUnsafeCall tgt _ress args) = foldRegsUsed f (foldRegsUsed f z tgt) args
163 middle (CopyIn _ _formals _) = z
164 middle (CopyOut _ actuals) = foldRegsUsed f z actuals
165 -- fold = foldRegsUsed
167 instance UserOfLocalRegs Last where
168 foldRegsUsed f z m = last m
169 where last (LastReturn) = z
170 last (LastJump e) = foldRegsUsed f z e
171 last (LastBranch _id) = z
172 last (LastCall tgt _) = foldRegsUsed f z tgt
173 last (LastCondBranch e _ _) = foldRegsUsed f z e
174 last (LastSwitch e _tbl) = foldRegsUsed f z e
176 instance UserOfLocalRegs (ZLast Last) where
177 foldRegsUsed f z (LastOther l) = foldRegsUsed f z l
178 foldRegsUsed _f z LastExit = z
181 ----------------------------------------------------------------------
182 ----- Instance declarations for prettyprinting (avoids recursive imports)
184 instance Outputable Middle where
187 instance Outputable Last where
190 instance Outputable Convention where
193 instance DF.DebugNodes Middle Last
195 instance Outputable CmmGraph where
201 pprMiddle :: Middle -> SDoc
202 pprMiddle stmt = (case stmt of
204 CopyIn conv args _ ->
205 if null args then ptext SLIT("empty CopyIn")
206 else commafy (map pprHinted args) <+> equals <+>
207 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
210 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
211 parens (commafy (map pprHinted args))
214 MidComment s -> text "//" <+> ftext s
217 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
220 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
222 rep = ppr ( cmmExprRep expr )
224 -- call "ccall" foo(x, y)[r1, r2];
226 MidUnsafeCall (CmmCallee fn cconv) results args ->
227 hcat [ if null results
229 else parens (commafy $ map ppr results) <>
231 ptext SLIT("call"), space,
232 doubleQuotes(ppr cconv), space,
233 target fn, parens ( commafy $ map ppr args ),
236 target t@(CmmLit _) = ppr t
237 target fn' = parens (ppr fn')
239 MidUnsafeCall (CmmPrim op) results args ->
240 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
242 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
244 if debugPpr then empty
247 CopyIn {} -> text "CopyIn"
248 CopyOut {} -> text "CopyOut"
249 MidComment {} -> text "MidComment"
250 MidAssign {} -> text "MidAssign"
251 MidStore {} -> text "MidStore"
252 MidUnsafeCall {} -> text "MidUnsafeCall"
255 pprHinted :: Outputable a => (a, MachHint) -> SDoc
256 pprHinted (a, NoHint) = ppr a
257 pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
258 pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
259 pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
261 pprLast :: Last -> SDoc
262 pprLast stmt = (case stmt of
263 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
264 LastCondBranch expr t f -> genFullCondBranch expr t f
265 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
266 , ptext SLIT("(...)"), semi]
267 LastReturn -> hcat [ ptext SLIT("return"), space
268 , ptext SLIT("(...)"), semi]
269 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
270 LastCall tgt k -> genBareCall tgt k
272 if debugPpr then empty
275 LastBranch {} -> text "LastBranch"
276 LastCondBranch {} -> text "LastCondBranch"
277 LastJump {} -> text "LastJump"
278 LastReturn {} -> text "LastReturn"
279 LastSwitch {} -> text "LastSwitch"
280 LastCall {} -> text "LastCall"
282 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
284 hcat [ ptext SLIT("call"), space
285 , pprFun fn, ptext SLIT("(...)"), space
286 , case k of Nothing -> ptext SLIT("never returns")
287 Just k -> ptext SLIT("returns to") <+> ppr k
291 pprFun :: CmmExpr -> SDoc
292 pprFun f@(CmmLit _) = ppr f
293 pprFun f = parens (ppr f)
295 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
296 genFullCondBranch expr t f =
297 hsep [ ptext SLIT("if")
301 , ptext SLIT("else goto")
305 pprConvention :: Convention -> SDoc
306 pprConvention (ConventionStandard c _) = ppr c
307 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
309 commafy :: [SDoc] -> SDoc
310 commafy xs = hsep $ punctuate comma xs