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