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
  23 import UniqFM
  24 import Unique
  25
  26 import Outputable
  27
  28 import Data.Bits
  29 import Data.Word
  30 import Data.Int
  31 import GHC.Exts
  32
  33 -- -----------------------------------------------------------------------------
  34 -- The mini-inliner
  35
  36 {-
  37 This pass inlines assignments to temporaries that are used just
  38 once.  It works as follows:
  39
  40   - count uses of each temporary
  41   - for each temporary that occurs just once:
  42         - attempt to push it forward to the statement that uses it
  43         - only push forward past assignments to other temporaries
  44           (assumes that temporaries are single-assignment)
  45         - if we reach the statement that uses it, inline the rhs
  46           and delete the original assignment.
  47
  48 Possible generalisations: here is an example from factorial
  49
  50 Fac_zdwfac_entry:
  51     cmG:
  52         _smi = R2;
  53         if (_smi != 0) goto cmK;
  54         R1 = R3;
  55         jump I64[Sp];
  56     cmK:
  57         _smn = _smi * R3;
  58         R2 = _smi + (-1);
  59         R3 = _smn;
  60         jump Fac_zdwfac_info;
  61
  62 We want to inline _smi and _smn.  To inline _smn:
  63
  64    - we must be able to push forward past assignments to global regs.
  65      We can do this if the rhs of the assignment we are pushing
  66      forward doesn't refer to the global reg being assigned to; easy
  67      to test.
  68
  69 To inline _smi:
  70
  71    - It is a trivial replacement, reg for reg, but it occurs more than
  72      once.
  73    - We can inline trivial assignments even if the temporary occurs
  74      more than once, as long as we don't eliminate the original assignment
  75      (this doesn't help much on its own).
  76    - We need to be able to propagate the assignment forward through jumps;
  77      if we did this, we would find that it can be inlined safely in all
  78      its occurrences.
  79 -}
  80
  81 cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
  82 cmmMiniInline blocks = map do_inline blocks
  83   where
  84         blockUses (BasicBlock _ stmts)
  85          = foldr (plusUFM_C (+)) emptyUFM (map getStmtUses stmts)
  86
  87         uses = foldr (plusUFM_C (+)) emptyUFM (map blockUses blocks)
  88
  89         do_inline (BasicBlock id stmts)
  90          = BasicBlock id (cmmMiniInlineStmts uses stmts)
  91
  92
  93 cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
  94 cmmMiniInlineStmts uses [] = []
  95 cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
  96   | Just 1 <- lookupUFM uses u,
  97     Just stmts' <- lookForInline u expr stmts
  98   =
  99 #ifdef NCG_DEBUG
 100      trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
 101 #endif
 102      cmmMiniInlineStmts uses stmts'
 103
 104 cmmMiniInlineStmts uses (stmt:stmts)
 105   = stmt : cmmMiniInlineStmts uses stmts
 106
 107
 108 -- Try to inline a temporary assignment.  We can skip over assignments to
 109 -- other tempoararies, because we know that expressions aren't side-effecting
 110 -- and temporaries are single-assignment.
 111 lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
 112   | u /= u'
 113   = case lookupUFM (getExprUses rhs) u of
 114         Just 1 -> Just (inlineStmt u expr stmt : rest)
 115         _other -> case lookForInline u expr rest of
 116                      Nothing    -> Nothing
 117                      Just stmts -> Just (stmt:stmts)
 118
 119 lookForInline u expr (CmmNop : rest)
 120   = lookForInline u expr rest
 121
 122 lookForInline u expr (stmt:stmts)
 123   = case lookupUFM (getStmtUses stmt) u of
 124         Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
 125         _other -> Nothing
 126   where
 127         -- we don't inline into CmmCall if the expression refers to global
 128         -- registers.  This is a HACK to avoid global registers clashing with
 129         -- C argument-passing registers, really the back-end ought to be able
 130         -- to handle it properly, but currently neither PprC nor the NCG can
 131         -- do it.  See also CgForeignCall:load_args_into_temps.
 132     ok_to_inline = case stmt of
 133                      CmmCall{} -> hasNoGlobalRegs expr
 134                      _ -> True
 135
 136 -- -----------------------------------------------------------------------------
 137 -- Boring Cmm traversals for collecting usage info and substitutions.
 138
 139 getStmtUses :: CmmStmt -> UniqFM Int
 140 getStmtUses (CmmAssign _ e) = getExprUses e
 141 getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
 142 getStmtUses (CmmCall target _ es _)
 143    = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
 144    where uses (CmmForeignCall e _) = getExprUses e
 145          uses _ = emptyUFM
 146 getStmtUses (CmmCondBranch e _) = getExprUses e
 147 getStmtUses (CmmSwitch e _) = getExprUses e
 148 getStmtUses (CmmJump e _) = getExprUses e
 149 getStmtUses _ = emptyUFM
 150
 151 getExprUses :: CmmExpr -> UniqFM Int
 152 getExprUses (CmmReg (CmmLocal (LocalReg u _))) = unitUFM u 1
 153 getExprUses (CmmRegOff (CmmLocal (LocalReg u _)) _) = unitUFM u 1
 154 getExprUses (CmmLoad e _) = getExprUses e
 155 getExprUses (CmmMachOp _ es) = getExprsUses es
 156 getExprUses _other = emptyUFM
 157
 158 getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
 159
 160 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
 161 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 162 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
 163 inlineStmt u a (CmmCall target regs es vols)
 164    = CmmCall (infn target) regs es' vols
 165    where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
 166          infn (CmmPrim p) = CmmPrim p
 167          es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
 168 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
 169 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
 170 inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
 171 inlineStmt u a other_stmt = other_stmt
 172
 173 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
 174 inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
 175   | u == u' = a
 176   | otherwise = e
 177 inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
 178   | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
 179   | otherwise = e
 180 inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
 181 inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
 182 inlineExpr u a other_expr = other_expr
 183
 184 -- -----------------------------------------------------------------------------
 185 -- MachOp constant folder
 186
 187 -- Now, try to constant-fold the MachOps.  The arguments have already
 188 -- been optimized and folded.
 189
 190 cmmMachOpFold
 191     :: MachOp           -- The operation from an CmmMachOp
 192     -> [CmmExpr]        -- The optimized arguments
 193     -> CmmExpr
 194
 195 cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
 196   = case op of
 197       MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
 198       MO_Not r   -> CmmLit (CmmInt (complement x) rep)
 199
 200         -- these are interesting: we must first narrow to the
 201         -- "from" type, in order to truncate to the correct size.
 202         -- The final narrow/widen to the destination type
 203         -- is implicit in the CmmLit.
 204       MO_S_Conv from to
 205            | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
 206            | otherwise        -> CmmLit (CmmInt (narrowS from x) to)
 207       MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
 208
 209       _ -> panic "cmmMachOpFold: unknown unary op"
 210
 211
 212 -- Eliminate conversion NOPs
 213 cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
 214 cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
 215
 216 -- Eliminate nested conversions where possible
 217 cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
 218   | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
 219     Just (_,   rep3,signed2) <- isIntConversion conv_outer
 220   = case () of
 221         -- widen then narrow to the same size is a nop
 222       _ | rep1 < rep2 && rep1 == rep3 -> x
 223         -- Widen then narrow to different size: collapse to single conversion
 224         -- but remember to use the signedness from the widening, just in case
 225         -- the final conversion is a widen.
 226         | rep1 < rep2 && rep2 > rep3 ->
 227             cmmMachOpFold (intconv signed1 rep1 rep3) [x]
 228         -- Nested widenings: collapse if the signedness is the same
 229         | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
 230             cmmMachOpFold (intconv signed1 rep1 rep3) [x]
 231         -- Nested narrowings: collapse
 232         | rep1 > rep2 && rep2 > rep3 ->
 233             cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
 234         | otherwise ->
 235             CmmMachOp conv_outer args
 236   where
 237         isIntConversion (MO_U_Conv rep1 rep2)
 238           | not (isFloatingRep rep1) && not (isFloatingRep rep2)
 239           = Just (rep1,rep2,False)
 240         isIntConversion (MO_S_Conv rep1 rep2)
 241           | not (isFloatingRep rep1) && not (isFloatingRep rep2)
 242           = Just (rep1,rep2,True)
 243         isIntConversion _ = Nothing
 244
 245         intconv True  = MO_S_Conv
 246         intconv False = MO_U_Conv
 247
 248 -- ToDo: a narrow of a load can be collapsed into a narrow load, right?
 249 -- but what if the architecture only supports word-sized loads, should
 250 -- we do the transformation anyway?
 251
 252 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 253   = case mop of
 254         -- for comparisons: don't forget to narrow the arguments before
 255         -- comparing, since they might be out of range.
 256         MO_Eq r   -> CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordRep)
 257         MO_Ne r   -> CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordRep)
 258
 259         MO_U_Gt r -> CmmLit (CmmInt (if x_u >  y_u then 1 else 0) wordRep)
 260         MO_U_Ge r -> CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordRep)
 261         MO_U_Lt r -> CmmLit (CmmInt (if x_u <  y_u then 1 else 0) wordRep)
 262         MO_U_Le r -> CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordRep)
 263
 264         MO_S_Gt r -> CmmLit (CmmInt (if x_s >  y_s then 1 else 0) wordRep)
 265         MO_S_Ge r -> CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordRep)
 266         MO_S_Lt r -> CmmLit (CmmInt (if x_s <  y_s then 1 else 0) wordRep)
 267         MO_S_Le r -> CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordRep)
 268
 269         MO_Add r -> CmmLit (CmmInt (x + y) r)
 270         MO_Sub r -> CmmLit (CmmInt (x - y) r)
 271         MO_Mul r -> CmmLit (CmmInt (x * y) r)
 272         MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
 273         MO_S_Rem  r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
 274
 275         MO_And   r -> CmmLit (CmmInt (x .&. y) r)
 276         MO_Or    r -> CmmLit (CmmInt (x .|. y) r)
 277         MO_Xor   r -> CmmLit (CmmInt (x `xor` y) r)
 278
 279         MO_Shl   r -> CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
 280         MO_U_Shr r -> CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
 281         MO_S_Shr r -> CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
 282
 283         other      -> CmmMachOp mop args
 284
 285    where
 286         x_u = narrowU xrep x
 287         y_u = narrowU xrep y
 288         x_s = narrowS xrep x
 289         y_s = narrowS xrep y
 290
 291
 292 -- When possible, shift the constants to the right-hand side, so that we
 293 -- can match for strength reductions.  Note that the code generator will
 294 -- also assume that constants have been shifted to the right when
 295 -- possible.
 296
 297 cmmMachOpFold op [x@(CmmLit _), y]
 298    | not (isLit y) && isCommutableMachOp op
 299    = cmmMachOpFold op [y, x]
 300
 301 -- Turn (a+b)+c into a+(b+c) where possible.  Because literals are
 302 -- moved to the right, it is more likely that we will find
 303 -- opportunities for constant folding when the expression is
 304 -- right-associated.
 305 --
 306 -- ToDo: this appears to introduce a quadratic behaviour due to the
 307 -- nested cmmMachOpFold.  Can we fix this?
 308 --
 309 -- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2
 310 -- is also a lit (otherwise arg1 would be on the right).  If we
 311 -- put arg1 on the left of the rearranged expression, we'll get into a
 312 -- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...
 313 --
 314 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
 315    | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
 316    = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
 317
 318 -- Make a RegOff if we can
 319 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
 320   = CmmRegOff reg (fromIntegral (narrowS rep n))
 321 cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 322   = CmmRegOff reg (off + fromIntegral (narrowS rep n))
 323 cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
 324   = CmmRegOff reg (- fromIntegral (narrowS rep n))
 325 cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 326   = CmmRegOff reg (off - fromIntegral (narrowS rep n))
 327
 328 -- Fold label(+/-)offset into a CmmLit where possible
 329
 330 cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 331   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 332 cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
 333   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 334 cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 335   = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
 336
 337 -- We can often do something with constants of 0 and 1 ...
 338
 339 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
 340   = case mop of
 341         MO_Add   r -> x
 342         MO_Sub   r -> x
 343         MO_Mul   r -> y
 344         MO_And   r -> y
 345         MO_Or    r -> x
 346         MO_Xor   r -> x
 347         MO_Shl   r -> x
 348         MO_S_Shr r -> x
 349         MO_U_Shr r -> x
 350         MO_Ne    r | isComparisonExpr x -> x
 351         MO_Eq    r | Just x' <- maybeInvertConditionalExpr x -> x'
 352         MO_U_Gt  r | isComparisonExpr x -> x
 353         MO_S_Gt  r | isComparisonExpr x -> x
 354         MO_U_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 355         MO_S_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 356         MO_U_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 357         MO_S_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 358         MO_U_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 359         MO_S_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 360         other    -> CmmMachOp mop args
 361
 362 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
 363   = case mop of
 364         MO_Mul    r -> x
 365         MO_S_Quot r -> x
 366         MO_U_Quot r -> x
 367         MO_S_Rem  r -> CmmLit (CmmInt 0 rep)
 368         MO_U_Rem  r -> CmmLit (CmmInt 0 rep)
 369         MO_Ne    r | Just x' <- maybeInvertConditionalExpr x -> x'
 370         MO_Eq    r | isComparisonExpr x -> x
 371         MO_U_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 372         MO_S_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 373         MO_U_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 374         MO_S_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 375         MO_U_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 376         MO_S_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 377         MO_U_Ge  r | isComparisonExpr x -> x
 378         MO_S_Ge  r | isComparisonExpr x -> x
 379         other       -> CmmMachOp mop args
 380
 381 -- Now look for multiplication/division by powers of 2 (integers).
 382
 383 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
 384   = case mop of
 385         MO_Mul rep
 386            | Just p <- exactLog2 n ->
 387                  CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
 388         MO_S_Quot rep
 389            | Just p <- exactLog2 n,
 390              CmmReg _ <- x ->   -- We duplicate x below, hence require
 391                                 -- it is a reg.  FIXME: remove this restriction.
 392                 -- shift right is not the same as quot, because it rounds
 393                 -- to minus infinity, whereasq uot rounds toward zero.
 394                 -- To fix this up, we add one less than the divisor to the
 395                 -- dividend if it is a negative number.
 396                 --
 397                 -- to avoid a test/jump, we use the following sequence:
 398                 --      x1 = x >> word_size-1  (all 1s if -ve, all 0s if +ve)
 399                 --      x2 = y & (divisor-1)
 400                 --      result = (x+x2) >>= log2(divisor)
 401                 -- this could be done a bit more simply using conditional moves,
 402                 -- but we're processor independent here.
 403                 --
 404                 -- we optimise the divide by 2 case slightly, generating
 405                 --      x1 = x >> word_size-1  (unsigned)
 406                 --      return = (x + x1) >>= log2(divisor)
 407                 let
 408                     bits = fromIntegral (machRepBitWidth rep) - 1
 409                     shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
 410                     x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
 411                     x2 = if p == 1 then x1 else
 412                          CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
 413                     x3 = CmmMachOp (MO_Add rep) [x, x2]
 414                 in
 415                 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
 416         other
 417            -> unchanged
 418     where
 419        unchanged = CmmMachOp mop args
 420
 421 -- Anything else is just too hard.
 422
 423 cmmMachOpFold mop args = CmmMachOp mop args
 424
 425 -- -----------------------------------------------------------------------------
 426 -- exactLog2
 427
 428 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
 429 -- from GCC.  It requires bit manipulation primitives, and we use GHC
 430 -- extensions.  Tough.
 431 --
 432 -- Used to be in MachInstrs --SDM.
 433 -- ToDo: remove use of unboxery --SDM.
 434
 435 w2i x = word2Int# x
 436 i2w x = int2Word# x
 437
 438 exactLog2 :: Integer -> Maybe Integer
 439 exactLog2 x
 440   = if (x <= 0 || x >= 2147483648) then
 441        Nothing
 442     else
 443        case fromInteger x of { I# x# ->
 444        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
 445           Nothing
 446        else
 447           Just (toInteger (I# (pow2 x#)))
 448        }
 449   where
 450     pow2 x# | x# ==# 1# = 0#
 451             | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 452
 453
 454 -- -----------------------------------------------------------------------------
 455 -- widening / narrowing
 456
 457 narrowU :: MachRep -> Integer -> Integer
 458 narrowU I8  x = fromIntegral (fromIntegral x :: Word8)
 459 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
 460 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
 461 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
 462 narrowU _ _ = panic "narrowTo"
 463
 464 narrowS :: MachRep -> Integer -> Integer
 465 narrowS I8  x = fromIntegral (fromIntegral x :: Int8)
 466 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
 467 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
 468 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
 469 narrowS _ _ = panic "narrowTo"
 470
 471 -- -----------------------------------------------------------------------------
 472 -- Loopify for C
 473
 474 {-
 475  This is a simple pass that replaces tail-recursive functions like this:
 476
 477    fac() {
 478      ...
 479      jump fac();
 480    }
 481
 482  with this:
 483
 484   fac() {
 485    L:
 486      ...
 487      goto L;
 488   }
 489
 490   the latter generates better C code, because the C compiler treats it
 491   like a loop, and brings full loop optimisation to bear.
 492
 493   In my measurements this makes little or no difference to anything
 494   except factorial, but what the hell.
 495 -}
 496
 497 cmmLoopifyForC :: CmmTop -> CmmTop
 498 cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
 499   | null info = p  -- only if there's an info table, ignore case alts
 500   | otherwise =
 501 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
 502   CmmProc info entry_lbl [] blocks'
 503   where blocks' = [ BasicBlock id (map do_stmt stmts)
 504                   | BasicBlock id stmts <- blocks ]
 505
 506         do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
 507                 = CmmBranch top_id
 508         do_stmt stmt = stmt
 509
 510         jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
 511                  | otherwise        = entry_lbl
 512
 513 cmmLoopifyForC top = top
 514
 515 -- -----------------------------------------------------------------------------
 516 -- Utils
 517
 518 isLit (CmmLit _) = True
 519 isLit _          = False
 520
 521 isComparisonExpr :: CmmExpr -> Bool
 522 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 523 isComparisonExpr _other             = False
 524
 525 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
 526 maybeInvertConditionalExpr (CmmMachOp op args)
 527   | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
 528 maybeInvertConditionalExpr _ = Nothing