compiler/cmm/CmmUtils.hs

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