Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics
[ghc.git] / compiler / cmm / CmmNode.hs
1 -- CmmNode type for representation using Hoopl graphs.
2 {-# LANGUAGE GADTs #-}
3
4 {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
5 #if __GLASGOW_HASKELL__ >= 701
6 -- GHC 7.0.1 improved incomplete pattern warnings with GADTs
7 {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
8 #endif
9
10 module CmmNode
11 ( CmmNode(..)
12 , UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..)
13 , mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf
14 )
15 where
16
17 import CmmExpr
18 import CmmDecl
19 import FastString
20 import ForeignCall
21 import SMRep
22
23 import Compiler.Hoopl
24 import Data.Maybe
25 import Prelude hiding (succ)
26
27
28 ------------------------
29 -- CmmNode
30
31 data CmmNode e x where
32 CmmEntry :: Label -> CmmNode C O
33
34 CmmComment :: FastString -> CmmNode O O
35
36 CmmAssign :: CmmReg -> CmmExpr -> CmmNode O O -- Assign to register
37
38 CmmStore :: CmmExpr -> CmmExpr -> CmmNode O O -- Assign to memory location. Size is
39 -- given by cmmExprType of the rhs.
40
41 CmmUnsafeForeignCall :: -- An unsafe foreign call; see Note [Foreign calls]
42 -- Like a "fat machine instruction"; can occur
43 -- in the middle of a block
44 ForeignTarget -> -- call target
45 CmmFormals -> -- zero or more results
46 CmmActuals -> -- zero or more arguments
47 CmmNode O O
48 -- Semantics: kills only result regs; all other regs (both GlobalReg
49 -- and LocalReg) are preserved. But there is a current
50 -- bug for what can be put in arguments, see
51 -- Note [Register Parameter Passing]
52
53 CmmBranch :: Label -> CmmNode O C -- Goto another block in the same procedure
54
55 CmmCondBranch :: { -- conditional branch
56 cml_pred :: CmmExpr,
57 cml_true, cml_false :: Label
58 } -> CmmNode O C
59
60 CmmSwitch :: CmmExpr -> [Maybe Label] -> CmmNode O C -- Table branch
61 -- The scrutinee is zero-based;
62 -- zero -> first block
63 -- one -> second block etc
64 -- Undefined outside range, and when there's a Nothing
65
66 CmmCall :: { -- A native call or tail call
67 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
68
69 cml_cont :: Maybe Label,
70 -- Label of continuation (Nothing for return or tail call)
71
72 -- ToDO: add this:
73 -- cml_args_regs :: [GlobalReg],
74 -- It says which GlobalRegs are live for the parameters at the
75 -- moment of the call. Later stages can use this to give liveness
76 -- everywhere, which in turn guides register allocation.
77 -- It is the companion of cml_args; cml_args says which stack words
78 -- hold parameters, while cml_arg_regs says which global regs hold parameters.
79 -- But do note [Register parameter passing]
80
81 cml_args :: ByteOff,
82 -- Byte offset, from the *old* end of the Area associated with
83 -- the Label (if cml_cont = Nothing, then Old area), of
84 -- youngest outgoing arg. Set the stack pointer to this before
85 -- transferring control.
86 -- (NB: an update frame might also have been stored in the Old
87 -- area, but it'll be in an older part than the args.)
88
89 cml_ret_args :: ByteOff,
90 -- For calls *only*, the byte offset for youngest returned value
91 -- This is really needed at the *return* point rather than here
92 -- at the call, but in practice it's convenient to record it here.
93
94 cml_ret_off :: ByteOff
95 -- For calls *only*, the byte offset of the base of the frame that
96 -- must be described by the info table for the return point.
97 -- The older words are an update frames, which have their own
98 -- info-table and layout information
99
100 -- From a liveness point of view, the stack words older than
101 -- cml_ret_off are treated as live, even if the sequel of
102 -- the call goes into a loop.
103 } -> CmmNode O C
104
105 CmmForeignCall :: { -- A safe foreign call; see Note [Foreign calls]
106 -- Always the last node of a block
107 tgt :: ForeignTarget, -- call target and convention
108 res :: CmmFormals, -- zero or more results
109 args :: CmmActuals, -- zero or more arguments; see Note [Register parameter passing]
110 succ :: Label, -- Label of continuation
111 updfr :: UpdFrameOffset, -- where the update frame is (for building infotable)
112 intrbl:: Bool -- whether or not the call is interruptible
113 } -> CmmNode O C
114
115 {- Note [Foreign calls]
116 ~~~~~~~~~~~~~~~~~~~~~~~
117 A CmmUnsafeForeignCall is used for *unsafe* foreign calls;
118 a CmmForeignCall call is used for *safe* foreign calls.
119
120 Unsafe ones are mostly easy: think of them as a "fat machine
121 instruction". In particular, they do *not* kill all live registers,
122 just the registers they return to (there was a bit of code in GHC that
123 conservatively assumed otherwise.) However, see [Register parameter passing].
124
125 Safe ones are trickier. A safe foreign call
126 r = f(x)
127 ultimately expands to
128 push "return address" -- Never used to return to;
129 -- just points an info table
130 save registers into TSO
131 call suspendThread
132 r = f(x) -- Make the call
133 call resumeThread
134 restore registers
135 pop "return address"
136 We cannot "lower" a safe foreign call to this sequence of Cmms, because
137 after we've saved Sp all the Cmm optimiser's assumptions are broken.
138 Furthermore, currently the smart Cmm constructors know the calling
139 conventions for Haskell, the garbage collector, etc, and "lower" them
140 so that a LastCall passes no parameters or results. But the smart
141 constructors do *not* (currently) know the foreign call conventions.
142
143 Note that a safe foreign call needs an info table.
144 -}
145
146 {- Note [Register parameter passing]
147 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148 On certain architectures, some registers are utilized for parameter
149 passing in the C calling convention. For example, in x86-64 Linux
150 convention, rdi, rsi, rdx and rcx (as well as r8 and r9) may be used for
151 argument passing. These are registers R3-R6, which our generated
152 code may also be using; as a result, it's necessary to save these
153 values before doing a foreign call. This is done during initial
154 code generation in callerSaveVolatileRegs in StgCmmUtils.hs. However,
155 one result of doing this is that the contents of these registers
156 may mysteriously change if referenced inside the arguments. This
157 is dangerous, so you'll need to disable inlining much in the same
158 way is done in cmm/CmmOpt.hs currently. We should fix this!
159 -}
160
161 ---------------------------------------------
162 -- Eq instance of CmmNode
163 -- It is a shame GHC cannot infer it by itself :(
164
165 instance Eq (CmmNode e x) where
166 (CmmEntry a) == (CmmEntry a') = a==a'
167 (CmmComment a) == (CmmComment a') = a==a'
168 (CmmAssign a b) == (CmmAssign a' b') = a==a' && b==b'
169 (CmmStore a b) == (CmmStore a' b') = a==a' && b==b'
170 (CmmUnsafeForeignCall a b c) == (CmmUnsafeForeignCall a' b' c') = a==a' && b==b' && c==c'
171 (CmmBranch a) == (CmmBranch a') = a==a'
172 (CmmCondBranch a b c) == (CmmCondBranch a' b' c') = a==a' && b==b' && c==c'
173 (CmmSwitch a b) == (CmmSwitch a' b') = a==a' && b==b'
174 (CmmCall a b c d e) == (CmmCall a' b' c' d' e') = a==a' && b==b' && c==c' && d==d' && e==e'
175 (CmmForeignCall a b c d e f) == (CmmForeignCall a' b' c' d' e' f') = a==a' && b==b' && c==c' && d==d' && e==e' && f==f'
176 _ == _ = False
177
178 ----------------------------------------------
179 -- Hoopl instances of CmmNode
180
181 instance NonLocal CmmNode where
182 entryLabel (CmmEntry l) = l
183
184 successors (CmmBranch l) = [l]
185 successors (CmmCondBranch {cml_true=t, cml_false=f}) = [f, t] -- meets layout constraint
186 successors (CmmSwitch _ ls) = catMaybes ls
187 successors (CmmCall {cml_cont=l}) = maybeToList l
188 successors (CmmForeignCall {succ=l}) = [l]
189
190
191 instance HooplNode CmmNode where
192 mkBranchNode label = CmmBranch label
193 mkLabelNode label = CmmEntry label
194
195 --------------------------------------------------
196 -- Various helper types
197
198 type UpdFrameOffset = ByteOff
199
200 data Convention
201 = NativeDirectCall -- Native C-- call skipping the node (closure) argument
202 | NativeNodeCall -- Native C-- call including the node argument
203 | NativeReturn -- Native C-- return
204 | Slow -- Slow entry points: all args pushed on the stack
205 | GC -- Entry to the garbage collector: uses the node reg!
206 | PrimOpCall -- Calling prim ops
207 | PrimOpReturn -- Returning from prim ops
208 | Foreign -- Foreign call/return
209 ForeignConvention
210 | Private
211 -- Used for control transfers within a (pre-CPS) procedure All
212 -- jump sites known, never pushed on the stack (hence no SRT)
213 -- You can choose whatever calling convention you please
214 -- (provided you make sure all the call sites agree)!
215 -- This data type eventually to be extended to record the convention.
216 deriving( Eq )
217
218 data ForeignConvention
219 = ForeignConvention
220 CCallConv -- Which foreign-call convention
221 [ForeignHint] -- Extra info about the args
222 [ForeignHint] -- Extra info about the result
223 deriving Eq
224
225 data ForeignTarget -- The target of a foreign call
226 = ForeignTarget -- A foreign procedure
227 CmmExpr -- Its address
228 ForeignConvention -- Its calling convention
229 | PrimTarget -- A possibly-side-effecting machine operation
230 CallishMachOp -- Which one
231 deriving Eq
232
233 --------------------------------------------------
234 -- Instances of register and slot users / definers
235
236 instance UserOfLocalRegs (CmmNode e x) where
237 foldRegsUsed f z n = case n of
238 CmmAssign _ expr -> fold f z expr
239 CmmStore addr rval -> fold f (fold f z addr) rval
240 CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
241 CmmCondBranch expr _ _ -> fold f z expr
242 CmmSwitch expr _ -> fold f z expr
243 CmmCall {cml_target=tgt} -> fold f z tgt
244 CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
245 _ -> z
246 where fold :: forall a b.
247 UserOfLocalRegs a =>
248 (b -> LocalReg -> b) -> b -> a -> b
249 fold f z n = foldRegsUsed f z n
250
251 instance UserOfLocalRegs ForeignTarget where
252 foldRegsUsed _f z (PrimTarget _) = z
253 foldRegsUsed f z (ForeignTarget e _) = foldRegsUsed f z e
254
255 instance DefinerOfLocalRegs (CmmNode e x) where
256 foldRegsDefd f z n = case n of
257 CmmAssign lhs _ -> fold f z lhs
258 CmmUnsafeForeignCall _ fs _ -> fold f z fs
259 CmmForeignCall {res=res} -> fold f z res
260 _ -> z
261 where fold :: forall a b.
262 DefinerOfLocalRegs a =>
263 (b -> LocalReg -> b) -> b -> a -> b
264 fold f z n = foldRegsDefd f z n
265
266
267 instance UserOfSlots (CmmNode e x) where
268 foldSlotsUsed f z n = case n of
269 CmmAssign _ expr -> fold f z expr
270 CmmStore addr rval -> fold f (fold f z addr) rval
271 CmmUnsafeForeignCall _ _ args -> fold f z args
272 CmmCondBranch expr _ _ -> fold f z expr
273 CmmSwitch expr _ -> fold f z expr
274 CmmCall {cml_target=tgt} -> fold f z tgt
275 CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
276 _ -> z
277 where fold :: forall a b.
278 UserOfSlots a =>
279 (b -> SubArea -> b) -> b -> a -> b
280 fold f z n = foldSlotsUsed f z n
281
282 instance UserOfSlots ForeignTarget where
283 foldSlotsUsed f z (ForeignTarget e _) = foldSlotsUsed f z e
284 foldSlotsUsed _f z (PrimTarget _) = z
285
286 instance DefinerOfSlots (CmmNode e x) where
287 foldSlotsDefd f z n = case n of
288 CmmStore (CmmStackSlot a i) expr -> f z (a, i, widthInBytes $ typeWidth $ cmmExprType expr)
289 CmmForeignCall {res=res} -> fold f z $ map foreign_call_slot res
290 _ -> z
291 where
292 fold :: forall a b.
293 DefinerOfSlots a =>
294 (b -> SubArea -> b) -> b -> a -> b
295 fold f z n = foldSlotsDefd f z n
296 foreign_call_slot r = case widthInBytes $ typeWidth $ localRegType r of w -> (RegSlot r, w, w)
297
298 -----------------------------------
299 -- mapping Expr in CmmNode
300
301 mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
302 mapForeignTarget exp (ForeignTarget e c) = ForeignTarget (exp e) c
303 mapForeignTarget _ m@(PrimTarget _) = m
304
305 -- Take a transformer on expressions and apply it recursively.
306 wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
307 wrapRecExp f (CmmMachOp op es) = f (CmmMachOp op $ map (wrapRecExp f) es)
308 wrapRecExp f (CmmLoad addr ty) = f (CmmLoad (wrapRecExp f addr) ty)
309 wrapRecExp f e = f e
310
311 mapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
312 mapExp _ f@(CmmEntry _) = f
313 mapExp _ m@(CmmComment _) = m
314 mapExp f (CmmAssign r e) = CmmAssign r (f e)
315 mapExp f (CmmStore addr e) = CmmStore (f addr) (f e)
316 mapExp f (CmmUnsafeForeignCall tgt fs as) = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as)
317 mapExp _ l@(CmmBranch _) = l
318 mapExp f (CmmCondBranch e ti fi) = CmmCondBranch (f e) ti fi
319 mapExp f (CmmSwitch e tbl) = CmmSwitch (f e) tbl
320 mapExp f (CmmCall tgt mb_id o i s) = CmmCall (f tgt) mb_id o i s
321 mapExp f (CmmForeignCall tgt fs as succ updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ updfr intrbl
322
323 mapExpDeep :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
324 mapExpDeep f = mapExp $ wrapRecExp f
325
326 -----------------------------------
327 -- folding Expr in CmmNode
328
329 foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
330 foldExpForeignTarget exp (ForeignTarget e _) z = exp e z
331 foldExpForeignTarget _ (PrimTarget _) z = z
332
333 -- Take a folder on expressions and apply it recursively.
334 wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
335 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
336 wrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)
337 wrapRecExpf f e z = f e z
338
339 foldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
340 foldExp _ (CmmEntry {}) z = z
341 foldExp _ (CmmComment {}) z = z
342 foldExp f (CmmAssign _ e) z = f e z
343 foldExp f (CmmStore addr e) z = f addr $ f e z
344 foldExp f (CmmUnsafeForeignCall t _ as) z = foldr f (foldExpForeignTarget f t z) as
345 foldExp _ (CmmBranch _) z = z
346 foldExp f (CmmCondBranch e _ _) z = f e z
347 foldExp f (CmmSwitch e _) z = f e z
348 foldExp f (CmmCall {cml_target=tgt}) z = f tgt z
349 foldExp f (CmmForeignCall {tgt=tgt, args=args}) z = foldr f (foldExpForeignTarget f tgt z) args
350
351 foldExpDeep :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
352 foldExpDeep f = foldExp $ wrapRecExpf f