1 -----------------------------------------------------------------------------
5 -- (c) The University of Glasgow 2006
7 -----------------------------------------------------------------------------
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
22 #include "HsVersions.h"
41 -- -----------------------------------------------------------------------------
45 This pass inlines assignments to temporaries that are used just
46 once. It works as follows:
48 - count uses of each temporary
49 - for each temporary that occurs just once:
50 - attempt to push it forward to the statement that uses it
51 - only push forward past assignments to other temporaries
52 (assumes that temporaries are single-assignment)
53 - if we reach the statement that uses it, inline the rhs
54 and delete the original assignment.
56 [N.B. In the Quick C-- compiler, this optimization is achieved by a
57 combination of two dataflow passes: forward substitution (peephole
58 optimization) and dead-assignment elimination. ---NR]
60 Possible generalisations: here is an example from factorial
65 if (_smi != 0) goto cmK;
74 We want to inline _smi and _smn. To inline _smn:
76 - we must be able to push forward past assignments to global regs.
77 We can do this if the rhs of the assignment we are pushing
78 forward doesn't refer to the global reg being assigned to; easy
83 - It is a trivial replacement, reg for reg, but it occurs more than
85 - We can inline trivial assignments even if the temporary occurs
86 more than once, as long as we don't eliminate the original assignment
87 (this doesn't help much on its own).
88 - We need to be able to propagate the assignment forward through jumps;
89 if we did this, we would find that it can be inlined safely in all
93 countUses :: UserOfLocalRegs a => a -> UniqFM Int
94 countUses a = foldRegsUsed (\m r -> addToUFM m r (count m r + 1)) emptyUFM a
95 where count m r = lookupWithDefaultUFM m (0::Int) r
97 cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
98 cmmMiniInline blocks = map do_inline blocks
99 where do_inline (BasicBlock id stmts)
100 = BasicBlock id (cmmMiniInlineStmts (countUses blocks) stmts)
102 cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
103 cmmMiniInlineStmts uses [] = []
104 cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _ _)) expr) : stmts)
105 | Just 1 <- lookupUFM uses u,
106 Just stmts' <- lookForInline u expr stmts
109 trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
111 cmmMiniInlineStmts uses stmts'
113 cmmMiniInlineStmts uses (stmt:stmts)
114 = stmt : cmmMiniInlineStmts uses stmts
117 -- Try to inline a temporary assignment. We can skip over assignments to
118 -- other tempoararies, because we know that expressions aren't side-effecting
119 -- and temporaries are single-assignment.
120 lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _ _)) rhs) : rest)
122 = case lookupUFM (countUses rhs) u of
123 Just 1 -> Just (inlineStmt u expr stmt : rest)
124 _other -> case lookForInline u expr rest of
126 Just stmts -> Just (stmt:stmts)
128 lookForInline u expr (CmmNop : rest)
129 = lookForInline u expr rest
131 lookForInline _ _ [] = Nothing
133 lookForInline u expr (stmt:stmts)
134 = case lookupUFM (countUses stmt) u of
135 Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
138 -- we don't inline into CmmCall if the expression refers to global
139 -- registers. This is a HACK to avoid global registers clashing with
140 -- C argument-passing registers, really the back-end ought to be able
141 -- to handle it properly, but currently neither PprC nor the NCG can
142 -- do it. See also CgForeignCall:load_args_into_temps.
143 ok_to_inline = case stmt of
144 CmmCall{} -> hasNoGlobalRegs expr
147 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
148 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
149 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
150 inlineStmt u a (CmmCall target regs es srt ret)
151 = CmmCall (infn target) regs es' srt ret
152 where infn (CmmCallee fn cconv) = CmmCallee fn cconv
153 infn (CmmPrim p) = CmmPrim p
154 es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
155 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
156 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
157 inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
158 inlineStmt u a other_stmt = other_stmt
160 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
161 inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _ _)))
164 inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep _)) off)
165 | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
167 inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
168 inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
169 inlineExpr u a other_expr = other_expr
171 -- -----------------------------------------------------------------------------
172 -- MachOp constant folder
174 -- Now, try to constant-fold the MachOps. The arguments have already
175 -- been optimized and folded.
178 :: MachOp -- The operation from an CmmMachOp
179 -> [CmmExpr] -- The optimized arguments
182 cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
184 MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
185 MO_Not r -> CmmLit (CmmInt (complement x) rep)
187 -- these are interesting: we must first narrow to the
188 -- "from" type, in order to truncate to the correct size.
189 -- The final narrow/widen to the destination type
190 -- is implicit in the CmmLit.
192 | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
193 | otherwise -> CmmLit (CmmInt (narrowS from x) to)
194 MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
196 _ -> panic "cmmMachOpFold: unknown unary op"
199 -- Eliminate conversion NOPs
200 cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
201 cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
203 -- Eliminate nested conversions where possible
204 cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
205 | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
206 Just (_, rep3,signed2) <- isIntConversion conv_outer
208 -- widen then narrow to the same size is a nop
209 _ | rep1 < rep2 && rep1 == rep3 -> x
210 -- Widen then narrow to different size: collapse to single conversion
211 -- but remember to use the signedness from the widening, just in case
212 -- the final conversion is a widen.
213 | rep1 < rep2 && rep2 > rep3 ->
214 cmmMachOpFold (intconv signed1 rep1 rep3) [x]
215 -- Nested widenings: collapse if the signedness is the same
216 | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
217 cmmMachOpFold (intconv signed1 rep1 rep3) [x]
218 -- Nested narrowings: collapse
219 | rep1 > rep2 && rep2 > rep3 ->
220 cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
222 CmmMachOp conv_outer args
224 isIntConversion (MO_U_Conv rep1 rep2)
225 | not (isFloatingRep rep1) && not (isFloatingRep rep2)
226 = Just (rep1,rep2,False)
227 isIntConversion (MO_S_Conv rep1 rep2)
228 | not (isFloatingRep rep1) && not (isFloatingRep rep2)
229 = Just (rep1,rep2,True)
230 isIntConversion _ = Nothing
232 intconv True = MO_S_Conv
233 intconv False = MO_U_Conv
235 -- ToDo: a narrow of a load can be collapsed into a narrow load, right?
236 -- but what if the architecture only supports word-sized loads, should
237 -- we do the transformation anyway?
239 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
241 -- for comparisons: don't forget to narrow the arguments before
242 -- comparing, since they might be out of range.
243 MO_Eq r -> CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordRep)
244 MO_Ne r -> CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordRep)
246 MO_U_Gt r -> CmmLit (CmmInt (if x_u > y_u then 1 else 0) wordRep)
247 MO_U_Ge r -> CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordRep)
248 MO_U_Lt r -> CmmLit (CmmInt (if x_u < y_u then 1 else 0) wordRep)
249 MO_U_Le r -> CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordRep)
251 MO_S_Gt r -> CmmLit (CmmInt (if x_s > y_s then 1 else 0) wordRep)
252 MO_S_Ge r -> CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordRep)
253 MO_S_Lt r -> CmmLit (CmmInt (if x_s < y_s then 1 else 0) wordRep)
254 MO_S_Le r -> CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordRep)
256 MO_Add r -> CmmLit (CmmInt (x + y) r)
257 MO_Sub r -> CmmLit (CmmInt (x - y) r)
258 MO_Mul r -> CmmLit (CmmInt (x * y) r)
259 MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
260 MO_S_Rem r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
262 MO_And r -> CmmLit (CmmInt (x .&. y) r)
263 MO_Or r -> CmmLit (CmmInt (x .|. y) r)
264 MO_Xor r -> CmmLit (CmmInt (x `xor` y) r)
266 MO_Shl r -> CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
267 MO_U_Shr r -> CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
268 MO_S_Shr r -> CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
270 other -> CmmMachOp mop args
279 -- When possible, shift the constants to the right-hand side, so that we
280 -- can match for strength reductions. Note that the code generator will
281 -- also assume that constants have been shifted to the right when
284 cmmMachOpFold op [x@(CmmLit _), y]
285 | not (isLit y) && isCommutableMachOp op
286 = cmmMachOpFold op [y, x]
288 -- Turn (a+b)+c into a+(b+c) where possible. Because literals are
289 -- moved to the right, it is more likely that we will find
290 -- opportunities for constant folding when the expression is
293 -- ToDo: this appears to introduce a quadratic behaviour due to the
294 -- nested cmmMachOpFold. Can we fix this?
296 -- Why do we check isLit arg1? If arg1 is a lit, it means that arg2
297 -- is also a lit (otherwise arg1 would be on the right). If we
298 -- put arg1 on the left of the rearranged expression, we'll get into a
299 -- loop: (x1+x2)+x3 => x1+(x2+x3) => (x2+x3)+x1 => x2+(x3+x1) ...
301 -- Also don't do it if arg1 is PicBaseReg, so that we don't separate the
302 -- PicBaseReg from the corresponding label (or label difference).
304 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
305 | mop1 == mop2 && isAssociativeMachOp mop1
306 && not (isLit arg1) && not (isPicReg arg1)
307 = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
309 -- Make a RegOff if we can
310 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
311 = CmmRegOff reg (fromIntegral (narrowS rep n))
312 cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
313 = CmmRegOff reg (off + fromIntegral (narrowS rep n))
314 cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
315 = CmmRegOff reg (- fromIntegral (narrowS rep n))
316 cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
317 = CmmRegOff reg (off - fromIntegral (narrowS rep n))
319 -- Fold label(+/-)offset into a CmmLit where possible
321 cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
322 = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
323 cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
324 = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
325 cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
326 = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
329 -- Comparison of literal with narrowed/widened operand: perform
330 -- the comparison at a different width, as long as the literal is
333 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
334 -- powerPC NCG has a TODO for I8/I16 comparisons, so don't try
336 cmmMachOpFold cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
337 | Just (rep, narrow) <- maybe_conversion conv,
338 Just narrow_cmp <- maybe_comparison cmp rep,
339 let narrow_i = narrow rep i,
341 = cmmMachOpFold narrow_cmp [x, CmmLit (CmmInt narrow_i rep)]
343 maybe_conversion (MO_U_Conv from _) = Just (from, narrowU)
344 maybe_conversion (MO_S_Conv from _) = Just (from, narrowS)
345 maybe_conversion _ = Nothing
347 maybe_comparison (MO_U_Gt _) rep = Just (MO_U_Gt rep)
348 maybe_comparison (MO_U_Ge _) rep = Just (MO_U_Ge rep)
349 maybe_comparison (MO_U_Lt _) rep = Just (MO_U_Lt rep)
350 maybe_comparison (MO_U_Le _) rep = Just (MO_U_Le rep)
351 maybe_comparison (MO_S_Gt _) rep = Just (MO_S_Gt rep)
352 maybe_comparison (MO_S_Ge _) rep = Just (MO_S_Ge rep)
353 maybe_comparison (MO_S_Lt _) rep = Just (MO_S_Lt rep)
354 maybe_comparison (MO_S_Le _) rep = Just (MO_S_Le rep)
355 maybe_comparison (MO_Eq _) rep = Just (MO_Eq rep)
356 maybe_comparison _ _ = Nothing
360 -- We can often do something with constants of 0 and 1 ...
362 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
373 MO_Ne r | isComparisonExpr x -> x
374 MO_Eq r | Just x' <- maybeInvertCmmExpr x -> x'
375 MO_U_Gt r | isComparisonExpr x -> x
376 MO_S_Gt r | isComparisonExpr x -> x
377 MO_U_Lt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
378 MO_S_Lt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
379 MO_U_Ge r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
380 MO_S_Ge r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
381 MO_U_Le r | Just x' <- maybeInvertCmmExpr x -> x'
382 MO_S_Le r | Just x' <- maybeInvertCmmExpr x -> x'
383 other -> CmmMachOp mop args
385 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
390 MO_S_Rem r -> CmmLit (CmmInt 0 rep)
391 MO_U_Rem r -> CmmLit (CmmInt 0 rep)
392 MO_Ne r | Just x' <- maybeInvertCmmExpr x -> x'
393 MO_Eq r | isComparisonExpr x -> x
394 MO_U_Lt r | Just x' <- maybeInvertCmmExpr x -> x'
395 MO_S_Lt r | Just x' <- maybeInvertCmmExpr x -> x'
396 MO_U_Gt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
397 MO_S_Gt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
398 MO_U_Le r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
399 MO_S_Le r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
400 MO_U_Ge r | isComparisonExpr x -> x
401 MO_S_Ge r | isComparisonExpr x -> x
402 other -> CmmMachOp mop args
404 -- Now look for multiplication/division by powers of 2 (integers).
406 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
409 | Just p <- exactLog2 n ->
410 CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
412 | Just p <- exactLog2 n,
413 CmmReg _ <- x -> -- We duplicate x below, hence require
414 -- it is a reg. FIXME: remove this restriction.
415 -- shift right is not the same as quot, because it rounds
416 -- to minus infinity, whereasq uot rounds toward zero.
417 -- To fix this up, we add one less than the divisor to the
418 -- dividend if it is a negative number.
420 -- to avoid a test/jump, we use the following sequence:
421 -- x1 = x >> word_size-1 (all 1s if -ve, all 0s if +ve)
422 -- x2 = y & (divisor-1)
423 -- result = (x+x2) >>= log2(divisor)
424 -- this could be done a bit more simply using conditional moves,
425 -- but we're processor independent here.
427 -- we optimise the divide by 2 case slightly, generating
428 -- x1 = x >> word_size-1 (unsigned)
429 -- return = (x + x1) >>= log2(divisor)
431 bits = fromIntegral (machRepBitWidth rep) - 1
432 shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
433 x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
434 x2 = if p == 1 then x1 else
435 CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
436 x3 = CmmMachOp (MO_Add rep) [x, x2]
438 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
442 unchanged = CmmMachOp mop args
444 -- Anything else is just too hard.
446 cmmMachOpFold mop args = CmmMachOp mop args
448 -- -----------------------------------------------------------------------------
451 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
452 -- from GCC. It requires bit manipulation primitives, and we use GHC
453 -- extensions. Tough.
455 -- Used to be in MachInstrs --SDM.
456 -- ToDo: remove use of unboxery --SDM.
461 exactLog2 :: Integer -> Maybe Integer
463 = if (x <= 0 || x >= 2147483648) then
466 case fromInteger x of { I# x# ->
467 if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
470 Just (toInteger (I# (pow2 x#)))
473 pow2 x# | x# ==# 1# = 0#
474 | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
477 -- -----------------------------------------------------------------------------
478 -- widening / narrowing
480 narrowU :: MachRep -> Integer -> Integer
481 narrowU I8 x = fromIntegral (fromIntegral x :: Word8)
482 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
483 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
484 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
485 narrowU _ _ = panic "narrowTo"
487 narrowS :: MachRep -> Integer -> Integer
488 narrowS I8 x = fromIntegral (fromIntegral x :: Int8)
489 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
490 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
491 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
492 narrowS _ _ = panic "narrowTo"
494 -- -----------------------------------------------------------------------------
498 This is a simple pass that replaces tail-recursive functions like this:
513 the latter generates better C code, because the C compiler treats it
514 like a loop, and brings full loop optimisation to bear.
516 In my measurements this makes little or no difference to anything
517 except factorial, but what the hell.
520 cmmLoopifyForC :: RawCmmTop -> RawCmmTop
521 cmmLoopifyForC p@(CmmProc info entry_lbl [] (ListGraph blocks@(BasicBlock top_id _ : _)))
522 | null info = p -- only if there's an info table, ignore case alts
524 -- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
525 CmmProc info entry_lbl [] (ListGraph blocks')
526 where blocks' = [ BasicBlock id (map do_stmt stmts)
527 | BasicBlock id stmts <- blocks ]
529 do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
533 jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
534 | otherwise = entry_lbl
536 cmmLoopifyForC top = top
538 -- -----------------------------------------------------------------------------
541 isLit (CmmLit _) = True
544 isComparisonExpr :: CmmExpr -> Bool
545 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
546 isComparisonExpr _other = False
548 isPicReg (CmmReg (CmmGlobal PicBaseReg)) = True
551 _unused :: FS.FastString -- stops a warning