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 ZipDataflow0 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 | MidAddToContext -- push a frame on the stack;
59 -- I will return to this frame
60 CmmExpr -- The frame's return address; it must be
61 -- preceded by an info table that describes the
63 [CmmExpr] -- The frame's live variables, to go on the
64 -- stack with the first one at the young end
66 | CopyIn -- Move incoming parameters or results from conventional
67 -- locations to registers. Note [CopyIn invariant]
69 CmmFormals -- eventually [CmmKind] will be used only for foreign
70 -- calls and will migrate into 'Convention' (helping to
71 -- drain "the swamp"), leaving this as [LocalReg]
72 C_SRT -- Static things kept alive by this block
74 | CopyOut Convention CmmActuals
75 -- Move outgoing parameters or results from registers to
76 -- conventional locations. Every 'LastReturn',
77 -- 'LastJump', or 'LastCall' must be dominated by a
78 -- matching 'CopyOut' in the same basic block.
79 -- As above, '[CmmKind]' will migrate into the foreign calling
80 -- convention, leaving the actuals as '[CmmExpr]'.
83 = LastBranch BlockId -- Goto another block in the same procedure
85 | LastCondBranch { -- conditional branch
87 cml_true, cml_false :: BlockId
90 | LastReturn -- Return from a function; values in a previous CopyOut node
92 | LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node
94 | LastCall { -- A call (native or safe foreign); args in CopyOut node
95 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
96 cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns
98 | LastSwitch CmmExpr [Maybe BlockId] -- Table branch
99 -- The scrutinee is zero-based;
100 -- zero -> first block
101 -- one -> second block etc
102 -- Undefined outside range, and when there's a Nothing
105 = ConventionStandard CCallConv ValueDirection
107 -- Used for control transfers within a (pre-CPS) procedure All
108 -- jump sites known, never pushed on the stack (hence no SRT)
109 -- You can choose whatever calling convention you please
110 -- (provided you make sure all the call sites agree)!
111 -- This data type eventually to be extended to record the convention.
115 data ValueDirection = Arguments | Results
116 -- Arguments go with procedure definitions, jumps, and arguments to calls
117 -- Results go with returns and with results of calls.
121 Note [CopyIn invariant]
122 ~~~~~~~~~~~~~~~~~~~~~~~
123 One might wish for CopyIn to be a First node, but in practice, the
124 possibility raises all sorts of hairy issues with graph splicing,
125 rewriting, and so on. In the end, NR finds it better to make the
126 placement of CopyIn a dynamic invariant; it should normally be the first
127 Middle node in the basic block in which it occurs.
130 ----------------------------------------------------------------------
131 ----- Instance declarations for control flow
133 instance HavingSuccessors Last where
135 fold_succs = fold_cmm_succs
137 instance LastNode Last where
138 mkBranchNode id = LastBranch id
139 isBranchNode (LastBranch _) = True
140 isBranchNode _ = False
141 branchNodeTarget (LastBranch id) = id
142 branchNodeTarget _ = panic "asked for target of non-branch"
144 cmmSuccs :: Last -> [BlockId]
145 cmmSuccs (LastReturn {}) = []
146 cmmSuccs (LastJump {}) = []
147 cmmSuccs (LastBranch id) = [id]
148 cmmSuccs (LastCall _ (Just id)) = [id]
149 cmmSuccs (LastCall _ Nothing) = []
150 cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
151 cmmSuccs (LastSwitch _ edges) = catMaybes edges
153 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
154 fold_cmm_succs _f (LastReturn {}) z = z
155 fold_cmm_succs _f (LastJump {}) z = z
156 fold_cmm_succs f (LastBranch id) z = f id z
157 fold_cmm_succs f (LastCall _ (Just id)) z = f id z
158 fold_cmm_succs _f (LastCall _ Nothing) z = z
159 fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
160 fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
162 ----------------------------------------------------------------------
163 ----- Instance declarations for register use
165 instance UserOfLocalRegs Middle where
166 foldRegsUsed f z m = middle m
167 where middle (MidComment {}) = z
168 middle (MidAssign _lhs expr) = fold f z expr
169 middle (MidStore addr rval) = fold f (fold f z addr) rval
170 middle (MidUnsafeCall tgt _ress args) = fold f (fold f z tgt) args
171 middle (MidAddToContext ra args) = fold f (fold f z ra) args
172 middle (CopyIn _ _formals _) = z
173 middle (CopyOut _ actuals) = fold f z actuals
174 fold f z m = foldRegsUsed f z m -- avoid monomorphism restriction
176 instance UserOfLocalRegs Last where
177 foldRegsUsed f z m = last m
178 where last (LastReturn) = z
179 last (LastJump e) = foldRegsUsed f z e
180 last (LastBranch _id) = z
181 last (LastCall tgt _) = foldRegsUsed f z tgt
182 last (LastCondBranch e _ _) = foldRegsUsed f z e
183 last (LastSwitch e _tbl) = foldRegsUsed f z e
186 ----------------------------------------------------------------------
187 ----- Instance declarations for prettyprinting (avoids recursive imports)
189 instance Outputable Middle where
192 instance Outputable Last where
195 instance Outputable Convention where
198 instance DF.DebugNodes Middle Last
200 instance Outputable CmmGraph where
206 pprMiddle :: Middle -> SDoc
207 pprMiddle stmt = (case stmt of
209 CopyIn conv args _ ->
210 if null args then ptext SLIT("empty CopyIn")
211 else commafy (map pprHinted args) <+> equals <+>
212 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
215 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
216 parens (commafy (map pprHinted args))
219 MidComment s -> text "//" <+> ftext s
222 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
225 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
227 rep = ppr ( cmmExprRep expr )
229 -- call "ccall" foo(x, y)[r1, r2];
231 MidUnsafeCall (CmmCallee fn cconv) results args ->
232 hcat [ if null results
234 else parens (commafy $ map ppr results) <>
236 ptext SLIT("call"), space,
237 doubleQuotes(ppr cconv), space,
238 ppr_target fn, parens ( commafy $ map ppr args ),
241 MidUnsafeCall (CmmPrim op) results args ->
242 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
244 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
246 MidAddToContext ra args ->
247 hcat [ ptext SLIT("return via ")
248 , ppr_target ra, parens (commafy $ map ppr args), semi ]
251 if debugPpr then empty
254 CopyIn {} -> text "CopyIn"
255 CopyOut {} -> text "CopyOut"
256 MidComment {} -> text "MidComment"
257 MidAssign {} -> text "MidAssign"
258 MidStore {} -> text "MidStore"
259 MidUnsafeCall {} -> text "MidUnsafeCall"
260 MidAddToContext {} -> text "MidAddToContext"
263 ppr_target :: CmmExpr -> SDoc
264 ppr_target t@(CmmLit _) = ppr t
265 ppr_target fn' = parens (ppr fn')
268 pprHinted :: Outputable a => (a, MachHint) -> SDoc
269 pprHinted (a, NoHint) = ppr a
270 pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
271 pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
272 pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
274 pprLast :: Last -> SDoc
275 pprLast stmt = (case stmt of
276 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
277 LastCondBranch expr t f -> genFullCondBranch expr t f
278 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
279 , ptext SLIT("(...)"), semi]
280 LastReturn -> hcat [ ptext SLIT("return"), space
281 , ptext SLIT("(...)"), semi]
282 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
283 LastCall tgt k -> genBareCall tgt k
285 if debugPpr then empty
288 LastBranch {} -> text "LastBranch"
289 LastCondBranch {} -> text "LastCondBranch"
290 LastJump {} -> text "LastJump"
291 LastReturn {} -> text "LastReturn"
292 LastSwitch {} -> text "LastSwitch"
293 LastCall {} -> text "LastCall"
295 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
297 hcat [ ptext SLIT("call"), space
298 , pprFun fn, ptext SLIT("(...)"), space
299 , case k of Nothing -> ptext SLIT("never returns")
300 Just k -> ptext SLIT("returns to") <+> ppr k
304 pprFun :: CmmExpr -> SDoc
305 pprFun f@(CmmLit _) = ppr f
306 pprFun f = parens (ppr f)
308 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
309 genFullCondBranch expr t f =
310 hsep [ ptext SLIT("if")
314 , ptext SLIT("else goto")
318 pprConvention :: Convention -> SDoc
319 pprConvention (ConventionStandard c _) = ppr c
320 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
322 commafy :: [SDoc] -> SDoc
323 commafy xs = hsep $ punctuate comma xs