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, CmmHinted(..)
19 , CmmStmt(CmmSwitch) -- imported in order to call ppr
28 import qualified ZipDataflow0 as DF
35 import Prelude hiding (zip, unzip, last)
37 ----------------------------------------------------------------------
38 ----- Type synonyms and definitions
40 type CmmGraph = LGraph Middle Last
41 type CmmAGraph = AGraph Middle Last
42 type CmmBlock = Block Middle Last
43 type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
44 type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
47 = MidComment FastString
49 | MidAssign CmmReg CmmExpr -- Assign to register
51 | MidStore CmmExpr CmmExpr -- Assign to memory location. Size is
52 -- given by cmmExprRep of the rhs.
54 | MidUnsafeCall -- An "unsafe" foreign call;
55 CmmCallTarget -- just a fat machine instructoin
56 CmmFormals -- zero or more results
57 CmmActuals -- zero or more arguments
59 | MidAddToContext -- push a frame on the stack;
60 -- I will return to this frame
61 CmmExpr -- The frame's return address; it must be
62 -- preceded by an info table that describes the
64 [CmmExpr] -- The frame's live variables, to go on the
65 -- stack with the first one at the young end
67 | CopyIn -- Move incoming parameters or results from conventional
68 -- locations to registers. Note [CopyIn invariant]
70 CmmFormals -- eventually [CmmKind] will be used only for foreign
71 -- calls and will migrate into 'Convention' (helping to
72 -- drain "the swamp"), leaving this as [LocalReg]
73 C_SRT -- Static things kept alive by this block
75 | CopyOut Convention CmmActuals
76 -- Move outgoing parameters or results from registers to
77 -- conventional locations. Every 'LastReturn',
78 -- 'LastJump', or 'LastCall' must be dominated by a
79 -- matching 'CopyOut' in the same basic block.
80 -- As above, '[CmmKind]' will migrate into the foreign calling
81 -- convention, leaving the actuals as '[CmmExpr]'.
84 = LastBranch BlockId -- Goto another block in the same procedure
86 | LastCondBranch { -- conditional branch
88 cml_true, cml_false :: BlockId
91 | LastReturn -- Return from a function; values in a previous CopyOut node
93 | LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node
95 | LastCall { -- A call (native or safe foreign); args in CopyOut node
96 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
97 cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns
99 | LastSwitch CmmExpr [Maybe BlockId] -- Table branch
100 -- The scrutinee is zero-based;
101 -- zero -> first block
102 -- one -> second block etc
103 -- Undefined outside range, and when there's a Nothing
106 = ConventionStandard CCallConv ValueDirection
108 -- Used for control transfers within a (pre-CPS) procedure All
109 -- jump sites known, never pushed on the stack (hence no SRT)
110 -- You can choose whatever calling convention you please
111 -- (provided you make sure all the call sites agree)!
112 -- This data type eventually to be extended to record the convention.
116 data ValueDirection = Arguments | Results
117 -- Arguments go with procedure definitions, jumps, and arguments to calls
118 -- Results go with returns and with results of calls.
122 Note [CopyIn invariant]
123 ~~~~~~~~~~~~~~~~~~~~~~~
124 One might wish for CopyIn to be a First node, but in practice, the
125 possibility raises all sorts of hairy issues with graph splicing,
126 rewriting, and so on. In the end, NR finds it better to make the
127 placement of CopyIn a dynamic invariant; it should normally be the first
128 Middle node in the basic block in which it occurs.
131 ----------------------------------------------------------------------
132 ----- Instance declarations for control flow
134 instance HavingSuccessors Last where
136 fold_succs = fold_cmm_succs
138 instance LastNode Last where
139 mkBranchNode id = LastBranch id
140 isBranchNode (LastBranch _) = True
141 isBranchNode _ = False
142 branchNodeTarget (LastBranch id) = id
143 branchNodeTarget _ = panic "asked for target of non-branch"
145 cmmSuccs :: Last -> [BlockId]
146 cmmSuccs (LastReturn {}) = []
147 cmmSuccs (LastJump {}) = []
148 cmmSuccs (LastBranch id) = [id]
149 cmmSuccs (LastCall _ (Just id)) = [id]
150 cmmSuccs (LastCall _ Nothing) = []
151 cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
152 cmmSuccs (LastSwitch _ edges) = catMaybes edges
154 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
155 fold_cmm_succs _f (LastReturn {}) z = z
156 fold_cmm_succs _f (LastJump {}) z = z
157 fold_cmm_succs f (LastBranch id) z = f id z
158 fold_cmm_succs f (LastCall _ (Just id)) z = f id z
159 fold_cmm_succs _f (LastCall _ Nothing) z = z
160 fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
161 fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
163 ----------------------------------------------------------------------
164 ----- Instance declarations for register use
166 instance UserOfLocalRegs Middle where
167 foldRegsUsed f z m = middle m
168 where middle (MidComment {}) = z
169 middle (MidAssign _lhs expr) = fold f z expr
170 middle (MidStore addr rval) = fold f (fold f z addr) rval
171 middle (MidUnsafeCall tgt _ress args) = fold f (fold f z tgt) args
172 middle (MidAddToContext ra args) = fold f (fold f z ra) args
173 middle (CopyIn _ _formals _) = z
174 middle (CopyOut _ actuals) = fold f z actuals
175 fold f z m = foldRegsUsed f z m -- avoid monomorphism restriction
177 instance UserOfLocalRegs Last where
178 foldRegsUsed f z m = last m
179 where last (LastReturn) = z
180 last (LastJump e) = foldRegsUsed f z e
181 last (LastBranch _id) = z
182 last (LastCall tgt _) = foldRegsUsed f z tgt
183 last (LastCondBranch e _ _) = foldRegsUsed f z e
184 last (LastSwitch e _tbl) = foldRegsUsed f z e
187 ----------------------------------------------------------------------
188 ----- Instance declarations for prettyprinting (avoids recursive imports)
190 instance Outputable Middle where
193 instance Outputable Last where
196 instance Outputable Convention where
199 instance DF.DebugNodes Middle Last
204 pprMiddle :: Middle -> SDoc
205 pprMiddle stmt = (case stmt of
207 CopyIn conv args _ ->
208 if null args then ptext SLIT("empty CopyIn")
209 else commafy (map pprHinted args) <+> equals <+>
210 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
213 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
214 parens (commafy (map pprHinted args))
217 MidComment s -> text "//" <+> ftext s
220 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
223 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
225 rep = ppr ( cmmExprRep expr )
227 -- call "ccall" foo(x, y)[r1, r2];
229 MidUnsafeCall (CmmCallee fn cconv) results args ->
230 hcat [ if null results
232 else parens (commafy $ map ppr results) <>
234 ptext SLIT("call"), space,
235 doubleQuotes(ppr cconv), space,
236 ppr_target fn, parens ( commafy $ map ppr args ),
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 MidAddToContext ra args ->
245 hcat [ ptext SLIT("return via ")
246 , ppr_target ra, parens (commafy $ map ppr args), semi ]
249 if debugPpr then empty
252 CopyIn {} -> text "CopyIn"
253 CopyOut {} -> text "CopyOut"
254 MidComment {} -> text "MidComment"
255 MidAssign {} -> text "MidAssign"
256 MidStore {} -> text "MidStore"
257 MidUnsafeCall {} -> text "MidUnsafeCall"
258 MidAddToContext {} -> text "MidAddToContext"
261 ppr_target :: CmmExpr -> SDoc
262 ppr_target t@(CmmLit _) = ppr t
263 ppr_target fn' = parens (ppr fn')
266 pprHinted :: Outputable a => CmmHinted a -> SDoc
267 pprHinted (CmmHinted a NoHint) = ppr a
268 pprHinted (CmmHinted a PtrHint) = doubleQuotes (text "address") <+> ppr a
269 pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed") <+> ppr a
270 pprHinted (CmmHinted a FloatHint) = doubleQuotes (text "float") <+> ppr a
272 pprLast :: Last -> SDoc
273 pprLast stmt = (case stmt of
274 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
275 LastCondBranch expr t f -> genFullCondBranch expr t f
276 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
277 , ptext SLIT("(...)"), semi]
278 LastReturn -> hcat [ ptext SLIT("return"), space
279 , ptext SLIT("(...)"), semi]
280 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
281 LastCall tgt k -> genBareCall tgt k
283 if debugPpr then empty
286 LastBranch {} -> text "LastBranch"
287 LastCondBranch {} -> text "LastCondBranch"
288 LastJump {} -> text "LastJump"
289 LastReturn {} -> text "LastReturn"
290 LastSwitch {} -> text "LastSwitch"
291 LastCall {} -> text "LastCall"
293 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
295 hcat [ ptext SLIT("call"), space
296 , pprFun fn, ptext SLIT("(...)"), space
297 , case k of Nothing -> ptext SLIT("never returns")
298 Just k -> ptext SLIT("returns to") <+> ppr k
302 pprFun :: CmmExpr -> SDoc
303 pprFun f@(CmmLit _) = ppr f
304 pprFun f = parens (ppr f)
306 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
307 genFullCondBranch expr t f =
308 hsep [ ptext SLIT("if")
312 , ptext SLIT("else goto")
316 pprConvention :: Convention -> SDoc
317 pprConvention (ConventionStandard c _) = ppr c
318 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
320 commafy :: [SDoc] -> SDoc
321 commafy xs = hsep $ punctuate comma xs