compiler/cmm/CmmUtils.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Cmm utilities.
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 {-# OPTIONS_GHC -w #-}
  10 -- The above warning supression flag is a temporary kludge.
  11 -- While working on this module you are encouraged to remove it and fix
  12 -- any warnings in the module. See
  13 --     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
  14 -- for details
  15
  16 module CmmUtils(
  17         CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
  18         isNopStmt,
  19
  20         isTrivialCmmExpr, hasNoGlobalRegs,
  21
  22         cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
  23         cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
  24
  25         mkIntCLit, zeroCLit,
  26
  27         mkLblExpr,
  28
  29         loadArgsIntoTemps, maybeAssignTemp,
  30   ) where
  31
  32 #include "HsVersions.h"
  33
  34 import CLabel
  35 import Cmm
  36 import MachOp
  37 import OrdList
  38 import Outputable
  39 import Unique
  40
  41 ---------------------------------------------------
  42 --
  43 --      CmmStmts
  44 --
  45 ---------------------------------------------------
  46
  47 type CmmStmts = OrdList CmmStmt
  48
  49 noStmts :: CmmStmts
  50 noStmts = nilOL
  51
  52 oneStmt :: CmmStmt -> CmmStmts
  53 oneStmt = unitOL
  54
  55 mkStmts :: [CmmStmt] -> CmmStmts
  56 mkStmts = toOL
  57
  58 plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
  59 plusStmts = appOL
  60
  61 stmtList :: CmmStmts -> [CmmStmt]
  62 stmtList = fromOL
  63
  64
  65 ---------------------------------------------------
  66 --
  67 --      CmmStmt
  68 --
  69 ---------------------------------------------------
  70
  71 isNopStmt :: CmmStmt -> Bool
  72 -- If isNopStmt returns True, the stmt is definitely a no-op;
  73 -- but it might be a no-op even if isNopStmt returns False
  74 isNopStmt CmmNop                       = True
  75 isNopStmt (CmmAssign r e)              = cheapEqReg r e
  76 isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
  77 isNopStmt s                            = False
  78
  79 cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
  80 cheapEqExpr (CmmReg r)      e                 = cheapEqReg r e
  81 cheapEqExpr (CmmRegOff r 0) e                 = cheapEqReg r e
  82 cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
  83 cheapEqExpr e1              e2                = False
  84
  85 cheapEqReg :: CmmReg -> CmmExpr -> Bool
  86 cheapEqReg r (CmmReg r')      = r==r'
  87 cheapEqReg r (CmmRegOff r' 0) = r==r'
  88 cheapEqReg r e                = False
  89
  90 ---------------------------------------------------
  91 --
  92 --      CmmExpr
  93 --
  94 ---------------------------------------------------
  95
  96 isTrivialCmmExpr :: CmmExpr -> Bool
  97 isTrivialCmmExpr (CmmLoad _ _)   = False
  98 isTrivialCmmExpr (CmmMachOp _ _) = False
  99 isTrivialCmmExpr (CmmLit _)      = True
 100 isTrivialCmmExpr (CmmReg _)      = True
 101 isTrivialCmmExpr (CmmRegOff _ _) = True
 102
 103 hasNoGlobalRegs :: CmmExpr -> Bool
 104 hasNoGlobalRegs (CmmLoad e _)              = hasNoGlobalRegs e
 105 hasNoGlobalRegs (CmmMachOp _ es)           = all hasNoGlobalRegs es
 106 hasNoGlobalRegs (CmmLit _)                 = True
 107 hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
 108 hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
 109 hasNoGlobalRegs _ = False
 110
 111 ---------------------------------------------------
 112 --
 113 --      Expr Construction helpers
 114 --
 115 ---------------------------------------------------
 116
 117 cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
 118 -- assumes base and offset have the same MachRep
 119 cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
 120 cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprRep e)) [e, byte_off]
 121
 122 -- NB. Do *not* inspect the value of the offset in these smart constructors!!!
 123 --
 124 -- because the offset is sometimes involved in a loop in the code generator
 125 -- (we don't know the real Hp offset until we've generated code for the entire
 126 -- basic block, for example).  So we cannot eliminate zero offsets at this
 127 -- stage; they're eliminated later instead (either during printing or
 128 -- a later optimisation step on Cmm).
 129 --
 130 cmmOffset :: CmmExpr -> Int -> CmmExpr
 131 cmmOffset (CmmReg reg)      byte_off = cmmRegOff reg byte_off
 132 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
 133 cmmOffset (CmmLit lit)      byte_off = CmmLit (cmmOffsetLit lit byte_off)
 134 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
 135   = CmmMachOp (MO_Add rep)
 136               [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
 137 cmmOffset expr byte_off
 138   = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
 139   where
 140     rep = cmmExprRep expr
 141
 142 -- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.
 143 cmmRegOff :: CmmReg -> Int -> CmmExpr
 144 cmmRegOff reg byte_off = CmmRegOff reg byte_off
 145
 146 cmmOffsetLit :: CmmLit -> Int -> CmmLit
 147 cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff   l byte_off
 148 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff   l (m+byte_off)
 149 cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
 150 cmmOffsetLit other             byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
 151
 152 cmmLabelOff :: CLabel -> Int -> CmmLit
 153 -- Smart constructor for CmmLabelOff
 154 cmmLabelOff lbl 0        = CmmLabel lbl
 155 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
 156
 157 -- | Useful for creating an index into an array, with a staticaly known offset.
 158 cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
 159 cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
 160
 161 -- | Useful for creating an index into an array, with an unknown offset.
 162 cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
 163 cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
 164 cmmIndexExpr rep base idx =
 165   cmmOffsetExpr base byte_off
 166   where
 167     idx_rep = cmmExprRep idx
 168     byte_off = CmmMachOp (MO_Shl idx_rep) [
 169                   idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
 170
 171 cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
 172 cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
 173
 174 ---------------------------------------------------
 175 --
 176 --      Literal construction functions
 177 --
 178 ---------------------------------------------------
 179
 180 mkIntCLit :: Int -> CmmLit
 181 mkIntCLit i = CmmInt (toInteger i) wordRep
 182
 183 zeroCLit :: CmmLit
 184 zeroCLit = CmmInt 0 wordRep
 185
 186 mkLblExpr :: CLabel -> CmmExpr
 187 mkLblExpr lbl = CmmLit (CmmLabel lbl)
 188
 189 ---------------------------------------------------
 190 --
 191 --      Helpers for foreign call arguments
 192 --
 193 ---------------------------------------------------
 194
 195 loadArgsIntoTemps :: [Unique]
 196                   -> CmmActuals
 197                   -> ([Unique], [CmmStmt], CmmActuals)
 198 loadArgsIntoTemps uniques [] = (uniques, [], [])
 199 loadArgsIntoTemps uniques ((e, hint):args) =
 200     (uniques'',
 201      new_stmts ++ remaining_stmts,
 202      (new_e, hint) : remaining_e)
 203     where
 204       (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
 205       (uniques'', remaining_stmts, remaining_e) =
 206           loadArgsIntoTemps uniques' args
 207
 208 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
 209 maybeAssignTemp uniques e
 210     | hasNoGlobalRegs e = (uniques, [], e)
 211     | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
 212     where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) KindNonPtr)