32afa1d07826c368bde3eb24474bcf92a2d25cf1
[ghc.git] / compiler / cmm / CmmOpt.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Cmm optimisation
4 --
5 -- (c) The University of Glasgow 2006
6 --
7 -----------------------------------------------------------------------------
8
9 module CmmOpt (
10 cmmMachOpFold,
11 cmmMachOpFoldM,
12 cmmLoopifyForC,
13 ) where
14
15 #include "HsVersions.h"
16
17 import OldCmm
18 import DynFlags
19 import CLabel
20
21 import FastTypes
22 import Outputable
23 import Platform
24
25 import Data.Bits
26 import Data.Maybe
27
28 -- -----------------------------------------------------------------------------
29 -- MachOp constant folder
30
31 -- Now, try to constant-fold the MachOps. The arguments have already
32 -- been optimized and folded.
33
34 cmmMachOpFold
35 :: DynFlags
36 -> MachOp -- The operation from an CmmMachOp
37 -> [CmmExpr] -- The optimized arguments
38 -> CmmExpr
39
40 cmmMachOpFold dflags op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM dflags op args)
41
42 -- Returns Nothing if no changes, useful for Hoopl, also reduces
43 -- allocation!
44 cmmMachOpFoldM
45 :: DynFlags
46 -> MachOp
47 -> [CmmExpr]
48 -> Maybe CmmExpr
49
50 cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
51 = Just $ case op of
52 MO_S_Neg _ -> CmmLit (CmmInt (-x) rep)
53 MO_Not _ -> CmmLit (CmmInt (complement x) rep)
54
55 -- these are interesting: we must first narrow to the
56 -- "from" type, in order to truncate to the correct size.
57 -- The final narrow/widen to the destination type
58 -- is implicit in the CmmLit.
59 MO_SF_Conv _from to -> CmmLit (CmmFloat (fromInteger x) to)
60 MO_SS_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
61 MO_UU_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
62
63 _ -> panic "cmmMachOpFoldM: unknown unary op"
64
65
66 -- Eliminate conversion NOPs
67 cmmMachOpFoldM _ (MO_SS_Conv rep1 rep2) [x] | rep1 == rep2 = Just x
68 cmmMachOpFoldM _ (MO_UU_Conv rep1 rep2) [x] | rep1 == rep2 = Just x
69
70 -- Eliminate nested conversions where possible
71 cmmMachOpFoldM dflags conv_outer [CmmMachOp conv_inner [x]]
72 | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
73 Just (_, rep3,signed2) <- isIntConversion conv_outer
74 = case () of
75 -- widen then narrow to the same size is a nop
76 _ | rep1 < rep2 && rep1 == rep3 -> Just x
77 -- Widen then narrow to different size: collapse to single conversion
78 -- but remember to use the signedness from the widening, just in case
79 -- the final conversion is a widen.
80 | rep1 < rep2 && rep2 > rep3 ->
81 Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]
82 -- Nested widenings: collapse if the signedness is the same
83 | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
84 Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]
85 -- Nested narrowings: collapse
86 | rep1 > rep2 && rep2 > rep3 ->
87 Just $ cmmMachOpFold dflags (MO_UU_Conv rep1 rep3) [x]
88 | otherwise ->
89 Nothing
90 where
91 isIntConversion (MO_UU_Conv rep1 rep2)
92 = Just (rep1,rep2,False)
93 isIntConversion (MO_SS_Conv rep1 rep2)
94 = Just (rep1,rep2,True)
95 isIntConversion _ = Nothing
96
97 intconv True = MO_SS_Conv
98 intconv False = MO_UU_Conv
99
100 -- ToDo: a narrow of a load can be collapsed into a narrow load, right?
101 -- but what if the architecture only supports word-sized loads, should
102 -- we do the transformation anyway?
103
104 cmmMachOpFoldM dflags mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
105 = case mop of
106 -- for comparisons: don't forget to narrow the arguments before
107 -- comparing, since they might be out of range.
108 MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth dflags))
109 MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth dflags))
110
111 MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth dflags))
112 MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth dflags))
113 MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth dflags))
114 MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth dflags))
115
116 MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth dflags))
117 MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth dflags))
118 MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth dflags))
119 MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth dflags))
120
121 MO_Add r -> Just $ CmmLit (CmmInt (x + y) r)
122 MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r)
123 MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r)
124 MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r)
125 MO_U_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem` y_u) r)
126 MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r)
127 MO_S_Rem r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r)
128
129 MO_And r -> Just $ CmmLit (CmmInt (x .&. y) r)
130 MO_Or r -> Just $ CmmLit (CmmInt (x .|. y) r)
131 MO_Xor r -> Just $ CmmLit (CmmInt (x `xor` y) r)
132
133 MO_Shl r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
134 MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
135 MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
136
137 _ -> Nothing
138
139 where
140 x_u = narrowU xrep x
141 y_u = narrowU xrep y
142 x_s = narrowS xrep x
143 y_s = narrowS xrep y
144
145
146 -- When possible, shift the constants to the right-hand side, so that we
147 -- can match for strength reductions. Note that the code generator will
148 -- also assume that constants have been shifted to the right when
149 -- possible.
150
151 cmmMachOpFoldM dflags op [x@(CmmLit _), y]
152 | not (isLit y) && isCommutableMachOp op
153 = Just (cmmMachOpFold dflags op [y, x])
154
155 -- Turn (a+b)+c into a+(b+c) where possible. Because literals are
156 -- moved to the right, it is more likely that we will find
157 -- opportunities for constant folding when the expression is
158 -- right-associated.
159 --
160 -- ToDo: this appears to introduce a quadratic behaviour due to the
161 -- nested cmmMachOpFold. Can we fix this?
162 --
163 -- Why do we check isLit arg1? If arg1 is a lit, it means that arg2
164 -- is also a lit (otherwise arg1 would be on the right). If we
165 -- put arg1 on the left of the rearranged expression, we'll get into a
166 -- loop: (x1+x2)+x3 => x1+(x2+x3) => (x2+x3)+x1 => x2+(x3+x1) ...
167 --
168 -- Also don't do it if arg1 is PicBaseReg, so that we don't separate the
169 -- PicBaseReg from the corresponding label (or label difference).
170 --
171 cmmMachOpFoldM dflags mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
172 | mop2 `associates_with` mop1
173 && not (isLit arg1) && not (isPicReg arg1)
174 = Just (cmmMachOpFold dflags mop2 [arg1, cmmMachOpFold dflags mop1 [arg2,arg3]])
175 where
176 MO_Add{} `associates_with` MO_Sub{} = True
177 mop1 `associates_with` mop2 =
178 mop1 == mop2 && isAssociativeMachOp mop1
179
180 -- special case: (a - b) + c ==> a + (c - b)
181 cmmMachOpFoldM dflags mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]
182 | not (isLit arg1) && not (isPicReg arg1)
183 = Just (cmmMachOpFold dflags mop1 [arg1, cmmMachOpFold dflags mop2 [arg3,arg2]])
184
185 -- Make a RegOff if we can
186 cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
187 = Just $ CmmRegOff reg (fromIntegral (narrowS rep n))
188 cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
189 = Just $ CmmRegOff reg (off + fromIntegral (narrowS rep n))
190 cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
191 = Just $ CmmRegOff reg (- fromIntegral (narrowS rep n))
192 cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
193 = Just $ CmmRegOff reg (off - fromIntegral (narrowS rep n))
194
195 -- Fold label(+/-)offset into a CmmLit where possible
196
197 cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
198 = Just $ CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
199 cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
200 = Just $ CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
201 cmmMachOpFoldM _ (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
202 = Just $ CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
203
204
205 -- Comparison of literal with widened operand: perform the comparison
206 -- at the smaller width, as long as the literal is within range.
207
208 -- We can't do the reverse trick, when the operand is narrowed:
209 -- narrowing throws away bits from the operand, there's no way to do
210 -- the same comparison at the larger size.
211
212 cmmMachOpFoldM dflags cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
213 | -- powerPC NCG has a TODO for I8/I16 comparisons, so don't try
214 platformArch (targetPlatform dflags) `elem` [ArchX86, ArchX86_64],
215 -- if the operand is widened:
216 Just (rep, signed, narrow_fn) <- maybe_conversion conv,
217 -- and this is a comparison operation:
218 Just narrow_cmp <- maybe_comparison cmp rep signed,
219 -- and the literal fits in the smaller size:
220 i == narrow_fn rep i
221 -- then we can do the comparison at the smaller size
222 = Just (cmmMachOpFold dflags narrow_cmp [x, CmmLit (CmmInt i rep)])
223 where
224 maybe_conversion (MO_UU_Conv from to)
225 | to > from
226 = Just (from, False, narrowU)
227 maybe_conversion (MO_SS_Conv from to)
228 | to > from
229 = Just (from, True, narrowS)
230
231 -- don't attempt to apply this optimisation when the source
232 -- is a float; see #1916
233 maybe_conversion _ = Nothing
234
235 -- careful (#2080): if the original comparison was signed, but
236 -- we were doing an unsigned widen, then we must do an
237 -- unsigned comparison at the smaller size.
238 maybe_comparison (MO_U_Gt _) rep _ = Just (MO_U_Gt rep)
239 maybe_comparison (MO_U_Ge _) rep _ = Just (MO_U_Ge rep)
240 maybe_comparison (MO_U_Lt _) rep _ = Just (MO_U_Lt rep)
241 maybe_comparison (MO_U_Le _) rep _ = Just (MO_U_Le rep)
242 maybe_comparison (MO_Eq _) rep _ = Just (MO_Eq rep)
243 maybe_comparison (MO_S_Gt _) rep True = Just (MO_S_Gt rep)
244 maybe_comparison (MO_S_Ge _) rep True = Just (MO_S_Ge rep)
245 maybe_comparison (MO_S_Lt _) rep True = Just (MO_S_Lt rep)
246 maybe_comparison (MO_S_Le _) rep True = Just (MO_S_Le rep)
247 maybe_comparison (MO_S_Gt _) rep False = Just (MO_U_Gt rep)
248 maybe_comparison (MO_S_Ge _) rep False = Just (MO_U_Ge rep)
249 maybe_comparison (MO_S_Lt _) rep False = Just (MO_U_Lt rep)
250 maybe_comparison (MO_S_Le _) rep False = Just (MO_U_Le rep)
251 maybe_comparison _ _ _ = Nothing
252
253 -- We can often do something with constants of 0 and 1 ...
254
255 cmmMachOpFoldM dflags mop [x, y@(CmmLit (CmmInt 0 _))]
256 = case mop of
257 MO_Add _ -> Just x
258 MO_Sub _ -> Just x
259 MO_Mul _ -> Just y
260 MO_And _ -> Just y
261 MO_Or _ -> Just x
262 MO_Xor _ -> Just x
263 MO_Shl _ -> Just x
264 MO_S_Shr _ -> Just x
265 MO_U_Shr _ -> Just x
266 MO_Ne _ | isComparisonExpr x -> Just x
267 MO_Eq _ | Just x' <- maybeInvertCmmExpr x -> Just x'
268 MO_U_Gt _ | isComparisonExpr x -> Just x
269 MO_S_Gt _ | isComparisonExpr x -> Just x
270 MO_U_Lt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
271 MO_S_Lt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
272 MO_U_Ge _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
273 MO_S_Ge _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
274 MO_U_Le _ | Just x' <- maybeInvertCmmExpr x -> Just x'
275 MO_S_Le _ | Just x' <- maybeInvertCmmExpr x -> Just x'
276 _ -> Nothing
277
278 cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt 1 rep))]
279 = case mop of
280 MO_Mul _ -> Just x
281 MO_S_Quot _ -> Just x
282 MO_U_Quot _ -> Just x
283 MO_S_Rem _ -> Just $ CmmLit (CmmInt 0 rep)
284 MO_U_Rem _ -> Just $ CmmLit (CmmInt 0 rep)
285 MO_Ne _ | Just x' <- maybeInvertCmmExpr x -> Just x'
286 MO_Eq _ | isComparisonExpr x -> Just x
287 MO_U_Lt _ | Just x' <- maybeInvertCmmExpr x -> Just x'
288 MO_S_Lt _ | Just x' <- maybeInvertCmmExpr x -> Just x'
289 MO_U_Gt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
290 MO_S_Gt _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
291 MO_U_Le _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
292 MO_S_Le _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
293 MO_U_Ge _ | isComparisonExpr x -> Just x
294 MO_S_Ge _ | isComparisonExpr x -> Just x
295 _ -> Nothing
296
297 -- Now look for multiplication/division by powers of 2 (integers).
298
299 cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt n _))]
300 = case mop of
301 MO_Mul rep
302 | Just p <- exactLog2 n ->
303 Just (cmmMachOpFold dflags (MO_Shl rep) [x, CmmLit (CmmInt p rep)])
304 MO_U_Quot rep
305 | Just p <- exactLog2 n ->
306 Just (cmmMachOpFold dflags (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)])
307 MO_S_Quot rep
308 | Just p <- exactLog2 n,
309 CmmReg _ <- x -> -- We duplicate x below, hence require
310 -- it is a reg. FIXME: remove this restriction.
311 -- shift right is not the same as quot, because it rounds
312 -- to minus infinity, whereasq quot rounds toward zero.
313 -- To fix this up, we add one less than the divisor to the
314 -- dividend if it is a negative number.
315 --
316 -- to avoid a test/jump, we use the following sequence:
317 -- x1 = x >> word_size-1 (all 1s if -ve, all 0s if +ve)
318 -- x2 = y & (divisor-1)
319 -- result = (x+x2) >>= log2(divisor)
320 -- this could be done a bit more simply using conditional moves,
321 -- but we're processor independent here.
322 --
323 -- we optimise the divide by 2 case slightly, generating
324 -- x1 = x >> word_size-1 (unsigned)
325 -- return = (x + x1) >>= log2(divisor)
326 let
327 bits = fromIntegral (widthInBits rep) - 1
328 shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
329 x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
330 x2 = if p == 1 then x1 else
331 CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
332 x3 = CmmMachOp (MO_Add rep) [x, x2]
333 in
334 Just (cmmMachOpFold dflags (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)])
335 _ -> Nothing
336
337 -- ToDo (#7116): optimise floating-point multiplication, e.g. x*2.0 -> x+x
338 -- Unfortunately this needs a unique supply because x might not be a
339 -- register. See #2253 (program 6) for an example.
340
341
342 -- Anything else is just too hard.
343
344 cmmMachOpFoldM _ _ _ = Nothing
345
346 -- -----------------------------------------------------------------------------
347 -- exactLog2
348
349 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
350 -- from GCC. It requires bit manipulation primitives, and we use GHC
351 -- extensions. Tough.
352 --
353 -- Used to be in MachInstrs --SDM.
354 -- ToDo: remove use of unboxery --SDM.
355
356 -- Unboxery removed in favor of FastInt; but is the function supposed to fail
357 -- on inputs >= 2147483648, or was that just an implementation artifact?
358 -- And is this speed-critical, or can we just use Integer operations
359 -- (including Data.Bits)?
360 -- --Isaac Dupree
361
362 exactLog2 :: Integer -> Maybe Integer
363 exactLog2 x_
364 = if (x_ <= 0 || x_ >= 2147483648) then
365 Nothing
366 else
367 case iUnbox (fromInteger x_) of { x ->
368 if (x `bitAndFastInt` negateFastInt x) /=# x then
369 Nothing
370 else
371 Just (toInteger (iBox (pow2 x)))
372 }
373 where
374 pow2 x | x ==# _ILIT(1) = _ILIT(0)
375 | otherwise = _ILIT(1) +# pow2 (x `shiftR_FastInt` _ILIT(1))
376
377
378 -- -----------------------------------------------------------------------------
379 -- Loopify for C
380
381 {-
382 This is a simple pass that replaces tail-recursive functions like this:
383
384 fac() {
385 ...
386 jump fac();
387 }
388
389 with this:
390
391 fac() {
392 L:
393 ...
394 goto L;
395 }
396
397 the latter generates better C code, because the C compiler treats it
398 like a loop, and brings full loop optimisation to bear.
399
400 In my measurements this makes little or no difference to anything
401 except factorial, but what the hell.
402 -}
403
404 cmmLoopifyForC :: DynFlags -> RawCmmDecl -> RawCmmDecl
405 -- XXX: revisit if we actually want to do this
406 -- cmmLoopifyForC p@(CmmProc Nothing _ _) = p -- only if there's an info table, ignore case alts
407 cmmLoopifyForC dflags (CmmProc infos entry_lbl
408 (ListGraph blocks@(BasicBlock top_id _ : _))) =
409 -- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
410 CmmProc infos entry_lbl (ListGraph blocks')
411 where blocks' = [ BasicBlock id (map do_stmt stmts)
412 | BasicBlock id stmts <- blocks ]
413
414 do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
415 = CmmBranch top_id
416 do_stmt stmt = stmt
417
418 jump_lbl | tablesNextToCode dflags = toInfoLbl entry_lbl
419 | otherwise = entry_lbl
420
421 cmmLoopifyForC _ top = top
422
423 -- -----------------------------------------------------------------------------
424 -- Utils
425
426 isLit :: CmmExpr -> Bool
427 isLit (CmmLit _) = True
428 isLit _ = False
429
430 isComparisonExpr :: CmmExpr -> Bool
431 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
432 isComparisonExpr _ = False
433
434 isPicReg :: CmmExpr -> Bool
435 isPicReg (CmmReg (CmmGlobal PicBaseReg)) = True
436 isPicReg _ = False
437