1 -----------------------------------------------------------------------------
5 -- (c) The University of Glasgow 2006
7 -----------------------------------------------------------------------------
15 #include "HsVersions.h"
34 -- -----------------------------------------------------------------------------
38 This pass inlines assignments to temporaries that are used just
39 once. It works as follows:
41 - count uses of each temporary
42 - for each temporary that occurs just once:
43 - attempt to push it forward to the statement that uses it
44 - only push forward past assignments to other temporaries
45 (assumes that temporaries are single-assignment)
46 - if we reach the statement that uses it, inline the rhs
47 and delete the original assignment.
49 Possible generalisations: here is an example from factorial
54 if (_smi != 0) goto cmK;
63 We want to inline _smi and _smn. To inline _smn:
65 - we must be able to push forward past assignments to global regs.
66 We can do this if the rhs of the assignment we are pushing
67 forward doesn't refer to the global reg being assigned to; easy
72 - It is a trivial replacement, reg for reg, but it occurs more than
74 - We can inline trivial assignments even if the temporary occurs
75 more than once, as long as we don't eliminate the original assignment
76 (this doesn't help much on its own).
77 - We need to be able to propagate the assignment forward through jumps;
78 if we did this, we would find that it can be inlined safely in all
82 cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
83 cmmMiniInline blocks = map do_inline blocks
85 blockUses (BasicBlock _ stmts)
86 = foldr (plusUFM_C (+)) emptyUFM (map getStmtUses stmts)
88 uses = foldr (plusUFM_C (+)) emptyUFM (map blockUses blocks)
90 do_inline (BasicBlock id stmts)
91 = BasicBlock id (cmmMiniInlineStmts uses stmts)
94 cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
95 cmmMiniInlineStmts uses [] = []
96 cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
97 | Just 1 <- lookupUFM uses u,
98 Just stmts' <- lookForInline u expr stmts
101 trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
103 cmmMiniInlineStmts uses stmts'
105 cmmMiniInlineStmts uses (stmt:stmts)
106 = stmt : cmmMiniInlineStmts uses stmts
109 -- Try to inline a temporary assignment. We can skip over assignments to
110 -- other tempoararies, because we know that expressions aren't side-effecting
111 -- and temporaries are single-assignment.
112 lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
114 = case lookupUFM (getExprUses rhs) u of
115 Just 1 -> Just (inlineStmt u expr stmt : rest)
116 _other -> case lookForInline u expr rest of
118 Just stmts -> Just (stmt:stmts)
120 lookForInline u expr (CmmNop : rest)
121 = lookForInline u expr rest
123 lookForInline u expr (stmt:stmts)
124 = case lookupUFM (getStmtUses stmt) u of
125 Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
128 -- we don't inline into CmmCall if the expression refers to global
129 -- registers. This is a HACK to avoid global registers clashing with
130 -- C argument-passing registers, really the back-end ought to be able
131 -- to handle it properly, but currently neither PprC nor the NCG can
132 -- do it. See also CgForeignCall:load_args_into_temps.
133 ok_to_inline = case stmt of
134 CmmCall{} -> hasNoGlobalRegs expr
137 -- -----------------------------------------------------------------------------
138 -- Boring Cmm traversals for collecting usage info and substitutions.
140 getStmtUses :: CmmStmt -> UniqFM Int
141 getStmtUses (CmmAssign _ e) = getExprUses e
142 getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
143 getStmtUses (CmmCall target _ es _)
144 = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
145 where uses (CmmForeignCall e _) = getExprUses e
147 getStmtUses (CmmCondBranch e _) = getExprUses e
148 getStmtUses (CmmSwitch e _) = getExprUses e
149 getStmtUses (CmmJump e _) = getExprUses e
150 getStmtUses _ = emptyUFM
152 getExprUses :: CmmExpr -> UniqFM Int
153 getExprUses (CmmReg (CmmLocal (LocalReg u _))) = unitUFM u 1
154 getExprUses (CmmRegOff (CmmLocal (LocalReg u _)) _) = unitUFM u 1
155 getExprUses (CmmLoad e _) = getExprUses e
156 getExprUses (CmmMachOp _ es) = getExprsUses es
157 getExprUses _other = emptyUFM
159 getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
161 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
162 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
163 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
164 inlineStmt u a (CmmCall target regs es vols)
165 = CmmCall (infn target) regs es' vols
166 where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
167 infn (CmmPrim p) = CmmPrim p
168 es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
169 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
170 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
171 inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
172 inlineStmt u a other_stmt = other_stmt
174 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
175 inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
178 inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
179 | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
181 inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
182 inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
183 inlineExpr u a other_expr = other_expr
185 -- -----------------------------------------------------------------------------
186 -- MachOp constant folder
188 -- Now, try to constant-fold the MachOps. The arguments have already
189 -- been optimized and folded.
192 :: MachOp -- The operation from an CmmMachOp
193 -> [CmmExpr] -- The optimized arguments
196 cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
198 MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
199 MO_Not r -> CmmLit (CmmInt (complement x) rep)
201 -- these are interesting: we must first narrow to the
202 -- "from" type, in order to truncate to the correct size.
203 -- The final narrow/widen to the destination type
204 -- is implicit in the CmmLit.
206 | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
207 | otherwise -> CmmLit (CmmInt (narrowS from x) to)
208 MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
210 _ -> panic "cmmMachOpFold: unknown unary op"
213 -- Eliminate conversion NOPs
214 cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
215 cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
217 -- Eliminate nested conversions where possible
218 cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
219 | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
220 Just (_, rep3,signed2) <- isIntConversion conv_outer
222 -- widen then narrow to the same size is a nop
223 _ | rep1 < rep2 && rep1 == rep3 -> x
224 -- Widen then narrow to different size: collapse to single conversion
225 -- but remember to use the signedness from the widening, just in case
226 -- the final conversion is a widen.
227 | rep1 < rep2 && rep2 > rep3 ->
228 cmmMachOpFold (intconv signed1 rep1 rep3) [x]
229 -- Nested widenings: collapse if the signedness is the same
230 | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
231 cmmMachOpFold (intconv signed1 rep1 rep3) [x]
232 -- Nested narrowings: collapse
233 | rep1 > rep2 && rep2 > rep3 ->
234 cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
236 CmmMachOp conv_outer args
238 isIntConversion (MO_U_Conv rep1 rep2)
239 | not (isFloatingRep rep1) && not (isFloatingRep rep2)
240 = Just (rep1,rep2,False)
241 isIntConversion (MO_S_Conv rep1 rep2)
242 | not (isFloatingRep rep1) && not (isFloatingRep rep2)
243 = Just (rep1,rep2,True)
244 isIntConversion _ = Nothing
246 intconv True = MO_S_Conv
247 intconv False = MO_U_Conv
249 -- ToDo: a narrow of a load can be collapsed into a narrow load, right?
250 -- but what if the architecture only supports word-sized loads, should
251 -- we do the transformation anyway?
253 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
255 -- for comparisons: don't forget to narrow the arguments before
256 -- comparing, since they might be out of range.
257 MO_Eq r -> CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordRep)
258 MO_Ne r -> CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordRep)
260 MO_U_Gt r -> CmmLit (CmmInt (if x_u > y_u then 1 else 0) wordRep)
261 MO_U_Ge r -> CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordRep)
262 MO_U_Lt r -> CmmLit (CmmInt (if x_u < y_u then 1 else 0) wordRep)
263 MO_U_Le r -> CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordRep)
265 MO_S_Gt r -> CmmLit (CmmInt (if x_s > y_s then 1 else 0) wordRep)
266 MO_S_Ge r -> CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordRep)
267 MO_S_Lt r -> CmmLit (CmmInt (if x_s < y_s then 1 else 0) wordRep)
268 MO_S_Le r -> CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordRep)
270 MO_Add r -> CmmLit (CmmInt (x + y) r)
271 MO_Sub r -> CmmLit (CmmInt (x - y) r)
272 MO_Mul r -> CmmLit (CmmInt (x * y) r)
273 MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
274 MO_S_Rem r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
276 MO_And r -> CmmLit (CmmInt (x .&. y) r)
277 MO_Or r -> CmmLit (CmmInt (x .|. y) r)
278 MO_Xor r -> CmmLit (CmmInt (x `xor` y) r)
280 MO_Shl r -> CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
281 MO_U_Shr r -> CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
282 MO_S_Shr r -> CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
284 other -> CmmMachOp mop args
293 -- When possible, shift the constants to the right-hand side, so that we
294 -- can match for strength reductions. Note that the code generator will
295 -- also assume that constants have been shifted to the right when
298 cmmMachOpFold op [x@(CmmLit _), y]
299 | not (isLit y) && isCommutableMachOp op
300 = cmmMachOpFold op [y, x]
302 -- Turn (a+b)+c into a+(b+c) where possible. Because literals are
303 -- moved to the right, it is more likely that we will find
304 -- opportunities for constant folding when the expression is
307 -- ToDo: this appears to introduce a quadratic behaviour due to the
308 -- nested cmmMachOpFold. Can we fix this?
310 -- Why do we check isLit arg1? If arg1 is a lit, it means that arg2
311 -- is also a lit (otherwise arg1 would be on the right). If we
312 -- put arg1 on the left of the rearranged expression, we'll get into a
313 -- loop: (x1+x2)+x3 => x1+(x2+x3) => (x2+x3)+x1 => x2+(x3+x1) ...
315 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
316 | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
317 = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
319 -- Make a RegOff if we can
320 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
321 = CmmRegOff reg (fromIntegral (narrowS rep n))
322 cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
323 = CmmRegOff reg (off + fromIntegral (narrowS rep n))
324 cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
325 = CmmRegOff reg (- fromIntegral (narrowS rep n))
326 cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
327 = CmmRegOff reg (off - fromIntegral (narrowS rep n))
329 -- Fold label(+/-)offset into a CmmLit where possible
331 cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
332 = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
333 cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
334 = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
335 cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
336 = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
338 -- We can often do something with constants of 0 and 1 ...
340 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
351 MO_Ne r | isComparisonExpr x -> x
352 MO_Eq r | Just x' <- maybeInvertConditionalExpr x -> x'
353 MO_U_Gt r | isComparisonExpr x -> x
354 MO_S_Gt r | isComparisonExpr x -> x
355 MO_U_Lt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
356 MO_S_Lt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
357 MO_U_Ge r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
358 MO_S_Ge r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
359 MO_U_Le r | Just x' <- maybeInvertConditionalExpr x -> x'
360 MO_S_Le r | Just x' <- maybeInvertConditionalExpr x -> x'
361 other -> CmmMachOp mop args
363 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
368 MO_S_Rem r -> CmmLit (CmmInt 0 rep)
369 MO_U_Rem r -> CmmLit (CmmInt 0 rep)
370 MO_Ne r | Just x' <- maybeInvertConditionalExpr x -> x'
371 MO_Eq r | isComparisonExpr x -> x
372 MO_U_Lt r | Just x' <- maybeInvertConditionalExpr x -> x'
373 MO_S_Lt r | Just x' <- maybeInvertConditionalExpr x -> x'
374 MO_U_Gt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
375 MO_S_Gt r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
376 MO_U_Le r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
377 MO_S_Le r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
378 MO_U_Ge r | isComparisonExpr x -> x
379 MO_S_Ge r | isComparisonExpr x -> x
380 other -> CmmMachOp mop args
382 -- Now look for multiplication/division by powers of 2 (integers).
384 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
387 | Just p <- exactLog2 n ->
388 CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
390 | Just p <- exactLog2 n,
391 CmmReg _ <- x -> -- We duplicate x below, hence require
392 -- it is a reg. FIXME: remove this restriction.
393 -- shift right is not the same as quot, because it rounds
394 -- to minus infinity, whereasq uot rounds toward zero.
395 -- To fix this up, we add one less than the divisor to the
396 -- dividend if it is a negative number.
398 -- to avoid a test/jump, we use the following sequence:
399 -- x1 = x >> word_size-1 (all 1s if -ve, all 0s if +ve)
400 -- x2 = y & (divisor-1)
401 -- result = (x+x2) >>= log2(divisor)
402 -- this could be done a bit more simply using conditional moves,
403 -- but we're processor independent here.
405 -- we optimise the divide by 2 case slightly, generating
406 -- x1 = x >> word_size-1 (unsigned)
407 -- return = (x + x1) >>= log2(divisor)
409 bits = fromIntegral (machRepBitWidth rep) - 1
410 shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
411 x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
412 x2 = if p == 1 then x1 else
413 CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
414 x3 = CmmMachOp (MO_Add rep) [x, x2]
416 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
420 unchanged = CmmMachOp mop args
422 -- Anything else is just too hard.
424 cmmMachOpFold mop args = CmmMachOp mop args
426 -- -----------------------------------------------------------------------------
429 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
430 -- from GCC. It requires bit manipulation primitives, and we use GHC
431 -- extensions. Tough.
433 -- Used to be in MachInstrs --SDM.
434 -- ToDo: remove use of unboxery --SDM.
439 exactLog2 :: Integer -> Maybe Integer
441 = if (x <= 0 || x >= 2147483648) then
444 case fromInteger x of { I# x# ->
445 if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
448 Just (toInteger (I# (pow2 x#)))
451 pow2 x# | x# ==# 1# = 0#
452 | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
455 -- -----------------------------------------------------------------------------
456 -- widening / narrowing
458 narrowU :: MachRep -> Integer -> Integer
459 narrowU I8 x = fromIntegral (fromIntegral x :: Word8)
460 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
461 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
462 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
463 narrowU _ _ = panic "narrowTo"
465 narrowS :: MachRep -> Integer -> Integer
466 narrowS I8 x = fromIntegral (fromIntegral x :: Int8)
467 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
468 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
469 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
470 narrowS _ _ = panic "narrowTo"
472 -- -----------------------------------------------------------------------------
476 This is a simple pass that replaces tail-recursive functions like this:
491 the latter generates better C code, because the C compiler treats it
492 like a loop, and brings full loop optimisation to bear.
494 In my measurements this makes little or no difference to anything
495 except factorial, but what the hell.
498 cmmLoopifyForC :: CmmTop -> CmmTop
499 cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
500 | null info = p -- only if there's an info table, ignore case alts
502 -- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
503 CmmProc info entry_lbl [] blocks'
504 where blocks' = [ BasicBlock id (map do_stmt stmts)
505 | BasicBlock id stmts <- blocks ]
507 do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
511 jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
512 | otherwise = entry_lbl
514 cmmLoopifyForC top = top
516 -- -----------------------------------------------------------------------------
519 isLit (CmmLit _) = True
522 isComparisonExpr :: CmmExpr -> Bool
523 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
524 isComparisonExpr _other = False
526 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
527 maybeInvertConditionalExpr (CmmMachOp op args)
528 | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
529 maybeInvertConditionalExpr _ = Nothing