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
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
203 pprMiddle :: Middle -> SDoc
204 pprMiddle stmt = (case stmt of
206 CopyIn conv args _ ->
207 if null args then ptext SLIT("empty CopyIn")
208 else commafy (map pprHinted args) <+> equals <+>
209 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
212 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
213 parens (commafy (map pprHinted args))
216 MidComment s -> text "//" <+> ftext s
219 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
222 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
224 rep = ppr ( cmmExprRep expr )
226 -- call "ccall" foo(x, y)[r1, r2];
228 MidUnsafeCall (CmmCallee fn cconv) results args ->
229 hcat [ if null results
231 else parens (commafy $ map ppr results) <>
233 ptext SLIT("call"), space,
234 doubleQuotes(ppr cconv), space,
235 ppr_target fn, parens ( commafy $ map ppr args ),
238 MidUnsafeCall (CmmPrim op) results args ->
239 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
241 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
243 MidAddToContext ra args ->
244 hcat [ ptext SLIT("return via ")
245 , ppr_target ra, parens (commafy $ map ppr args), semi ]
248 if debugPpr then empty
251 CopyIn {} -> text "CopyIn"
252 CopyOut {} -> text "CopyOut"
253 MidComment {} -> text "MidComment"
254 MidAssign {} -> text "MidAssign"
255 MidStore {} -> text "MidStore"
256 MidUnsafeCall {} -> text "MidUnsafeCall"
257 MidAddToContext {} -> text "MidAddToContext"
260 ppr_target :: CmmExpr -> SDoc
261 ppr_target t@(CmmLit _) = ppr t
262 ppr_target fn' = parens (ppr fn')
265 pprHinted :: Outputable a => CmmHinted a -> SDoc
266 pprHinted (CmmHinted a NoHint) = ppr a
267 pprHinted (CmmHinted a PtrHint) = doubleQuotes (text "address") <+> ppr a
268 pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed") <+> ppr a
269 pprHinted (CmmHinted a FloatHint) = doubleQuotes (text "float") <+> ppr a
271 pprLast :: Last -> SDoc
272 pprLast stmt = (case stmt of
273 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
274 LastCondBranch expr t f -> genFullCondBranch expr t f
275 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
276 , ptext SLIT("(...)"), semi]
277 LastReturn -> hcat [ ptext SLIT("return"), space
278 , ptext SLIT("(...)"), semi]
279 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
280 LastCall tgt k -> genBareCall tgt k
282 if debugPpr then empty
285 LastBranch {} -> text "LastBranch"
286 LastCondBranch {} -> text "LastCondBranch"
287 LastJump {} -> text "LastJump"
288 LastReturn {} -> text "LastReturn"
289 LastSwitch {} -> text "LastSwitch"
290 LastCall {} -> text "LastCall"
292 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
294 hcat [ ptext SLIT("call"), space
295 , pprFun fn, ptext SLIT("(...)"), space
296 , case k of Nothing -> ptext SLIT("never returns")
297 Just k -> ptext SLIT("returns to") <+> ppr k
301 pprFun :: CmmExpr -> SDoc
302 pprFun f@(CmmLit _) = ppr f
303 pprFun f = parens (ppr f)
305 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
306 genFullCondBranch expr t f =
307 hsep [ ptext SLIT("if")
311 , ptext SLIT("else goto")
315 pprConvention :: Convention -> SDoc
316 pprConvention (ConventionStandard c _) = ppr c
317 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
319 commafy :: [SDoc] -> SDoc
320 commafy xs = hsep $ punctuate comma xs