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         primRepCmmType, primRepForeignHint,
  21         typeCmmType, typeForeignHint,
  22
  23         isTrivialCmmExpr, hasNoGlobalRegs,
  24
  25         cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
  26         cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
  27
  28         mkIntCLit, zeroCLit,
  29
  30         mkLblExpr,
  31
  32         maybeAssignTemp, loadArgsIntoTemps
  33   ) where
  34
  35 #include "HsVersions.h"
  36
  37 import TyCon    ( PrimRep(..) )
  38 import Type     ( Type, typePrimRep )
  39
  40 import CLabel
  41 import Cmm
  42 import OrdList
  43 import Outputable
  44 import Unique
  45
  46 ---------------------------------------------------
  47 --
  48 --      CmmTypes
  49 --
  50 ---------------------------------------------------
  51
  52 primRepCmmType :: PrimRep -> CmmType
  53 primRepCmmType VoidRep    = panic "primRepCmmType:VoidRep"
  54 primRepCmmType PtrRep     = gcWord
  55 primRepCmmType IntRep     = bWord
  56 primRepCmmType WordRep    = bWord
  57 primRepCmmType Int64Rep   = b64
  58 primRepCmmType Word64Rep  = b64
  59 primRepCmmType AddrRep    = bWord
  60 primRepCmmType FloatRep   = f32
  61 primRepCmmType DoubleRep  = f64
  62
  63 typeCmmType :: Type -> CmmType
  64 typeCmmType ty = primRepCmmType (typePrimRep ty)
  65
  66 primRepForeignHint :: PrimRep -> ForeignHint
  67 primRepForeignHint VoidRep      = panic "primRepForeignHint:VoidRep"
  68 primRepForeignHint PtrRep       = AddrHint
  69 primRepForeignHint IntRep       = SignedHint
  70 primRepForeignHint WordRep      = NoHint
  71 primRepForeignHint Int64Rep     = SignedHint
  72 primRepForeignHint Word64Rep    = NoHint
  73 primRepForeignHint AddrRep     = AddrHint -- NB! AddrHint, but NonPtrArg
  74 primRepForeignHint FloatRep     = NoHint
  75 primRepForeignHint DoubleRep    = NoHint
  76
  77 typeForeignHint :: Type -> ForeignHint
  78 typeForeignHint = primRepForeignHint . typePrimRep
  79
  80
  81 ---------------------------------------------------
  82 --
  83 --      CmmStmts
  84 --
  85 ---------------------------------------------------
  86
  87 type CmmStmts = OrdList CmmStmt
  88
  89 noStmts :: CmmStmts
  90 noStmts = nilOL
  91
  92 oneStmt :: CmmStmt -> CmmStmts
  93 oneStmt = unitOL
  94
  95 mkStmts :: [CmmStmt] -> CmmStmts
  96 mkStmts = toOL
  97
  98 plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
  99 plusStmts = appOL
 100
 101 stmtList :: CmmStmts -> [CmmStmt]
 102 stmtList = fromOL
 103
 104
 105 ---------------------------------------------------
 106 --
 107 --      CmmStmt
 108 --
 109 ---------------------------------------------------
 110
 111 isNopStmt :: CmmStmt -> Bool
 112 -- If isNopStmt returns True, the stmt is definitely a no-op;
 113 -- but it might be a no-op even if isNopStmt returns False
 114 isNopStmt CmmNop                       = True
 115 isNopStmt (CmmAssign r e)              = cheapEqReg r e
 116 isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
 117 isNopStmt s                            = False
 118
 119 cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
 120 cheapEqExpr (CmmReg r)      e                 = cheapEqReg r e
 121 cheapEqExpr (CmmRegOff r 0) e                 = cheapEqReg r e
 122 cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
 123 cheapEqExpr e1              e2                = False
 124
 125 cheapEqReg :: CmmReg -> CmmExpr -> Bool
 126 cheapEqReg r (CmmReg r')      = r==r'
 127 cheapEqReg r (CmmRegOff r' 0) = r==r'
 128 cheapEqReg r e                = False
 129
 130 ---------------------------------------------------
 131 --
 132 --      CmmExpr
 133 --
 134 ---------------------------------------------------
 135
 136 isTrivialCmmExpr :: CmmExpr -> Bool
 137 isTrivialCmmExpr (CmmLoad _ _)   = False
 138 isTrivialCmmExpr (CmmMachOp _ _) = False
 139 isTrivialCmmExpr (CmmLit _)      = True
 140 isTrivialCmmExpr (CmmReg _)      = True
 141 isTrivialCmmExpr (CmmRegOff _ _) = True
 142
 143 hasNoGlobalRegs :: CmmExpr -> Bool
 144 hasNoGlobalRegs (CmmLoad e _)              = hasNoGlobalRegs e
 145 hasNoGlobalRegs (CmmMachOp _ es)           = all hasNoGlobalRegs es
 146 hasNoGlobalRegs (CmmLit _)                 = True
 147 hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
 148 hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
 149 hasNoGlobalRegs _ = False
 150
 151 ---------------------------------------------------
 152 --
 153 --      Expr Construction helpers
 154 --
 155 ---------------------------------------------------
 156
 157 cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
 158 -- assumes base and offset have the same CmmType
 159 cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
 160 cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprWidth e)) [e, byte_off]
 161
 162 -- NB. Do *not* inspect the value of the offset in these smart constructors!!!
 163 -- because the offset is sometimes involved in a loop in the code generator
 164 -- (we don't know the real Hp offset until we've generated code for the entire
 165 -- basic block, for example).  So we cannot eliminate zero offsets at this
 166 -- stage; they're eliminated later instead (either during printing or
 167 -- a later optimisation step on Cmm).
 168 --
 169 cmmOffset :: CmmExpr -> Int -> CmmExpr
 170 cmmOffset e                 0        = e
 171 cmmOffset (CmmReg reg)      byte_off = cmmRegOff reg byte_off
 172 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
 173 cmmOffset (CmmLit lit)      byte_off = CmmLit (cmmOffsetLit lit byte_off)
 174 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
 175   = CmmMachOp (MO_Add rep)
 176               [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
 177 cmmOffset expr byte_off
 178   = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]
 179   where
 180     width = cmmExprWidth expr
 181
 182 -- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.
 183 cmmRegOff :: CmmReg -> Int -> CmmExpr
 184 cmmRegOff reg byte_off = CmmRegOff reg byte_off
 185
 186 cmmOffsetLit :: CmmLit -> Int -> CmmLit
 187 cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff   l byte_off
 188 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff   l (m+byte_off)
 189 cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
 190 cmmOffsetLit other             byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
 191
 192 cmmLabelOff :: CLabel -> Int -> CmmLit
 193 -- Smart constructor for CmmLabelOff
 194 cmmLabelOff lbl 0        = CmmLabel lbl
 195 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
 196
 197 -- | Useful for creating an index into an array, with a staticaly known offset.
 198 -- The type is the element type; used for making the multiplier
 199 cmmIndex :: Width       -- Width w
 200          -> CmmExpr     -- Address of vector of items of width w
 201          -> Int         -- Which element of the vector (0 based)
 202          -> CmmExpr     -- Address of i'th element
 203 cmmIndex width base idx = cmmOffset base (idx * widthInBytes width)
 204
 205 -- | Useful for creating an index into an array, with an unknown offset.
 206 cmmIndexExpr :: Width           -- Width w
 207              -> CmmExpr         -- Address of vector of items of width w
 208              -> CmmExpr         -- Which element of the vector (0 based)
 209              -> CmmExpr         -- Address of i'th element
 210 cmmIndexExpr width base (CmmLit (CmmInt n _)) = cmmIndex width base (fromInteger n)
 211 cmmIndexExpr width base idx =
 212   cmmOffsetExpr base byte_off
 213   where
 214     idx_w = cmmExprWidth idx
 215     byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))]
 216
 217 cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
 218 cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
 219
 220 ---------------------------------------------------
 221 --
 222 --      Literal construction functions
 223 --
 224 ---------------------------------------------------
 225
 226 mkIntCLit :: Int -> CmmLit
 227 mkIntCLit i = CmmInt (toInteger i) wordWidth
 228
 229 zeroCLit :: CmmLit
 230 zeroCLit = CmmInt 0 wordWidth
 231
 232 mkLblExpr :: CLabel -> CmmExpr
 233 mkLblExpr lbl = CmmLit (CmmLabel lbl)
 234
 235 ---------------------------------------------------
 236 --
 237 --      Helpers for foreign call arguments
 238 --
 239 ---------------------------------------------------
 240
 241 loadArgsIntoTemps :: [Unique]
 242                   -> HintedCmmActuals
 243                   -> ([Unique], [CmmStmt], HintedCmmActuals)
 244 loadArgsIntoTemps uniques [] = (uniques, [], [])
 245 loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
 246     (uniques'',
 247      new_stmts ++ remaining_stmts,
 248      (CmmHinted new_e hint) : remaining_e)
 249     where
 250       (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
 251       (uniques'', remaining_stmts, remaining_e) =
 252           loadArgsIntoTemps uniques' args
 253
 254
 255 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
 256 maybeAssignTemp uniques e
 257     | hasNoGlobalRegs e = (uniques, [], e)
 258     | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
 259     where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))