compiler/cmm/CmmUtils.hs

   1 {-# OPTIONS -w #-}
   2 -- The above warning supression flag is a temporary kludge.
   3 -- While working on this module you are encouraged to remove it and fix
   4 -- any warnings in the module. See
   5 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
   6 -- for details
   7
   8 -----------------------------------------------------------------------------
   9 --
  10 -- Cmm utilities.
  11 --
  12 -- (c) The University of Glasgow 2004-2006
  13 --
  14 -----------------------------------------------------------------------------
  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 e                 0        = e
 132 cmmOffset (CmmReg reg)      byte_off = cmmRegOff reg byte_off
 133 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
 134 cmmOffset (CmmLit lit)      byte_off = CmmLit (cmmOffsetLit lit byte_off)
 135 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
 136   = CmmMachOp (MO_Add rep)
 137               [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
 138 cmmOffset expr byte_off
 139   = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
 140   where
 141     rep = cmmExprRep expr
 142
 143 -- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.
 144 cmmRegOff :: CmmReg -> Int -> CmmExpr
 145 cmmRegOff reg byte_off = CmmRegOff reg byte_off
 146
 147 cmmOffsetLit :: CmmLit -> Int -> CmmLit
 148 cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff   l byte_off
 149 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff   l (m+byte_off)
 150 cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
 151 cmmOffsetLit other             byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
 152
 153 cmmLabelOff :: CLabel -> Int -> CmmLit
 154 -- Smart constructor for CmmLabelOff
 155 cmmLabelOff lbl 0        = CmmLabel lbl
 156 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
 157
 158 -- | Useful for creating an index into an array, with a staticaly known offset.
 159 cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
 160 cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
 161
 162 -- | Useful for creating an index into an array, with an unknown offset.
 163 cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
 164 cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
 165 cmmIndexExpr rep base idx =
 166   cmmOffsetExpr base byte_off
 167   where
 168     idx_rep = cmmExprRep idx
 169     byte_off = CmmMachOp (MO_Shl idx_rep) [
 170                   idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
 171
 172 cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
 173 cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
 174
 175 ---------------------------------------------------
 176 --
 177 --      Literal construction functions
 178 --
 179 ---------------------------------------------------
 180
 181 mkIntCLit :: Int -> CmmLit
 182 mkIntCLit i = CmmInt (toInteger i) wordRep
 183
 184 zeroCLit :: CmmLit
 185 zeroCLit = CmmInt 0 wordRep
 186
 187 mkLblExpr :: CLabel -> CmmExpr
 188 mkLblExpr lbl = CmmLit (CmmLabel lbl)
 189
 190 ---------------------------------------------------
 191 --
 192 --      Helpers for foreign call arguments
 193 --
 194 ---------------------------------------------------
 195
 196 loadArgsIntoTemps :: [Unique]
 197                   -> CmmActuals
 198                   -> ([Unique], [CmmStmt], CmmActuals)
 199 loadArgsIntoTemps uniques [] = (uniques, [], [])
 200 loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
 201     (uniques'',
 202      new_stmts ++ remaining_stmts,
 203      (CmmHinted new_e hint) : remaining_e)
 204     where
 205       (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
 206       (uniques'', remaining_stmts, remaining_e) =
 207           loadArgsIntoTemps uniques' args
 208
 209 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
 210 maybeAssignTemp uniques e
 211     | hasNoGlobalRegs e = (uniques, [], e)
 212     | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
 213     where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) GCKindNonPtr)