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
185 instance UserOfLocalRegs (ZLast Last) where
186 foldRegsUsed f z (LastOther l) = foldRegsUsed f z l
187 foldRegsUsed _f z LastExit = z
190 ----------------------------------------------------------------------
191 ----- Instance declarations for prettyprinting (avoids recursive imports)
193 instance Outputable Middle where
196 instance Outputable Last where
199 instance Outputable Convention where
202 instance DF.DebugNodes Middle Last
204 instance Outputable CmmGraph where
210 pprMiddle :: Middle -> SDoc
211 pprMiddle stmt = (case stmt of
213 CopyIn conv args _ ->
214 if null args then ptext SLIT("empty CopyIn")
215 else commafy (map pprHinted args) <+> equals <+>
216 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
219 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
220 parens (commafy (map pprHinted args))
223 MidComment s -> text "//" <+> ftext s
226 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
229 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
231 rep = ppr ( cmmExprRep expr )
233 -- call "ccall" foo(x, y)[r1, r2];
235 MidUnsafeCall (CmmCallee fn cconv) results args ->
236 hcat [ if null results
238 else parens (commafy $ map ppr results) <>
240 ptext SLIT("call"), space,
241 doubleQuotes(ppr cconv), space,
242 ppr_target fn, parens ( commafy $ map ppr args ),
245 MidUnsafeCall (CmmPrim op) results args ->
246 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
248 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
250 MidAddToContext ra args ->
251 hcat [ ptext SLIT("return via ")
252 , ppr_target ra, parens (commafy $ map ppr args), semi ]
255 if debugPpr then empty
258 CopyIn {} -> text "CopyIn"
259 CopyOut {} -> text "CopyOut"
260 MidComment {} -> text "MidComment"
261 MidAssign {} -> text "MidAssign"
262 MidStore {} -> text "MidStore"
263 MidUnsafeCall {} -> text "MidUnsafeCall"
264 MidAddToContext {} -> text "MidAddToContext"
267 ppr_target :: CmmExpr -> SDoc
268 ppr_target t@(CmmLit _) = ppr t
269 ppr_target fn' = parens (ppr fn')
272 pprHinted :: Outputable a => (a, MachHint) -> SDoc
273 pprHinted (a, NoHint) = ppr a
274 pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
275 pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
276 pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
278 pprLast :: Last -> SDoc
279 pprLast stmt = (case stmt of
280 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
281 LastCondBranch expr t f -> genFullCondBranch expr t f
282 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
283 , ptext SLIT("(...)"), semi]
284 LastReturn -> hcat [ ptext SLIT("return"), space
285 , ptext SLIT("(...)"), semi]
286 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
287 LastCall tgt k -> genBareCall tgt k
289 if debugPpr then empty
292 LastBranch {} -> text "LastBranch"
293 LastCondBranch {} -> text "LastCondBranch"
294 LastJump {} -> text "LastJump"
295 LastReturn {} -> text "LastReturn"
296 LastSwitch {} -> text "LastSwitch"
297 LastCall {} -> text "LastCall"
299 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
301 hcat [ ptext SLIT("call"), space
302 , pprFun fn, ptext SLIT("(...)"), space
303 , case k of Nothing -> ptext SLIT("never returns")
304 Just k -> ptext SLIT("returns to") <+> ppr k
308 pprFun :: CmmExpr -> SDoc
309 pprFun f@(CmmLit _) = ppr f
310 pprFun f = parens (ppr f)
312 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
313 genFullCondBranch expr t f =
314 hsep [ ptext SLIT("if")
318 , ptext SLIT("else goto")
322 pprConvention :: Convention -> SDoc
323 pprConvention (ConventionStandard c _) = ppr c
324 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
326 commafy :: [SDoc] -> SDoc
327 commafy xs = hsep $ punctuate comma xs