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, CmmFormalsWithoutKinds, CmmFormals
19 , CmmStmt(CmmJump, CmmSwitch) -- imported in order to call ppr
28 import qualified ZipDataflow as DF
34 import Prelude hiding (zip, unzip, last)
36 type CmmGraph = LGraph Middle Last
37 type CmmAGraph = AGraph Middle Last
38 type CmmBlock = Block Middle Last
39 type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
40 type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
44 | MidComment FastString
46 | MidAssign CmmReg CmmExpr -- Assign to register
48 | MidStore CmmExpr CmmExpr -- Assign to memory location. Size is
49 -- given by cmmExprRep of the rhs.
51 | MidUnsafeCall -- An "unsafe" foreign call;
52 CmmCallTarget -- just a fat machine instructoin
53 CmmFormals -- zero or more results
54 CmmActuals -- zero or more arguments
56 | CopyIn -- Move parameters or results from conventional locations to registers
57 -- Note [CopyIn invariant]
59 CmmFormals -- eventually [CmmKind] will be used only for foreign
60 -- calls and will migrate into 'Convention' (helping to
62 C_SRT -- Static things kept alive by this block
63 | CopyOut Convention CmmActuals
66 = LastReturn CmmActuals -- Return from a function,
67 -- with these return values.
69 | LastJump CmmExpr CmmActuals
70 -- Tail call to another procedure
72 | LastBranch BlockId CmmFormalsWithoutKinds
73 -- To another block in the same procedure
74 -- The parameters are unused at present.
76 | LastCall { -- A call (native or safe foreign)
77 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
78 cml_next :: Maybe BlockId } -- BlockId of continuation, if call returns
80 | LastCondBranch { -- conditional branch
82 cml_true, cml_false :: BlockId
85 | LastSwitch CmmExpr [Maybe BlockId] -- Table branch
86 -- The scrutinee is zero-based;
87 -- zero -> first block
88 -- one -> second block etc
89 -- Undefined outside range, and when there's a Nothing
92 = ConventionStandard CCallConv ValueDirection
94 -- Used for control transfers within a (pre-CPS) procedure
95 -- All jump sites known, never pushed on the stack (hence no SRT)
96 -- You can choose whatever calling convention
97 -- you please (provided you make sure
98 -- all the call sites agree)!
101 data ValueDirection = Arguments | Results
102 -- Arguments go with procedure definitions, jumps, and arguments to calls
103 -- Results go with returns and with results of calls.
107 Note [CopyIn invariant]
108 ~~~~~~~~~~~~~~~~~~~~~~~
109 In principle, CopyIn ought to be a First node, but in practice, the
110 possibility raises all sorts of hairy issues with graph splicing,
111 rewriting, and so on. In the end, NR finds it better to make the
112 placement of CopyIn a dynamic invariant. This change will complicate
113 the dataflow fact for the proc-point calculation, but it should make
114 things easier in many other respects.
117 instance HavingSuccessors Last where
119 fold_succs = fold_cmm_succs
121 instance LastNode Last where
122 mkBranchNode id = LastBranch id []
123 isBranchNode (LastBranch _ []) = True
124 isBranchNode _ = False
125 branchNodeTarget (LastBranch id []) = id
126 branchNodeTarget _ = panic "asked for target of non-branch"
128 cmmSuccs :: Last -> [BlockId]
129 cmmSuccs (LastReturn {}) = []
130 cmmSuccs (LastJump {}) = []
131 cmmSuccs (LastBranch id _) = [id]
132 cmmSuccs (LastCall _ (Just id)) = [id]
133 cmmSuccs (LastCall _ Nothing) = []
134 cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
135 cmmSuccs (LastSwitch _ edges) = catMaybes edges
137 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
138 fold_cmm_succs _f (LastReturn {}) z = z
139 fold_cmm_succs _f (LastJump {}) z = z
140 fold_cmm_succs f (LastBranch id _) z = f id z
141 fold_cmm_succs f (LastCall _ (Just id)) z = f id z
142 fold_cmm_succs _f (LastCall _ Nothing) z = z
143 fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
144 fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
147 ----------------------------------------------------------------
148 -- prettyprinting (avoids recursive imports)
150 instance Outputable Middle where
153 instance Outputable Last where
156 instance Outputable Convention where
159 instance DF.DebugNodes Middle Last
161 instance Outputable CmmGraph where
167 pprMiddle :: Middle -> SDoc
168 pprMiddle stmt = (case stmt of
172 CopyIn conv args _ ->
173 if null args then ptext SLIT("empty CopyIn")
174 else commafy (map pprHinted args) <+> equals <+>
175 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
178 if null args then empty
179 else ptext SLIT("CopyOut") <+> doubleQuotes(ppr conv) <+>
180 parens (commafy (map pprHinted args))
183 MidComment s -> text "//" <+> ftext s
186 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
189 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
191 rep = ppr ( cmmExprRep expr )
193 -- call "ccall" foo(x, y)[r1, r2];
195 MidUnsafeCall (CmmCallee fn cconv) results args ->
196 hcat [ if null results
198 else parens (commafy $ map ppr results) <>
200 ptext SLIT("call"), space,
201 doubleQuotes(ppr cconv), space,
202 target fn, parens ( commafy $ map ppr args ),
205 target t@(CmmLit _) = ppr t
206 target fn' = parens (ppr fn')
208 MidUnsafeCall (CmmPrim op) results args ->
209 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
211 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
213 if debugPpr then empty
216 MidNop {} -> text "MidNop"
217 CopyIn {} -> text "CopyIn"
218 CopyOut {} -> text "CopyOut"
219 MidComment {} -> text "MidComment"
220 MidAssign {} -> text "MidAssign"
221 MidStore {} -> text "MidStore"
222 MidUnsafeCall {} -> text "MidUnsafeCall"
225 pprHinted :: Outputable a => (a, MachHint) -> SDoc
226 pprHinted (a, NoHint) = ppr a
227 pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
228 pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
229 pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
231 pprLast :: Last -> SDoc
232 pprLast stmt = (case stmt of
233 LastBranch ident args -> genBranchWithArgs ident args
234 LastCondBranch expr t f -> genFullCondBranch expr t f
235 LastJump expr params -> ppr $ CmmJump expr params
236 LastReturn results -> hcat [ ptext SLIT("return"), space
237 , parens ( commafy $ map pprHinted results )
239 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
240 LastCall tgt k -> genBareCall tgt k
242 if debugPpr then empty
245 LastBranch {} -> text "LastBranch"
246 LastCondBranch {} -> text "LastCondBranch"
247 LastJump {} -> text "LastJump"
248 LastReturn {} -> text "LastReturn"
249 LastSwitch {} -> text "LastSwitch"
250 LastCall {} -> text "LastCall"
252 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
254 hcat [ ptext SLIT("foreign"), space
255 , doubleQuotes(ptext SLIT("<convention from CopyOut>")), space
256 , target fn, parens ( ptext SLIT("<parameters from CopyOut>") ), space
257 , case k of Nothing -> ptext SLIT("never returns")
258 Just k -> ptext SLIT("returns to") <+> ppr k
261 target t@(CmmLit _) = ppr t
262 target fn' = parens (ppr fn')
264 genBranchWithArgs :: (Outputable id, Outputable arg) => id -> [arg] -> SDoc
265 genBranchWithArgs ident [] = ptext SLIT("goto") <+> ppr ident <> semi
266 genBranchWithArgs ident args = ptext SLIT("goto") <+> ppr ident <+>
267 parens (commafy (map ppr args)) <> semi
269 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
270 genFullCondBranch expr t f =
271 hsep [ ptext SLIT("if")
275 , ptext SLIT("else goto")
279 pprConvention :: Convention -> SDoc
280 pprConvention (ConventionStandard c _) = ppr c
281 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
283 commafy :: [SDoc] -> SDoc
284 commafy xs = hsep $ punctuate comma xs