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 CmmUtils
  19 import CLabel
  20 import MachOp
  21 import SMRep
  22 import StaticFlags
  23
  24 import UniqFM
  25 import Unique
  26
  27 import Outputable
  28
  29 import Data.Bits
  30 import Data.Word
  31 import Data.Int
  32 import GHC.Exts
  33
  34 -- -----------------------------------------------------------------------------
  35 -- The mini-inliner
  36
  37 {-
  38 This pass inlines assignments to temporaries that are used just
  39 once.  It works as follows:
  40
  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.
  48
  49 Possible generalisations: here is an example from factorial
  50
  51 Fac_zdwfac_entry:
  52     cmG:
  53         _smi = R2;
  54         if (_smi != 0) goto cmK;
  55         R1 = R3;
  56         jump I64[Sp];
  57     cmK:
  58         _smn = _smi * R3;
  59         R2 = _smi + (-1);
  60         R3 = _smn;
  61         jump Fac_zdwfac_info;
  62
  63 We want to inline _smi and _smn.  To inline _smn:
  64
  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
  68      to test.
  69
  70 To inline _smi:
  71
  72    - It is a trivial replacement, reg for reg, but it occurs more than
  73      once.
  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
  79      its occurrences.
  80 -}
  81
  82 cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
  83 cmmMiniInline blocks = map do_inline blocks
  84   where
  85         blockUses (BasicBlock _ stmts)
  86          = foldr (plusUFM_C (+)) emptyUFM (map getStmtUses stmts)
  87
  88         uses = foldr (plusUFM_C (+)) emptyUFM (map blockUses blocks)
  89
  90         do_inline (BasicBlock id stmts)
  91          = BasicBlock id (cmmMiniInlineStmts uses stmts)
  92
  93
  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
  99   =
 100 #ifdef NCG_DEBUG
 101      trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
 102 #endif
 103      cmmMiniInlineStmts uses stmts'
 104
 105 cmmMiniInlineStmts uses (stmt:stmts)
 106   = stmt : cmmMiniInlineStmts uses stmts
 107
 108
 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)
 113   | u /= u'
 114   = case lookupUFM (getExprUses rhs) u of
 115         Just 1 -> Just (inlineStmt u expr stmt : rest)
 116         _other -> case lookForInline u expr rest of
 117                      Nothing    -> Nothing
 118                      Just stmts -> Just (stmt:stmts)
 119
 120 lookForInline u expr (CmmNop : rest)
 121   = lookForInline u expr rest
 122
 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)
 126         _other -> Nothing
 127   where
 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
 135                      _ -> True
 136
 137 -- -----------------------------------------------------------------------------
 138 -- Boring Cmm traversals for collecting usage info and substitutions.
 139
 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
 146          uses _ = emptyUFM
 147 getStmtUses (CmmCondBranch e _) = getExprUses e
 148 getStmtUses (CmmSwitch e _) = getExprUses e
 149 getStmtUses (CmmJump e _) = getExprUses e
 150 getStmtUses _ = emptyUFM
 151
 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
 158
 159 getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
 160
 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
 173
 174 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
 175 inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
 176   | u == u' = a
 177   | otherwise = e
 178 inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
 179   | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
 180   | otherwise = e
 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
 184
 185 -- -----------------------------------------------------------------------------
 186 -- MachOp constant folder
 187
 188 -- Now, try to constant-fold the MachOps.  The arguments have already
 189 -- been optimized and folded.
 190
 191 cmmMachOpFold
 192     :: MachOp           -- The operation from an CmmMachOp
 193     -> [CmmExpr]        -- The optimized arguments
 194     -> CmmExpr
 195
 196 cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
 197   = case op of
 198       MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
 199       MO_Not r   -> CmmLit (CmmInt (complement x) rep)
 200
 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.
 205       MO_S_Conv from to
 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)
 209
 210       _ -> panic "cmmMachOpFold: unknown unary op"
 211
 212
 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
 216
 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
 221   = case () of
 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]
 235         | otherwise ->
 236             CmmMachOp conv_outer args
 237   where
 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
 245
 246         intconv True  = MO_S_Conv
 247         intconv False = MO_U_Conv
 248
 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?
 252
 253 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 254   = case mop of
 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)
 259
 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)
 264
 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)
 269
 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)
 275
 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)
 279
 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)
 283
 284         other      -> CmmMachOp mop args
 285
 286    where
 287         x_u = narrowU xrep x
 288         y_u = narrowU xrep y
 289         x_s = narrowS xrep x
 290         y_s = narrowS xrep y
 291
 292
 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
 296 -- possible.
 297
 298 cmmMachOpFold op [x@(CmmLit _), y]
 299    | not (isLit y) && isCommutableMachOp op
 300    = cmmMachOpFold op [y, x]
 301
 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
 305 -- right-associated.
 306 --
 307 -- ToDo: this appears to introduce a quadratic behaviour due to the
 308 -- nested cmmMachOpFold.  Can we fix this?
 309 --
 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) ...
 314 --
 315 -- Also don't do it if arg1 is PicBaseReg, so that we don't separate the
 316 -- PicBaseReg from the corresponding label (or label difference).
 317 --
 318 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
 319    | mop1 == mop2 && isAssociativeMachOp mop1
 320      && not (isLit arg1) && not (isPicReg arg1)
 321    = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
 322
 323 -- Make a RegOff if we can
 324 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
 325   = CmmRegOff reg (fromIntegral (narrowS rep n))
 326 cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 327   = CmmRegOff reg (off + fromIntegral (narrowS rep n))
 328 cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
 329   = CmmRegOff reg (- fromIntegral (narrowS rep n))
 330 cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 331   = CmmRegOff reg (off - fromIntegral (narrowS rep n))
 332
 333 -- Fold label(+/-)offset into a CmmLit where possible
 334
 335 cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 336   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 337 cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
 338   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 339 cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 340   = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
 341
 342 -- We can often do something with constants of 0 and 1 ...
 343
 344 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
 345   = case mop of
 346         MO_Add   r -> x
 347         MO_Sub   r -> x
 348         MO_Mul   r -> y
 349         MO_And   r -> y
 350         MO_Or    r -> x
 351         MO_Xor   r -> x
 352         MO_Shl   r -> x
 353         MO_S_Shr r -> x
 354         MO_U_Shr r -> x
 355         MO_Ne    r | isComparisonExpr x -> x
 356         MO_Eq    r | Just x' <- maybeInvertConditionalExpr x -> x'
 357         MO_U_Gt  r | isComparisonExpr x -> x
 358         MO_S_Gt  r | isComparisonExpr x -> x
 359         MO_U_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 360         MO_S_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 361         MO_U_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 362         MO_S_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 363         MO_U_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 364         MO_S_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 365         other    -> CmmMachOp mop args
 366
 367 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
 368   = case mop of
 369         MO_Mul    r -> x
 370         MO_S_Quot r -> x
 371         MO_U_Quot r -> x
 372         MO_S_Rem  r -> CmmLit (CmmInt 0 rep)
 373         MO_U_Rem  r -> CmmLit (CmmInt 0 rep)
 374         MO_Ne    r | Just x' <- maybeInvertConditionalExpr x -> x'
 375         MO_Eq    r | isComparisonExpr x -> x
 376         MO_U_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 377         MO_S_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 378         MO_U_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 379         MO_S_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 380         MO_U_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 381         MO_S_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 382         MO_U_Ge  r | isComparisonExpr x -> x
 383         MO_S_Ge  r | isComparisonExpr x -> x
 384         other       -> CmmMachOp mop args
 385
 386 -- Now look for multiplication/division by powers of 2 (integers).
 387
 388 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
 389   = case mop of
 390         MO_Mul rep
 391            | Just p <- exactLog2 n ->
 392                  CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
 393         MO_S_Quot rep
 394            | Just p <- exactLog2 n,
 395              CmmReg _ <- x ->   -- We duplicate x below, hence require
 396                                 -- it is a reg.  FIXME: remove this restriction.
 397                 -- shift right is not the same as quot, because it rounds
 398                 -- to minus infinity, whereasq uot rounds toward zero.
 399                 -- To fix this up, we add one less than the divisor to the
 400                 -- dividend if it is a negative number.
 401                 --
 402                 -- to avoid a test/jump, we use the following sequence:
 403                 --      x1 = x >> word_size-1  (all 1s if -ve, all 0s if +ve)
 404                 --      x2 = y & (divisor-1)
 405                 --      result = (x+x2) >>= log2(divisor)
 406                 -- this could be done a bit more simply using conditional moves,
 407                 -- but we're processor independent here.
 408                 --
 409                 -- we optimise the divide by 2 case slightly, generating
 410                 --      x1 = x >> word_size-1  (unsigned)
 411                 --      return = (x + x1) >>= log2(divisor)
 412                 let
 413                     bits = fromIntegral (machRepBitWidth rep) - 1
 414                     shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
 415                     x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
 416                     x2 = if p == 1 then x1 else
 417                          CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
 418                     x3 = CmmMachOp (MO_Add rep) [x, x2]
 419                 in
 420                 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
 421         other
 422            -> unchanged
 423     where
 424        unchanged = CmmMachOp mop args
 425
 426 -- Anything else is just too hard.
 427
 428 cmmMachOpFold mop args = CmmMachOp mop args
 429
 430 -- -----------------------------------------------------------------------------
 431 -- exactLog2
 432
 433 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
 434 -- from GCC.  It requires bit manipulation primitives, and we use GHC
 435 -- extensions.  Tough.
 436 --
 437 -- Used to be in MachInstrs --SDM.
 438 -- ToDo: remove use of unboxery --SDM.
 439
 440 w2i x = word2Int# x
 441 i2w x = int2Word# x
 442
 443 exactLog2 :: Integer -> Maybe Integer
 444 exactLog2 x
 445   = if (x <= 0 || x >= 2147483648) then
 446        Nothing
 447     else
 448        case fromInteger x of { I# x# ->
 449        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
 450           Nothing
 451        else
 452           Just (toInteger (I# (pow2 x#)))
 453        }
 454   where
 455     pow2 x# | x# ==# 1# = 0#
 456             | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 457
 458
 459 -- -----------------------------------------------------------------------------
 460 -- widening / narrowing
 461
 462 narrowU :: MachRep -> Integer -> Integer
 463 narrowU I8  x = fromIntegral (fromIntegral x :: Word8)
 464 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
 465 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
 466 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
 467 narrowU _ _ = panic "narrowTo"
 468
 469 narrowS :: MachRep -> Integer -> Integer
 470 narrowS I8  x = fromIntegral (fromIntegral x :: Int8)
 471 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
 472 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
 473 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
 474 narrowS _ _ = panic "narrowTo"
 475
 476 -- -----------------------------------------------------------------------------
 477 -- Loopify for C
 478
 479 {-
 480  This is a simple pass that replaces tail-recursive functions like this:
 481
 482    fac() {
 483      ...
 484      jump fac();
 485    }
 486
 487  with this:
 488
 489   fac() {
 490    L:
 491      ...
 492      goto L;
 493   }
 494
 495   the latter generates better C code, because the C compiler treats it
 496   like a loop, and brings full loop optimisation to bear.
 497
 498   In my measurements this makes little or no difference to anything
 499   except factorial, but what the hell.
 500 -}
 501
 502 cmmLoopifyForC :: CmmTop -> CmmTop
 503 cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
 504   | null info = p  -- only if there's an info table, ignore case alts
 505   | otherwise =
 506 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
 507   CmmProc info entry_lbl [] blocks'
 508   where blocks' = [ BasicBlock id (map do_stmt stmts)
 509                   | BasicBlock id stmts <- blocks ]
 510
 511         do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
 512                 = CmmBranch top_id
 513         do_stmt stmt = stmt
 514
 515         jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
 516                  | otherwise        = entry_lbl
 517
 518 cmmLoopifyForC top = top
 519
 520 -- -----------------------------------------------------------------------------
 521 -- Utils
 522
 523 isLit (CmmLit _) = True
 524 isLit _          = False
 525
 526 isComparisonExpr :: CmmExpr -> Bool
 527 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 528 isComparisonExpr _other             = False
 529
 530 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
 531 maybeInvertConditionalExpr (CmmMachOp op args)
 532   | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
 533 maybeInvertConditionalExpr _ = Nothing
 534
 535 isPicReg (CmmReg (CmmGlobal PicBaseReg)) = True
 536 isPicReg _ = False