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)
 165    = CmmCall (infn target) regs es'
 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
 343 -- Comparison of literal with narrowed/widened operand: perform
 344 -- the comparison at a different width, as long as the literal is
 345 -- within range.
 346
 347 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 348 -- powerPC NCG has a TODO for I8/I16 comparisons, so don't try
 349
 350 cmmMachOpFold cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
 351   | Just (rep, narrow) <- maybe_conversion conv,
 352     Just narrow_cmp <- maybe_comparison cmp rep,
 353     let narrow_i = narrow rep i,
 354     narrow_i == i
 355   = cmmMachOpFold narrow_cmp [x, CmmLit (CmmInt narrow_i rep)]
 356  where
 357     maybe_conversion (MO_U_Conv from _) = Just (from, narrowU)
 358     maybe_conversion (MO_S_Conv from _) = Just (from, narrowS)
 359     maybe_conversion _ = Nothing
 360
 361     maybe_comparison (MO_U_Gt _) rep = Just (MO_U_Gt rep)
 362     maybe_comparison (MO_U_Ge _) rep = Just (MO_U_Ge rep)
 363     maybe_comparison (MO_U_Lt _) rep = Just (MO_U_Lt rep)
 364     maybe_comparison (MO_U_Le _) rep = Just (MO_U_Le rep)
 365     maybe_comparison (MO_S_Gt _) rep = Just (MO_S_Gt rep)
 366     maybe_comparison (MO_S_Ge _) rep = Just (MO_S_Ge rep)
 367     maybe_comparison (MO_S_Lt _) rep = Just (MO_S_Lt rep)
 368     maybe_comparison (MO_S_Le _) rep = Just (MO_S_Le rep)
 369     maybe_comparison (MO_Eq   _) rep = Just (MO_Eq   rep)
 370     maybe_comparison _ _ = Nothing
 371
 372 #endif
 373
 374 -- We can often do something with constants of 0 and 1 ...
 375
 376 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
 377   = case mop of
 378         MO_Add   r -> x
 379         MO_Sub   r -> x
 380         MO_Mul   r -> y
 381         MO_And   r -> y
 382         MO_Or    r -> x
 383         MO_Xor   r -> x
 384         MO_Shl   r -> x
 385         MO_S_Shr r -> x
 386         MO_U_Shr r -> x
 387         MO_Ne    r | isComparisonExpr x -> x
 388         MO_Eq    r | Just x' <- maybeInvertConditionalExpr x -> x'
 389         MO_U_Gt  r | isComparisonExpr x -> x
 390         MO_S_Gt  r | isComparisonExpr x -> x
 391         MO_U_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 392         MO_S_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 393         MO_U_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 394         MO_S_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 395         MO_U_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 396         MO_S_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 397         other    -> CmmMachOp mop args
 398
 399 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
 400   = case mop of
 401         MO_Mul    r -> x
 402         MO_S_Quot r -> x
 403         MO_U_Quot r -> x
 404         MO_S_Rem  r -> CmmLit (CmmInt 0 rep)
 405         MO_U_Rem  r -> CmmLit (CmmInt 0 rep)
 406         MO_Ne    r | Just x' <- maybeInvertConditionalExpr x -> x'
 407         MO_Eq    r | isComparisonExpr x -> x
 408         MO_U_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 409         MO_S_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 410         MO_U_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 411         MO_S_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 412         MO_U_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 413         MO_S_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 414         MO_U_Ge  r | isComparisonExpr x -> x
 415         MO_S_Ge  r | isComparisonExpr x -> x
 416         other       -> CmmMachOp mop args
 417
 418 -- Now look for multiplication/division by powers of 2 (integers).
 419
 420 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
 421   = case mop of
 422         MO_Mul rep
 423            | Just p <- exactLog2 n ->
 424                  CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
 425         MO_S_Quot rep
 426            | Just p <- exactLog2 n,
 427              CmmReg _ <- x ->   -- We duplicate x below, hence require
 428                                 -- it is a reg.  FIXME: remove this restriction.
 429                 -- shift right is not the same as quot, because it rounds
 430                 -- to minus infinity, whereasq uot rounds toward zero.
 431                 -- To fix this up, we add one less than the divisor to the
 432                 -- dividend if it is a negative number.
 433                 --
 434                 -- to avoid a test/jump, we use the following sequence:
 435                 --      x1 = x >> word_size-1  (all 1s if -ve, all 0s if +ve)
 436                 --      x2 = y & (divisor-1)
 437                 --      result = (x+x2) >>= log2(divisor)
 438                 -- this could be done a bit more simply using conditional moves,
 439                 -- but we're processor independent here.
 440                 --
 441                 -- we optimise the divide by 2 case slightly, generating
 442                 --      x1 = x >> word_size-1  (unsigned)
 443                 --      return = (x + x1) >>= log2(divisor)
 444                 let
 445                     bits = fromIntegral (machRepBitWidth rep) - 1
 446                     shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
 447                     x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
 448                     x2 = if p == 1 then x1 else
 449                          CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
 450                     x3 = CmmMachOp (MO_Add rep) [x, x2]
 451                 in
 452                 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
 453         other
 454            -> unchanged
 455     where
 456        unchanged = CmmMachOp mop args
 457
 458 -- Anything else is just too hard.
 459
 460 cmmMachOpFold mop args = CmmMachOp mop args
 461
 462 -- -----------------------------------------------------------------------------
 463 -- exactLog2
 464
 465 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
 466 -- from GCC.  It requires bit manipulation primitives, and we use GHC
 467 -- extensions.  Tough.
 468 --
 469 -- Used to be in MachInstrs --SDM.
 470 -- ToDo: remove use of unboxery --SDM.
 471
 472 w2i x = word2Int# x
 473 i2w x = int2Word# x
 474
 475 exactLog2 :: Integer -> Maybe Integer
 476 exactLog2 x
 477   = if (x <= 0 || x >= 2147483648) then
 478        Nothing
 479     else
 480        case fromInteger x of { I# x# ->
 481        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
 482           Nothing
 483        else
 484           Just (toInteger (I# (pow2 x#)))
 485        }
 486   where
 487     pow2 x# | x# ==# 1# = 0#
 488             | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 489
 490
 491 -- -----------------------------------------------------------------------------
 492 -- widening / narrowing
 493
 494 narrowU :: MachRep -> Integer -> Integer
 495 narrowU I8  x = fromIntegral (fromIntegral x :: Word8)
 496 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
 497 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
 498 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
 499 narrowU _ _ = panic "narrowTo"
 500
 501 narrowS :: MachRep -> Integer -> Integer
 502 narrowS I8  x = fromIntegral (fromIntegral x :: Int8)
 503 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
 504 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
 505 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
 506 narrowS _ _ = panic "narrowTo"
 507
 508 -- -----------------------------------------------------------------------------
 509 -- Loopify for C
 510
 511 {-
 512  This is a simple pass that replaces tail-recursive functions like this:
 513
 514    fac() {
 515      ...
 516      jump fac();
 517    }
 518
 519  with this:
 520
 521   fac() {
 522    L:
 523      ...
 524      goto L;
 525   }
 526
 527   the latter generates better C code, because the C compiler treats it
 528   like a loop, and brings full loop optimisation to bear.
 529
 530   In my measurements this makes little or no difference to anything
 531   except factorial, but what the hell.
 532 -}
 533
 534 cmmLoopifyForC :: CmmTop -> CmmTop
 535 cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
 536   | null info = p  -- only if there's an info table, ignore case alts
 537   | otherwise =
 538 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
 539   CmmProc info entry_lbl [] blocks'
 540   where blocks' = [ BasicBlock id (map do_stmt stmts)
 541                   | BasicBlock id stmts <- blocks ]
 542
 543         do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
 544                 = CmmBranch top_id
 545         do_stmt stmt = stmt
 546
 547         jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
 548                  | otherwise        = entry_lbl
 549
 550 cmmLoopifyForC top = top
 551
 552 -- -----------------------------------------------------------------------------
 553 -- Utils
 554
 555 isLit (CmmLit _) = True
 556 isLit _          = False
 557
 558 isComparisonExpr :: CmmExpr -> Bool
 559 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 560 isComparisonExpr _other             = False
 561
 562 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
 563 maybeInvertConditionalExpr (CmmMachOp op args)
 564   | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
 565 maybeInvertConditionalExpr _ = Nothing
 566
 567 isPicReg (CmmReg (CmmGlobal PicBaseReg)) = True
 568 isPicReg _ = False