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