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 ZipDataflow 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
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 | CopyIn -- Move incoming parameters or results from conventional
60 -- locations to registers. Note [CopyIn invariant]
62 CmmFormals -- eventually [CmmKind] will be used only for foreign
63 -- calls and will migrate into 'Convention' (helping to
64 -- drain "the swamp"), leaving this as [LocalReg]
65 C_SRT -- Static things kept alive by this block
67 | CopyOut Convention CmmActuals
68 -- Move outgoing parameters or results from registers to
69 -- conventional locations. Every 'LastReturn',
70 -- 'LastJump', or 'LastCall' must be dominated by a
71 -- matching 'CopyOut' in the same basic block.
72 -- As above, '[CmmKind]' will migrate into the foreign calling
73 -- convention, leaving the actuals as '[CmmExpr]'.
76 = LastBranch BlockId -- Goto another block in the same procedure
78 | LastCondBranch { -- conditional branch
80 cml_true, cml_false :: BlockId
83 | LastReturn -- Return from a function; values in a previous CopyOut node
85 | LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node
87 | LastCall { -- A call (native or safe foreign)
88 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
89 cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns
91 | LastSwitch CmmExpr [Maybe BlockId] -- Table branch
92 -- The scrutinee is zero-based;
93 -- zero -> first block
94 -- one -> second block etc
95 -- Undefined outside range, and when there's a Nothing
98 = ConventionStandard CCallConv ValueDirection
100 -- Used for control transfers within a (pre-CPS) procedure All
101 -- jump sites known, never pushed on the stack (hence no SRT)
102 -- You can choose whatever calling convention you please
103 -- (provided you make sure all the call sites agree)!
104 -- This data type eventually to be extended to record the convention.
108 data ValueDirection = Arguments | Results
109 -- Arguments go with procedure definitions, jumps, and arguments to calls
110 -- Results go with returns and with results of calls.
114 Note [CopyIn invariant]
115 ~~~~~~~~~~~~~~~~~~~~~~~
116 One might wish for CopyIn to be a First node, but in practice, the
117 possibility raises all sorts of hairy issues with graph splicing,
118 rewriting, and so on. In the end, NR finds it better to make the
119 placement of CopyIn a dynamic invariant; it should normally be the first
120 Middle node in the basic block in which it occurs.
123 ----------------------------------------------------------------------
124 ----- Instance declarations for control flow
126 instance HavingSuccessors Last where
128 fold_succs = fold_cmm_succs
130 instance LastNode Last where
131 mkBranchNode id = LastBranch id
132 isBranchNode (LastBranch _) = True
133 isBranchNode _ = False
134 branchNodeTarget (LastBranch id) = id
135 branchNodeTarget _ = panic "asked for target of non-branch"
137 cmmSuccs :: Last -> [BlockId]
138 cmmSuccs (LastReturn {}) = []
139 cmmSuccs (LastJump {}) = []
140 cmmSuccs (LastBranch id) = [id]
141 cmmSuccs (LastCall _ (Just id)) = [id]
142 cmmSuccs (LastCall _ Nothing) = []
143 cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint
144 cmmSuccs (LastSwitch _ edges) = catMaybes edges
146 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
147 fold_cmm_succs _f (LastReturn {}) z = z
148 fold_cmm_succs _f (LastJump {}) z = z
149 fold_cmm_succs f (LastBranch id) z = f id z
150 fold_cmm_succs f (LastCall _ (Just id)) z = f id z
151 fold_cmm_succs _f (LastCall _ Nothing) z = z
152 fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z)
153 fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges
156 ----------------------------------------------------------------------
157 ----- Instance declarations for prettyprinting (avoids recursive imports)
159 instance Outputable Middle where
162 instance Outputable Last where
165 instance Outputable Convention where
168 instance DF.DebugNodes Middle Last
170 instance Outputable CmmGraph where
176 pprMiddle :: Middle -> SDoc
177 pprMiddle stmt = (case stmt of
181 CopyIn conv args _ ->
182 if null args then ptext SLIT("empty CopyIn")
183 else commafy (map pprHinted args) <+> equals <+>
184 ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
187 ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
188 parens (commafy (map pprHinted args))
191 MidComment s -> text "//" <+> ftext s
194 MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
197 MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
199 rep = ppr ( cmmExprRep expr )
201 -- call "ccall" foo(x, y)[r1, r2];
203 MidUnsafeCall (CmmCallee fn cconv) results args ->
204 hcat [ if null results
206 else parens (commafy $ map ppr results) <>
208 ptext SLIT("call"), space,
209 doubleQuotes(ppr cconv), space,
210 target fn, parens ( commafy $ map ppr args ),
213 target t@(CmmLit _) = ppr t
214 target fn' = parens (ppr fn')
216 MidUnsafeCall (CmmPrim op) results args ->
217 pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
219 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
221 if debugPpr then empty
224 MidNop {} -> text "MidNop"
225 CopyIn {} -> text "CopyIn"
226 CopyOut {} -> text "CopyOut"
227 MidComment {} -> text "MidComment"
228 MidAssign {} -> text "MidAssign"
229 MidStore {} -> text "MidStore"
230 MidUnsafeCall {} -> text "MidUnsafeCall"
233 pprHinted :: Outputable a => (a, MachHint) -> SDoc
234 pprHinted (a, NoHint) = ppr a
235 pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
236 pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
237 pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
239 pprLast :: Last -> SDoc
240 pprLast stmt = (case stmt of
241 LastBranch ident -> ptext SLIT("goto") <+> ppr ident <> semi
242 LastCondBranch expr t f -> genFullCondBranch expr t f
243 LastJump expr -> hcat [ ptext SLIT("jump"), space, pprFun expr
244 , ptext SLIT("(...)"), semi]
245 LastReturn -> hcat [ ptext SLIT("return"), space
246 , ptext SLIT("(...)"), semi]
247 LastSwitch arg ids -> ppr $ CmmSwitch arg ids
248 LastCall tgt k -> genBareCall tgt k
250 if debugPpr then empty
253 LastBranch {} -> text "LastBranch"
254 LastCondBranch {} -> text "LastCondBranch"
255 LastJump {} -> text "LastJump"
256 LastReturn {} -> text "LastReturn"
257 LastSwitch {} -> text "LastSwitch"
258 LastCall {} -> text "LastCall"
260 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
262 hcat [ ptext SLIT("call"), space
263 , pprFun fn, ptext SLIT("(...)"), space
264 , case k of Nothing -> ptext SLIT("never returns")
265 Just k -> ptext SLIT("returns to") <+> ppr k
269 pprFun :: CmmExpr -> SDoc
270 pprFun f@(CmmLit _) = ppr f
271 pprFun f = parens (ppr f)
273 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
274 genFullCondBranch expr t f =
275 hsep [ ptext SLIT("if")
279 , ptext SLIT("else goto")
283 pprConvention :: Convention -> SDoc
284 pprConvention (ConventionStandard c _) = ppr c
285 pprConvention (ConventionPrivate {} ) = text "<private-convention>"
287 commafy :: [SDoc] -> SDoc
288 commafy xs = hsep $ punctuate comma xs