Generalize register sets and liveness calculations.
[ghc.git] / compiler / cmm / CmmNode.hs
1 -- CmmNode type for representation using Hoopl graphs.
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE GADTs #-}
4 {-# LANGUAGE UndecidableInstances #-}
5
6 {-# OPTIONS -fno-warn-tabs #-}
7 -- The above warning supression flag is a temporary kludge.
8 -- While working on this module you are encouraged to remove it and
9 -- detab the module (please do the detabbing in a separate patch). See
10 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
11 -- for details
12
13 module CmmNode (
14 CmmNode(..), CmmFormal, CmmActual,
15 UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..),
16 CmmReturnInfo(..),
17 mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf,
18 mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors
19 ) where
20
21 import CodeGen.Platform
22 import CmmExpr
23 import DynFlags
24 import FastString
25 import ForeignCall
26 import SMRep
27
28 import Compiler.Hoopl
29 import Data.Maybe
30 import Data.List (tails)
31 import Prelude hiding (succ)
32
33
34 ------------------------
35 -- CmmNode
36
37 #define ULabel {-# UNPACK #-} !Label
38
39 data CmmNode e x where
40 CmmEntry :: ULabel -> CmmNode C O
41
42 CmmComment :: FastString -> CmmNode O O
43
44 CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O
45 -- Assign to register
46
47 CmmStore :: !CmmExpr -> !CmmExpr -> CmmNode O O
48 -- Assign to memory location. Size is
49 -- given by cmmExprType of the rhs.
50
51 CmmUnsafeForeignCall :: -- An unsafe foreign call;
52 -- see Note [Foreign calls]
53 -- Like a "fat machine instruction"; can occur
54 -- in the middle of a block
55 ForeignTarget -> -- call target
56 [CmmFormal] -> -- zero or more results
57 [CmmActual] -> -- zero or more arguments
58 CmmNode O O
59 -- Semantics: clobbers any GlobalRegs for which callerSaves r == True
60 -- See Note [foreign calls clobber GlobalRegs]
61 --
62 -- Also, there is a current bug for what can be put in
63 -- arguments, see Note [Register Parameter Passing]
64
65 CmmBranch :: ULabel -> CmmNode O C
66 -- Goto another block in the same procedure
67
68 CmmCondBranch :: { -- conditional branch
69 cml_pred :: CmmExpr,
70 cml_true, cml_false :: ULabel
71 } -> CmmNode O C
72
73 CmmSwitch :: CmmExpr -> [Maybe Label] -> CmmNode O C -- Table branch
74 -- The scrutinee is zero-based;
75 -- zero -> first block
76 -- one -> second block etc
77 -- Undefined outside range, and when there's a Nothing
78
79 CmmCall :: { -- A native call or tail call
80 cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
81
82 cml_cont :: Maybe Label,
83 -- Label of continuation (Nothing for return or tail call)
84 --
85 -- Note [Continuation BlockId]: these BlockIds are called
86 -- Continuation BlockIds, and are the only BlockIds that can
87 -- occur in CmmExprs, namely as (CmmLit (CmmBlock b)) or
88 -- (CmmStackSlot (Young b) _).
89
90 cml_args_regs :: [GlobalReg],
91 -- The argument GlobalRegs (Rx, Fx, Dx, Lx) that are passed
92 -- to the call. This is essential information for the
93 -- native code generator's register allocator; without
94 -- knowing which GlobalRegs are live it has to assume that
95 -- they are all live. This list should only include
96 -- GlobalRegs that are mapped to real machine registers on
97 -- the target platform.
98
99 cml_args :: ByteOff,
100 -- Byte offset, from the *old* end of the Area associated with
101 -- the Label (if cml_cont = Nothing, then Old area), of
102 -- youngest outgoing arg. Set the stack pointer to this before
103 -- transferring control.
104 -- (NB: an update frame might also have been stored in the Old
105 -- area, but it'll be in an older part than the args.)
106
107 cml_ret_args :: ByteOff,
108 -- For calls *only*, the byte offset for youngest returned value
109 -- This is really needed at the *return* point rather than here
110 -- at the call, but in practice it's convenient to record it here.
111
112 cml_ret_off :: ByteOff
113 -- For calls *only*, the byte offset of the base of the frame that
114 -- must be described by the info table for the return point.
115 -- The older words are an update frames, which have their own
116 -- info-table and layout information
117
118 -- From a liveness point of view, the stack words older than
119 -- cml_ret_off are treated as live, even if the sequel of
120 -- the call goes into a loop.
121 } -> CmmNode O C
122
123 CmmForeignCall :: { -- A safe foreign call; see Note [Foreign calls]
124 -- Always the last node of a block
125 tgt :: ForeignTarget, -- call target and convention
126 res :: [CmmFormal], -- zero or more results
127 args :: [CmmActual], -- zero or more arguments; see Note [Register parameter passing]
128 succ :: ULabel, -- Label of continuation
129 updfr :: UpdFrameOffset, -- where the update frame is (for building infotable)
130 intrbl:: Bool -- whether or not the call is interruptible
131 } -> CmmNode O C
132
133 {- Note [Foreign calls]
134 ~~~~~~~~~~~~~~~~~~~~~~~
135 A CmmUnsafeForeignCall is used for *unsafe* foreign calls;
136 a CmmForeignCall call is used for *safe* foreign calls.
137
138 Unsafe ones are mostly easy: think of them as a "fat machine
139 instruction". In particular, they do *not* kill all live registers,
140 just the registers they return to (there was a bit of code in GHC that
141 conservatively assumed otherwise.) However, see [Register parameter passing].
142
143 Safe ones are trickier. A safe foreign call
144 r = f(x)
145 ultimately expands to
146 push "return address" -- Never used to return to;
147 -- just points an info table
148 save registers into TSO
149 call suspendThread
150 r = f(x) -- Make the call
151 call resumeThread
152 restore registers
153 pop "return address"
154 We cannot "lower" a safe foreign call to this sequence of Cmms, because
155 after we've saved Sp all the Cmm optimiser's assumptions are broken.
156
157 Note that a safe foreign call needs an info table.
158
159 So Safe Foreign Calls must remain as last nodes until the stack is
160 made manifest in CmmLayoutStack, where they are lowered into the above
161 sequence.
162 -}
163
164 {- Note [foreign calls clobber GlobalRegs]
165 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
166
167 A foreign call is defined to clobber any GlobalRegs that are mapped to
168 caller-saves machine registers (according to the prevailing C ABI).
169 StgCmmUtils.callerSaves tells you which GlobalRegs are caller-saves.
170
171 This is a design choice that makes it easier to generate code later.
172 We could instead choose to say that foreign calls do *not* clobber
173 caller-saves regs, but then we would have to figure out which regs
174 were live across the call later and insert some saves/restores.
175
176 Furthermore when we generate code we never have any GlobalRegs live
177 across a call, because they are always copied-in to LocalRegs and
178 copied-out again before making a call/jump. So all we have to do is
179 avoid any code motion that would make a caller-saves GlobalReg live
180 across a foreign call during subsequent optimisations.
181 -}
182
183 {- Note [Register parameter passing]
184 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
185 On certain architectures, some registers are utilized for parameter
186 passing in the C calling convention. For example, in x86-64 Linux
187 convention, rdi, rsi, rdx and rcx (as well as r8 and r9) may be used for
188 argument passing. These are registers R3-R6, which our generated
189 code may also be using; as a result, it's necessary to save these
190 values before doing a foreign call. This is done during initial
191 code generation in callerSaveVolatileRegs in StgCmmUtils.hs. However,
192 one result of doing this is that the contents of these registers
193 may mysteriously change if referenced inside the arguments. This
194 is dangerous, so you'll need to disable inlining much in the same
195 way is done in cmm/CmmOpt.hs currently. We should fix this!
196 -}
197
198 ---------------------------------------------
199 -- Eq instance of CmmNode
200 -- It is a shame GHC cannot infer it by itself :(
201
202 instance Eq (CmmNode e x) where
203 (CmmEntry a) == (CmmEntry a') = a==a'
204 (CmmComment a) == (CmmComment a') = a==a'
205 (CmmAssign a b) == (CmmAssign a' b') = a==a' && b==b'
206 (CmmStore a b) == (CmmStore a' b') = a==a' && b==b'
207 (CmmUnsafeForeignCall a b c) == (CmmUnsafeForeignCall a' b' c') = a==a' && b==b' && c==c'
208 (CmmBranch a) == (CmmBranch a') = a==a'
209 (CmmCondBranch a b c) == (CmmCondBranch a' b' c') = a==a' && b==b' && c==c'
210 (CmmSwitch a b) == (CmmSwitch a' b') = a==a' && b==b'
211 (CmmCall a b c d e f) == (CmmCall a' b' c' d' e' f') = a==a' && b==b' && c==c' && d==d' && e==e' && f==f'
212 (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'
213 _ == _ = False
214
215 ----------------------------------------------
216 -- Hoopl instances of CmmNode
217
218 instance NonLocal CmmNode where
219 entryLabel (CmmEntry l) = l
220
221 successors (CmmBranch l) = [l]
222 successors (CmmCondBranch {cml_true=t, cml_false=f}) = [f, t] -- meets layout constraint
223 successors (CmmSwitch _ ls) = catMaybes ls
224 successors (CmmCall {cml_cont=l}) = maybeToList l
225 successors (CmmForeignCall {succ=l}) = [l]
226
227
228 --------------------------------------------------
229 -- Various helper types
230
231 type CmmActual = CmmExpr
232 type CmmFormal = LocalReg
233
234 type UpdFrameOffset = ByteOff
235
236 -- | A convention maps a list of values (function arguments or return
237 -- values) to registers or stack locations.
238 data Convention
239 = NativeDirectCall
240 -- ^ top-level Haskell functions use @NativeDirectCall@, which
241 -- maps arguments to registers starting with R2, according to
242 -- how many registers are available on the platform. This
243 -- convention ignores R1, because for a top-level function call
244 -- the function closure is implicit, and doesn't need to be passed.
245 | NativeNodeCall
246 -- ^ non-top-level Haskell functions, which pass the address of
247 -- the function closure in R1 (regardless of whether R1 is a
248 -- real register or not), and the rest of the arguments in
249 -- registers or on the stack.
250 | NativeReturn
251 -- ^ a native return. The convention for returns depends on
252 -- how many values are returned: for just one value returned,
253 -- the appropriate register is used (R1, F1, etc.). regardless
254 -- of whether it is a real register or not. For multiple
255 -- values returned, they are mapped to registers or the stack.
256 | Slow
257 -- ^ Slow entry points: all args pushed on the stack
258 | GC
259 -- ^ Entry to the garbage collector: uses the node reg!
260 -- (TODO: I don't think we need this --SDM)
261 deriving( Eq )
262
263 data ForeignConvention
264 = ForeignConvention
265 CCallConv -- Which foreign-call convention
266 [ForeignHint] -- Extra info about the args
267 [ForeignHint] -- Extra info about the result
268 CmmReturnInfo
269 deriving Eq
270
271 data CmmReturnInfo
272 = CmmMayReturn
273 | CmmNeverReturns
274 deriving ( Eq )
275
276 data ForeignTarget -- The target of a foreign call
277 = ForeignTarget -- A foreign procedure
278 CmmExpr -- Its address
279 ForeignConvention -- Its calling convention
280 | PrimTarget -- A possibly-side-effecting machine operation
281 CallishMachOp -- Which one
282 deriving Eq
283
284 --------------------------------------------------
285 -- Instances of register and slot users / definers
286
287 instance UserOfRegs LocalReg (CmmNode e x) where
288 foldRegsUsed dflags f z n = case n of
289 CmmAssign _ expr -> fold f z expr
290 CmmStore addr rval -> fold f (fold f z addr) rval
291 CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
292 CmmCondBranch expr _ _ -> fold f z expr
293 CmmSwitch expr _ -> fold f z expr
294 CmmCall {cml_target=tgt} -> fold f z tgt
295 CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
296 _ -> z
297 where fold :: forall a b.
298 UserOfRegs LocalReg a =>
299 (b -> LocalReg -> b) -> b -> a -> b
300 fold f z n = foldRegsUsed dflags f z n
301
302 instance UserOfRegs GlobalReg (CmmNode e x) where
303 foldRegsUsed dflags f z n = case n of
304 CmmAssign _ expr -> fold f z expr
305 CmmStore addr rval -> fold f (fold f z addr) rval
306 CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
307 CmmCondBranch expr _ _ -> fold f z expr
308 CmmSwitch expr _ -> fold f z expr
309 CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt
310 CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
311 _ -> z
312 where fold :: forall a b.
313 UserOfRegs GlobalReg a =>
314 (b -> GlobalReg -> b) -> b -> a -> b
315 fold f z n = foldRegsUsed dflags f z n
316
317 instance UserOfRegs r CmmExpr => UserOfRegs r ForeignTarget where
318 foldRegsUsed _ _ z (PrimTarget _) = z
319 foldRegsUsed dflags f z (ForeignTarget e _) = foldRegsUsed dflags f z e
320
321 instance DefinerOfRegs LocalReg (CmmNode e x) where
322 foldRegsDefd dflags f z n = case n of
323 CmmAssign lhs _ -> fold f z lhs
324 CmmUnsafeForeignCall _ fs _ -> fold f z fs
325 CmmForeignCall {res=res} -> fold f z res
326 _ -> z
327 where fold :: forall a b.
328 DefinerOfRegs LocalReg a =>
329 (b -> LocalReg -> b) -> b -> a -> b
330 fold f z n = foldRegsDefd dflags f z n
331
332 instance DefinerOfRegs GlobalReg (CmmNode e x) where
333 foldRegsDefd dflags f z n = case n of
334 CmmAssign lhs _ -> fold f z lhs
335 CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt)
336 CmmCall {} -> fold f z activeRegs
337 CmmForeignCall {tgt=tgt} -> fold f z (foreignTargetRegs tgt)
338 _ -> z
339 where fold :: forall a b.
340 DefinerOfRegs GlobalReg a =>
341 (b -> GlobalReg -> b) -> b -> a -> b
342 fold f z n = foldRegsDefd dflags f z n
343
344 platform = targetPlatform dflags
345 activeRegs = activeStgRegs platform
346 activeCallerSavesRegs = filter (callerSaves platform) activeRegs
347
348 foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []
349 foreignTargetRegs _ = activeCallerSavesRegs
350
351
352 -----------------------------------
353 -- mapping Expr in CmmNode
354
355 mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
356 mapForeignTarget exp (ForeignTarget e c) = ForeignTarget (exp e) c
357 mapForeignTarget _ m@(PrimTarget _) = m
358
359 -- Take a transformer on expressions and apply it recursively.
360 wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
361 wrapRecExp f (CmmMachOp op es) = f (CmmMachOp op $ map (wrapRecExp f) es)
362 wrapRecExp f (CmmLoad addr ty) = f (CmmLoad (wrapRecExp f addr) ty)
363 wrapRecExp f e = f e
364
365 mapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
366 mapExp _ f@(CmmEntry _) = f
367 mapExp _ m@(CmmComment _) = m
368 mapExp f (CmmAssign r e) = CmmAssign r (f e)
369 mapExp f (CmmStore addr e) = CmmStore (f addr) (f e)
370 mapExp f (CmmUnsafeForeignCall tgt fs as) = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as)
371 mapExp _ l@(CmmBranch _) = l
372 mapExp f (CmmCondBranch e ti fi) = CmmCondBranch (f e) ti fi
373 mapExp f (CmmSwitch e tbl) = CmmSwitch (f e) tbl
374 mapExp f n@CmmCall {cml_target=tgt} = n{cml_target = f tgt}
375 mapExp f (CmmForeignCall tgt fs as succ updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ updfr intrbl
376
377 mapExpDeep :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
378 mapExpDeep f = mapExp $ wrapRecExp f
379
380 ------------------------------------------------------------------------
381 -- mapping Expr in CmmNode, but not performing allocation if no changes
382
383 mapForeignTargetM :: (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget
384 mapForeignTargetM f (ForeignTarget e c) = (\x -> ForeignTarget x c) `fmap` f e
385 mapForeignTargetM _ (PrimTarget _) = Nothing
386
387 wrapRecExpM :: (CmmExpr -> Maybe CmmExpr) -> (CmmExpr -> Maybe CmmExpr)
388 wrapRecExpM f n@(CmmMachOp op es) = maybe (f n) (f . CmmMachOp op) (mapListM (wrapRecExpM f) es)
389 wrapRecExpM f n@(CmmLoad addr ty) = maybe (f n) (f . flip CmmLoad ty) (wrapRecExpM f addr)
390 wrapRecExpM f e = f e
391
392 mapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
393 mapExpM _ (CmmEntry _) = Nothing
394 mapExpM _ (CmmComment _) = Nothing
395 mapExpM f (CmmAssign r e) = CmmAssign r `fmap` f e
396 mapExpM f (CmmStore addr e) = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e]
397 mapExpM _ (CmmBranch _) = Nothing
398 mapExpM f (CmmCondBranch e ti fi) = (\x -> CmmCondBranch x ti fi) `fmap` f e
399 mapExpM f (CmmSwitch e tbl) = (\x -> CmmSwitch x tbl) `fmap` f e
400 mapExpM f (CmmCall tgt mb_id r o i s) = (\x -> CmmCall x mb_id r o i s) `fmap` f tgt
401 mapExpM f (CmmUnsafeForeignCall tgt fs as)
402 = case mapForeignTargetM f tgt of
403 Just tgt' -> Just (CmmUnsafeForeignCall tgt' fs (mapListJ f as))
404 Nothing -> (\xs -> CmmUnsafeForeignCall tgt fs xs) `fmap` mapListM f as
405 mapExpM f (CmmForeignCall tgt fs as succ updfr intrbl)
406 = case mapForeignTargetM f tgt of
407 Just tgt' -> Just (CmmForeignCall tgt' fs (mapListJ f as) succ updfr intrbl)
408 Nothing -> (\xs -> CmmForeignCall tgt fs xs succ updfr intrbl) `fmap` mapListM f as
409
410 -- share as much as possible
411 mapListM :: (a -> Maybe a) -> [a] -> Maybe [a]
412 mapListM f xs = let (b, r) = mapListT f xs
413 in if b then Just r else Nothing
414
415 mapListJ :: (a -> Maybe a) -> [a] -> [a]
416 mapListJ f xs = snd (mapListT f xs)
417
418 mapListT :: (a -> Maybe a) -> [a] -> (Bool, [a])
419 mapListT f xs = foldr g (False, []) (zip3 (tails xs) xs (map f xs))
420 where g (_, y, Nothing) (True, ys) = (True, y:ys)
421 g (_, _, Just y) (True, ys) = (True, y:ys)
422 g (ys', _, Nothing) (False, _) = (False, ys')
423 g (_, _, Just y) (False, ys) = (True, y:ys)
424
425 mapExpDeepM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
426 mapExpDeepM f = mapExpM $ wrapRecExpM f
427
428 -----------------------------------
429 -- folding Expr in CmmNode
430
431 foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
432 foldExpForeignTarget exp (ForeignTarget e _) z = exp e z
433 foldExpForeignTarget _ (PrimTarget _) z = z
434
435 -- Take a folder on expressions and apply it recursively.
436 wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
437 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
438 wrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)
439 wrapRecExpf f e z = f e z
440
441 foldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
442 foldExp _ (CmmEntry {}) z = z
443 foldExp _ (CmmComment {}) z = z
444 foldExp f (CmmAssign _ e) z = f e z
445 foldExp f (CmmStore addr e) z = f addr $ f e z
446 foldExp f (CmmUnsafeForeignCall t _ as) z = foldr f (foldExpForeignTarget f t z) as
447 foldExp _ (CmmBranch _) z = z
448 foldExp f (CmmCondBranch e _ _) z = f e z
449 foldExp f (CmmSwitch e _) z = f e z
450 foldExp f (CmmCall {cml_target=tgt}) z = f tgt z
451 foldExp f (CmmForeignCall {tgt=tgt, args=args}) z = foldr f (foldExpForeignTarget f tgt z) args
452
453 foldExpDeep :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
454 foldExpDeep f = foldExp (wrapRecExpf f)
455
456 -- -----------------------------------------------------------------------------
457
458 mapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C
459 mapSuccessors f (CmmBranch bid) = CmmBranch (f bid)
460 mapSuccessors f (CmmCondBranch p y n) = CmmCondBranch p (f y) (f n)
461 mapSuccessors f (CmmSwitch e arms) = CmmSwitch e (map (fmap f) arms)
462 mapSuccessors _ n = n
463