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 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
 316    | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
 317    = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
 318
 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))
 328
 329 -- Fold label(+/-)offset into a CmmLit where possible
 330
 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))))
 337
 338 -- We can often do something with constants of 0 and 1 ...
 339
 340 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
 341   = case mop of
 342         MO_Add   r -> x
 343         MO_Sub   r -> x
 344         MO_Mul   r -> y
 345         MO_And   r -> y
 346         MO_Or    r -> x
 347         MO_Xor   r -> x
 348         MO_Shl   r -> x
 349         MO_S_Shr r -> x
 350         MO_U_Shr r -> x
 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
 362
 363 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
 364   = case mop of
 365         MO_Mul    r -> x
 366         MO_S_Quot r -> x
 367         MO_U_Quot r -> x
 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
 381
 382 -- Now look for multiplication/division by powers of 2 (integers).
 383
 384 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
 385   = case mop of
 386         MO_Mul rep
 387            | Just p <- exactLog2 n ->
 388                  CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
 389         MO_S_Quot 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.
 397                 --
 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.
 404                 --
 405                 -- we optimise the divide by 2 case slightly, generating
 406                 --      x1 = x >> word_size-1  (unsigned)
 407                 --      return = (x + x1) >>= log2(divisor)
 408                 let
 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]
 415                 in
 416                 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
 417         other
 418            -> unchanged
 419     where
 420        unchanged = CmmMachOp mop args
 421
 422 -- Anything else is just too hard.
 423
 424 cmmMachOpFold mop args = CmmMachOp mop args
 425
 426 -- -----------------------------------------------------------------------------
 427 -- exactLog2
 428
 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.
 432 --
 433 -- Used to be in MachInstrs --SDM.
 434 -- ToDo: remove use of unboxery --SDM.
 435
 436 w2i x = word2Int# x
 437 i2w x = int2Word# x
 438
 439 exactLog2 :: Integer -> Maybe Integer
 440 exactLog2 x
 441   = if (x <= 0 || x >= 2147483648) then
 442        Nothing
 443     else
 444        case fromInteger x of { I# x# ->
 445        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
 446           Nothing
 447        else
 448           Just (toInteger (I# (pow2 x#)))
 449        }
 450   where
 451     pow2 x# | x# ==# 1# = 0#
 452             | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 453
 454
 455 -- -----------------------------------------------------------------------------
 456 -- widening / narrowing
 457
 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"
 464
 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"
 471
 472 -- -----------------------------------------------------------------------------
 473 -- Loopify for C
 474
 475 {-
 476  This is a simple pass that replaces tail-recursive functions like this:
 477
 478    fac() {
 479      ...
 480      jump fac();
 481    }
 482
 483  with this:
 484
 485   fac() {
 486    L:
 487      ...
 488      goto L;
 489   }
 490
 491   the latter generates better C code, because the C compiler treats it
 492   like a loop, and brings full loop optimisation to bear.
 493
 494   In my measurements this makes little or no difference to anything
 495   except factorial, but what the hell.
 496 -}
 497
 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
 501   | otherwise =
 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 ]
 506
 507         do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
 508                 = CmmBranch top_id
 509         do_stmt stmt = stmt
 510
 511         jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
 512                  | otherwise        = entry_lbl
 513
 514 cmmLoopifyForC top = top
 515
 516 -- -----------------------------------------------------------------------------
 517 -- Utils
 518
 519 isLit (CmmLit _) = True
 520 isLit _          = False
 521
 522 isComparisonExpr :: CmmExpr -> Bool
 523 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 524 isComparisonExpr _other             = False
 525
 526 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
 527 maybeInvertConditionalExpr (CmmMachOp op args)
 528   | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
 529 maybeInvertConditionalExpr _ = Nothing