ghc/compiler/cmm/CmmOpt.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Cmm optimisation
   4 --
   5 -- (c) The University of Glasgow 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CmmOpt (
  10         cmmMiniInline,
  11         cmmMachOpFold,
  12         cmmLoopifyForC,
  13  ) where
  14
  15 #include "HsVersions.h"
  16
  17 import Cmm
  18 import CLabel   ( entryLblToInfoLbl )
  19 import MachOp
  20 import SMRep    ( tablesNextToCode )
  21
  22 import UniqFM
  23 import Unique   ( Unique )
  24 import Panic    ( panic )
  25
  26 import Outputable
  27
  28 import Bits
  29 import Word
  30 import Int
  31 import GLAEXTS
  32
  33
  34 -- -----------------------------------------------------------------------------
  35 -- The mini-inliner
  36
  37 -- This pass inlines assignments to temporaries that are used just
  38 -- once in the very next statement only.  Generalising this would be
  39 -- quite difficult (have to take into account aliasing of memory
  40 -- writes, and so on), but at the moment it catches a number of useful
  41 -- cases and lets the code generator generate much better code.
  42
  43 -- NB. This assumes that temporaries are single-assignment.
  44
  45 cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
  46 cmmMiniInline blocks = map do_inline blocks
  47   where
  48         blockUses (BasicBlock _ stmts)
  49          = foldr (plusUFM_C (+)) emptyUFM (map getStmtUses stmts)
  50
  51         uses = foldr (plusUFM_C (+)) emptyUFM (map blockUses blocks)
  52
  53         do_inline (BasicBlock id stmts)
  54          = BasicBlock id (cmmMiniInlineStmts uses stmts)
  55
  56
  57 cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
  58 cmmMiniInlineStmts uses [] = []
  59 cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
  60   | Just 1 <- lookupUFM uses u,
  61     Just stmts' <- lookForInline u expr stmts
  62   =
  63 #ifdef NCG_DEBUG
  64      trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
  65 #endif
  66      cmmMiniInlineStmts uses stmts'
  67
  68 cmmMiniInlineStmts uses (stmt:stmts)
  69   = stmt : cmmMiniInlineStmts uses stmts
  70
  71
  72 -- Try to inline a temporary assignment.  We can skip over assignments to
  73 -- other tempoararies, because we know that expressions aren't side-effecting
  74 -- and temporaries are single-assignment.
  75 lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
  76   | u /= u'
  77   = case lookupUFM (getExprUses rhs) u of
  78         Just 1 -> Just (inlineStmt u expr stmt : rest)
  79         _other -> case lookForInline u expr rest of
  80                      Nothing    -> Nothing
  81                      Just stmts -> Just (stmt:stmts)
  82
  83 lookForInline u expr (CmmNop : rest)
  84   = lookForInline u expr rest
  85
  86 lookForInline u expr (stmt:stmts)
  87   = case lookupUFM (getStmtUses stmt) u of
  88         Just 1 -> Just (inlineStmt u expr stmt : stmts)
  89         _other -> Nothing
  90
  91 -- -----------------------------------------------------------------------------
  92 -- Boring Cmm traversals for collecting usage info and substitutions.
  93
  94 getStmtUses :: CmmStmt -> UniqFM Int
  95 getStmtUses (CmmAssign _ e) = getExprUses e
  96 getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
  97 getStmtUses (CmmCall target _ es _)
  98    = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
  99    where uses (CmmForeignCall e _) = getExprUses e
 100          uses _ = emptyUFM
 101 getStmtUses (CmmCondBranch e _) = getExprUses e
 102 getStmtUses (CmmSwitch e _) = getExprUses e
 103 getStmtUses (CmmJump e _) = getExprUses e
 104 getStmtUses _ = emptyUFM
 105
 106 getExprUses :: CmmExpr -> UniqFM Int
 107 getExprUses (CmmReg (CmmLocal (LocalReg u _))) = unitUFM u 1
 108 getExprUses (CmmRegOff (CmmLocal (LocalReg u _)) _) = unitUFM u 1
 109 getExprUses (CmmLoad e _) = getExprUses e
 110 getExprUses (CmmMachOp _ es) = getExprsUses es
 111 getExprUses _other = emptyUFM
 112
 113 getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
 114
 115 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
 116 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 117 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
 118 inlineStmt u a (CmmCall target regs es vols)
 119    = CmmCall (infn target) regs es' vols
 120    where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
 121          infn (CmmPrim p) = CmmPrim p
 122          es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
 123 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
 124 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
 125 inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
 126 inlineStmt u a other_stmt = other_stmt
 127
 128 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
 129 inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
 130   | u == u' = a
 131   | otherwise = e
 132 inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
 133   | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
 134   | otherwise = e
 135 inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
 136 inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
 137 inlineExpr u a other_expr = other_expr
 138
 139 -- -----------------------------------------------------------------------------
 140 -- MachOp constant folder
 141
 142 -- Now, try to constant-fold the MachOps.  The arguments have already
 143 -- been optimized and folded.
 144
 145 cmmMachOpFold
 146     :: MachOp           -- The operation from an CmmMachOp
 147     -> [CmmExpr]        -- The optimized arguments
 148     -> CmmExpr
 149
 150 cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
 151   = case op of
 152       MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
 153       MO_Not r   -> CmmLit (CmmInt (complement x) rep)
 154
 155         -- these are interesting: we must first narrow to the
 156         -- "from" type, in order to truncate to the correct size.
 157         -- The final narrow/widen to the destination type
 158         -- is implicit in the CmmLit.
 159       MO_S_Conv from to
 160            | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
 161            | otherwise        -> CmmLit (CmmInt (narrowS from x) to)
 162       MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
 163
 164       _ -> panic "cmmMachOpFold: unknown unary op"
 165
 166
 167 -- Eliminate conversion NOPs
 168 cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
 169 cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
 170
 171 -- Eliminate nested conversions where possible
 172 cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
 173   | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
 174     Just (_,   rep3,signed2) <- isIntConversion conv_outer
 175   = case () of
 176         -- widen then narrow to the same size is a nop
 177       _ | rep1 < rep2 && rep1 == rep3 -> x
 178         -- Widen then narrow to different size: collapse to single conversion
 179         -- but remember to use the signedness from the widening, just in case
 180         -- the final conversion is a widen.
 181         | rep1 < rep2 && rep2 > rep3 ->
 182             cmmMachOpFold (intconv signed1 rep1 rep3) [x]
 183         -- Nested widenings: collapse if the signedness is the same
 184         | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
 185             cmmMachOpFold (intconv signed1 rep1 rep3) [x]
 186         -- Nested narrowings: collapse
 187         | rep1 > rep2 && rep2 > rep3 ->
 188             cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
 189         | otherwise ->
 190             CmmMachOp conv_outer args
 191   where
 192         isIntConversion (MO_U_Conv rep1 rep2)
 193           | not (isFloatingRep rep1) && not (isFloatingRep rep2)
 194           = Just (rep1,rep2,False)
 195         isIntConversion (MO_S_Conv rep1 rep2)
 196           | not (isFloatingRep rep1) && not (isFloatingRep rep2)
 197           = Just (rep1,rep2,True)
 198         isIntConversion _ = Nothing
 199
 200         intconv True  = MO_S_Conv
 201         intconv False = MO_U_Conv
 202
 203 -- ToDo: a narrow of a load can be collapsed into a narrow load, right?
 204 -- but what if the architecture only supports word-sized loads, should
 205 -- we do the transformation anyway?
 206
 207 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 208   = case mop of
 209         -- for comparisons: don't forget to narrow the arguments before
 210         -- comparing, since they might be out of range.
 211         MO_Eq r   -> CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordRep)
 212         MO_Ne r   -> CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordRep)
 213
 214         MO_U_Gt r -> CmmLit (CmmInt (if x_u >  y_u then 1 else 0) wordRep)
 215         MO_U_Ge r -> CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordRep)
 216         MO_U_Lt r -> CmmLit (CmmInt (if x_u <  y_u then 1 else 0) wordRep)
 217         MO_U_Le r -> CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordRep)
 218
 219         MO_S_Gt r -> CmmLit (CmmInt (if x_s >  y_s then 1 else 0) wordRep)
 220         MO_S_Ge r -> CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordRep)
 221         MO_S_Lt r -> CmmLit (CmmInt (if x_s <  y_s then 1 else 0) wordRep)
 222         MO_S_Le r -> CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordRep)
 223
 224         MO_Add r -> CmmLit (CmmInt (x + y) r)
 225         MO_Sub r -> CmmLit (CmmInt (x - y) r)
 226         MO_Mul r -> CmmLit (CmmInt (x * y) r)
 227         MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
 228         MO_S_Rem  r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
 229
 230         MO_And   r -> CmmLit (CmmInt (x .&. y) r)
 231         MO_Or    r -> CmmLit (CmmInt (x .|. y) r)
 232         MO_Xor   r -> CmmLit (CmmInt (x `xor` y) r)
 233
 234         MO_Shl   r -> CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
 235         MO_U_Shr r -> CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
 236         MO_S_Shr r -> CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
 237
 238         other      -> CmmMachOp mop args
 239
 240    where
 241         x_u = narrowU xrep x
 242         y_u = narrowU xrep y
 243         x_s = narrowS xrep x
 244         y_s = narrowS xrep y
 245
 246
 247 -- When possible, shift the constants to the right-hand side, so that we
 248 -- can match for strength reductions.  Note that the code generator will
 249 -- also assume that constants have been shifted to the right when
 250 -- possible.
 251
 252 cmmMachOpFold op [x@(CmmLit _), y]
 253    | not (isLit y) && isCommutableMachOp op
 254    = cmmMachOpFold op [y, x]
 255
 256 -- Turn (a+b)+c into a+(b+c) where possible.  Because literals are
 257 -- moved to the right, it is more likely that we will find
 258 -- opportunities for constant folding when the expression is
 259 -- right-associated.
 260 --
 261 -- ToDo: this appears to introduce a quadratic behaviour due to the
 262 -- nested cmmMachOpFold.  Can we fix this?
 263 --
 264 -- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2
 265 -- is also a lit (otherwise arg1 would be on the right).  If we
 266 -- put arg1 on the left of the rearranged expression, we'll get into a
 267 -- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...
 268 --
 269 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
 270    | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
 271    = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
 272
 273 -- Make a RegOff if we can
 274 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
 275   = CmmRegOff reg (fromIntegral (narrowS rep n))
 276 cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 277   = CmmRegOff reg (off + fromIntegral (narrowS rep n))
 278 cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
 279   = CmmRegOff reg (- fromIntegral (narrowS rep n))
 280 cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 281   = CmmRegOff reg (off - fromIntegral (narrowS rep n))
 282
 283 -- Fold label(+/-)offset into a CmmLit where possible
 284
 285 cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 286   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 287 cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
 288   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 289 cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 290   = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
 291
 292 -- We can often do something with constants of 0 and 1 ...
 293
 294 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
 295   = case mop of
 296         MO_Add   r -> x
 297         MO_Sub   r -> x
 298         MO_Mul   r -> y
 299         MO_And   r -> y
 300         MO_Or    r -> x
 301         MO_Xor   r -> x
 302         MO_Shl   r -> x
 303         MO_S_Shr r -> x
 304         MO_U_Shr r -> x
 305         MO_Ne    r | isComparisonExpr x -> x
 306         MO_Eq    r | Just x' <- maybeInvertConditionalExpr x -> x'
 307         MO_U_Gt  r | isComparisonExpr x -> x
 308         MO_S_Gt  r | isComparisonExpr x -> x
 309         MO_U_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 310         MO_S_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 311         MO_U_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 312         MO_S_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 313         MO_U_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 314         MO_S_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 315         other    -> CmmMachOp mop args
 316
 317 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
 318   = case mop of
 319         MO_Mul    r -> x
 320         MO_S_Quot r -> x
 321         MO_U_Quot r -> x
 322         MO_S_Rem  r -> CmmLit (CmmInt 0 rep)
 323         MO_U_Rem  r -> CmmLit (CmmInt 0 rep)
 324         MO_Ne    r | Just x' <- maybeInvertConditionalExpr x -> x'
 325         MO_Eq    r | isComparisonExpr x -> x
 326         MO_U_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 327         MO_S_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 328         MO_U_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 329         MO_S_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 330         MO_U_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 331         MO_S_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 332         MO_U_Ge  r | isComparisonExpr x -> x
 333         MO_S_Ge  r | isComparisonExpr x -> x
 334         other       -> CmmMachOp mop args
 335
 336 -- Now look for multiplication/division by powers of 2 (integers).
 337
 338 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
 339   = case mop of
 340         MO_Mul rep
 341            -> case exactLog2 n of
 342                  Nothing -> unchanged
 343                  Just p  -> CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
 344         MO_S_Quot rep
 345            -> case exactLog2 n of
 346                  Nothing -> unchanged
 347                  Just p  -> CmmMachOp (MO_S_Shr rep) [x, CmmLit (CmmInt p rep)]
 348         other
 349            -> unchanged
 350     where
 351        unchanged = CmmMachOp mop args
 352
 353 -- Anything else is just too hard.
 354
 355 cmmMachOpFold mop args = CmmMachOp mop args
 356
 357 -- -----------------------------------------------------------------------------
 358 -- exactLog2
 359
 360 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
 361 -- from GCC.  It requires bit manipulation primitives, and we use GHC
 362 -- extensions.  Tough.
 363 --
 364 -- Used to be in MachInstrs --SDM.
 365 -- ToDo: remove use of unboxery --SDM.
 366
 367 w2i x = word2Int# x
 368 i2w x = int2Word# x
 369
 370 exactLog2 :: Integer -> Maybe Integer
 371 exactLog2 x
 372   = if (x <= 0 || x >= 2147483648) then
 373        Nothing
 374     else
 375        case fromInteger x of { I# x# ->
 376        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
 377           Nothing
 378        else
 379           Just (toInteger (I# (pow2 x#)))
 380        }
 381   where
 382     pow2 x# | x# ==# 1# = 0#
 383             | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 384
 385
 386 -- -----------------------------------------------------------------------------
 387 -- widening / narrowing
 388
 389 narrowU :: MachRep -> Integer -> Integer
 390 narrowU I8  x = fromIntegral (fromIntegral x :: Word8)
 391 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
 392 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
 393 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
 394 narrowU _ _ = panic "narrowTo"
 395
 396 narrowS :: MachRep -> Integer -> Integer
 397 narrowS I8  x = fromIntegral (fromIntegral x :: Int8)
 398 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
 399 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
 400 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
 401 narrowS _ _ = panic "narrowTo"
 402
 403 -- -----------------------------------------------------------------------------
 404 -- Loopify for C
 405
 406 {-
 407  This is a simple pass that replaces tail-recursive functions like this:
 408
 409    fac() {
 410      ...
 411      jump fac();
 412    }
 413
 414  with this:
 415
 416   fac() {
 417    L:
 418      ...
 419      goto L;
 420   }
 421
 422   the latter generates better C code, because the C compiler treats it
 423   like a loop, and brings full loop optimisation to bear.
 424
 425   In my measurements this makes little or no difference to anything
 426   except factorial, but what the hell.
 427 -}
 428
 429 cmmLoopifyForC :: CmmTop -> CmmTop
 430 cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
 431   | null info = p  -- only if there's an info table, ignore case alts
 432   | otherwise =
 433 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
 434   CmmProc info entry_lbl [] blocks'
 435   where blocks' = [ BasicBlock id (map do_stmt stmts)
 436                   | BasicBlock id stmts <- blocks ]
 437
 438         do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
 439                 = CmmBranch top_id
 440         do_stmt stmt = stmt
 441
 442         jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
 443                  | otherwise        = entry_lbl
 444
 445 cmmLoopifyForC top = top
 446
 447 -- -----------------------------------------------------------------------------
 448 -- Utils
 449
 450 isLit (CmmLit _) = True
 451 isLit _          = False
 452
 453 isComparisonExpr :: CmmExpr -> Bool
 454 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 455 isComparisonExpr _other             = False
 456
 457 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
 458 maybeInvertConditionalExpr (CmmMachOp op args)
 459   | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
 460 maybeInvertConditionalExpr _ = Nothing