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(..)
15 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
16 , CmmCallTarget(..), CmmActuals, CmmFormals, CmmHinted(..)
17 , CmmStmt(CmmSwitch) -- imported in order to call ppr
26 import qualified ZipDataflow0 as DF
33 import Prelude hiding (zip, unzip, last)
35 ----------------------------------------------------------------------
36 ----- Type synonyms and definitions
38 type CmmGraph = LGraph Middle Last
39 type CmmAGraph = AGraph Middle Last
40 type CmmBlock = Block Middle Last
41 type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
42 type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
45 = MidComment FastString
47 | MidAssign CmmReg CmmExpr -- Assign to register
49 | MidStore CmmExpr CmmExpr -- Assign to memory location. Size is
50 -- given by cmmExprRep of the rhs.
52 | MidUnsafeCall -- An "unsafe" foreign call;
53 CmmCallTarget -- just a fat machine instructoin
54 CmmFormals -- zero or more results
55 CmmActuals -- zero or more arguments
57 | MidAddToContext -- push a frame on the stack;
58 -- I will return to this frame
59 CmmExpr -- The frame's return address; it must be
60 -- preceded by an info table that describes the
62 [CmmExpr] -- The frame's live variables, to go on the
63 -- stack with the first one at the young end
65 | CopyIn -- Move incoming parameters or results from conventional
66 -- locations to registers. Note [CopyIn invariant]
68 CmmFormals -- eventually [CmmKind] will be used only for foreign
69 -- calls and will migrate into 'Convention' (helping to
70 -- drain "the swamp"), leaving this as [LocalReg]
71 C_SRT -- Static things kept alive by this block
73 | CopyOut Convention CmmActuals
74 -- Move outgoing parameters or results from registers to
75 -- conventional locations. Every 'LastReturn',
76 -- 'LastJump', or 'LastCall' must be dominated by a
77 -- matching 'CopyOut' in the same basic block.
78 -- As above, '[CmmKind]' will migrate into the foreign calling
79 -- convention, leaving the actuals as '[CmmExpr]'.
82 = LastBranch BlockId -- Goto another block in the same procedure
84 | LastCondBranch { -- conditional branch
86 cml_true, cml_false :: BlockId
89 | LastReturn -- Return from a function; values in a previous CopyOut node
91 | LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node
93 | LastCall { -- A call (native or safe foreign); args in CopyOut node
94 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
95 cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns
97 | LastSwitch CmmExpr [Maybe BlockId] -- Table branch
98 -- The scrutinee is zero-based;
99 -- zero -> first block
100 -- one -> second block etc
101 -- Undefined outside range, and when there's a Nothing
104 = ConventionStandard CCallConv ValueDirection
106 -- Used for control transfers within a (pre-CPS) procedure All
107 -- jump sites known, never pushed on the stack (hence no SRT)
108 -- You can choose whatever calling convention you please
109 -- (provided you make sure all the call sites agree)!
110 -- This data type eventually to be extended to record the convention.
114 data ValueDirection = Arguments | Results
115 -- Arguments go with procedure definitions, jumps, and arguments to calls
116 -- Results go with returns and with results of calls.
120 Note [CopyIn invariant]
121 ~~~~~~~~~~~~~~~~~~~~~~~
122 One might wish for CopyIn to be a First node, but in practice, the
123 possibility raises all sorts of hairy issues with graph splicing,
124 rewriting, and so on. In the end, NR finds it better to make the
125 placement of CopyIn a dynamic invariant; it should normally be the first
126 Middle node in the basic block in which it occurs.
129 ----------------------------------------------------------------------
130 ----- Instance declarations for control flow
132 instance HavingSuccessors Last where
134 fold_succs = fold_cmm_succs
136 instance LastNode Last where
137 mkBranchNode id = LastBranch id
138 isBranchNode (LastBranch _) = True
139 isBranchNode _ = False
140 branchNodeTarget (LastBranch id) = id
141 branchNodeTarget _ = panic "asked for target of non-branch"
143 cmmSuccs :: Last -> [BlockId]
144 cmmSuccs (LastReturn {}) = []
145 cmmSuccs (LastJump {}) = []
146 cmmSuccs (LastBranch id) = [id]
147 cmmSuccs (LastCall _ (Just id)) = [id]
148 cmmSuccs (LastCall _ Nothing) = []
149 cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
150 cmmSuccs (LastSwitch _ edges) = catMaybes edges
152 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
153 fold_cmm_succs _f (LastReturn {}) z = z
154 fold_cmm_succs _f (LastJump {}) z = z
155 fold_cmm_succs f (LastBranch id) z = f id z
156 fold_cmm_succs f (LastCall _ (Just id)) z = f id z
157 fold_cmm_succs _f (LastCall _ Nothing) z = z
158 fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
159 fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
161 ----------------------------------------------------------------------
162 ----- Instance declarations for register use
164 instance UserOfLocalRegs Middle where
165 foldRegsUsed f z m = middle m
166 where middle (MidComment {}) = z
167 middle (MidAssign _lhs expr) = fold f z expr
168 middle (MidStore addr rval) = fold f (fold f z addr) rval
169 middle (MidUnsafeCall tgt _ress args) = fold f (fold f z tgt) args
170 middle (MidAddToContext ra args) = fold f (fold f z ra) args
171 middle (CopyIn _ _formals _) = z
172 middle (CopyOut _ actuals) = fold f z actuals
173 fold f z m = foldRegsUsed f z m -- avoid monomorphism restriction
175 instance UserOfLocalRegs Last where
176 foldRegsUsed f z m = last m
177 where last (LastReturn) = z
178 last (LastJump e) = foldRegsUsed f z e
179 last (LastBranch _id) = z
180 last (LastCall tgt _) = foldRegsUsed f z tgt
181 last (LastCondBranch e _ _) = foldRegsUsed f z e
182 last (LastSwitch e _tbl) = foldRegsUsed f z e
185 ----------------------------------------------------------------------
186 ----- Instance declarations for prettyprinting (avoids recursive imports)
188 instance Outputable Middle where
191 instance Outputable Last where
194 instance Outputable Convention where
197 instance DF.DebugNodes Middle Last
202 pprMiddle :: Middle -> SDoc
203 pprMiddle stmt = (case stmt of
205 CopyIn conv args _ ->
206 if null args then ptext (sLit "empty CopyIn")
207 else commafy (map pprHinted args) <+> equals <+>
208 ptext (sLit "foreign") <+> doubleQuotes(ppr conv) <+> ptext (sLit "...")
211 ptext (sLit "next, pass") <+> doubleQuotes(ppr conv) <+>
212 parens (commafy (map pprHinted args))
215 MidComment s -> text "//" <+> ftext s
218 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
221 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
223 rep = ppr ( cmmExprRep expr )
225 -- call "ccall" foo(x, y)[r1, r2];
227 MidUnsafeCall (CmmCallee fn cconv) results args ->
228 hcat [ if null results
230 else parens (commafy $ map ppr results) <>
232 ptext (sLit "call"), space,
233 doubleQuotes(ppr cconv), space,
234 ppr_target fn, parens ( commafy $ map ppr args ),
237 MidUnsafeCall (CmmPrim op) results args ->
238 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
240 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
242 MidAddToContext ra args ->
243 hcat [ ptext (sLit "return via ")
244 , ppr_target ra, parens (commafy $ map ppr args), semi ]
247 if debugPpr then empty
250 CopyIn {} -> text "CopyIn"
251 CopyOut {} -> text "CopyOut"
252 MidComment {} -> text "MidComment"
253 MidAssign {} -> text "MidAssign"
254 MidStore {} -> text "MidStore"
255 MidUnsafeCall {} -> text "MidUnsafeCall"
256 MidAddToContext {} -> text "MidAddToContext"
259 ppr_target :: CmmExpr -> SDoc
260 ppr_target t@(CmmLit _) = ppr t
261 ppr_target fn' = parens (ppr fn')
264 pprHinted :: Outputable a => CmmHinted a -> SDoc
265 pprHinted (CmmHinted a NoHint) = ppr a
266 pprHinted (CmmHinted a PtrHint) = doubleQuotes (text "address") <+> ppr a
267 pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed") <+> ppr a
268 pprHinted (CmmHinted a FloatHint) = doubleQuotes (text "float") <+> ppr a
270 pprLast :: Last -> SDoc
271 pprLast stmt = (case stmt of
272 LastBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi
273 LastCondBranch expr t f -> genFullCondBranch expr t f
274 LastJump expr -> hcat [ ptext (sLit "jump"), space, pprFun expr
275 , ptext (sLit "(...)"), semi]
276 LastReturn -> hcat [ ptext (sLit "return"), space
277 , ptext (sLit "(...)"), semi]
278 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
279 LastCall tgt k -> genBareCall tgt k
281 if debugPpr then empty
284 LastBranch {} -> text "LastBranch"
285 LastCondBranch {} -> text "LastCondBranch"
286 LastJump {} -> text "LastJump"
287 LastReturn {} -> text "LastReturn"
288 LastSwitch {} -> text "LastSwitch"
289 LastCall {} -> text "LastCall"
291 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
293 hcat [ ptext (sLit "call"), space
294 , pprFun fn, ptext (sLit "(...)"), space
295 , case k of Nothing -> ptext (sLit "never returns")
296 Just k -> ptext (sLit "returns to") <+> ppr k
300 pprFun :: CmmExpr -> SDoc
301 pprFun f@(CmmLit _) = ppr f
302 pprFun f = parens (ppr f)
304 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
305 genFullCondBranch expr t f =
306 hsep [ ptext (sLit "if")
308 , ptext (sLit "goto")
310 , ptext (sLit "else goto")
314 pprConvention :: Convention -> SDoc
315 pprConvention (ConventionStandard c _) = ppr c
316 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
318 commafy :: [SDoc] -> SDoc
319 commafy xs = hsep $ punctuate comma xs