CmmUtils.hs 8.09 KB
Newer Older
1 2 3 4
-----------------------------------------------------------------------------
--
-- Cmm utilities.
--
Simon Marlow's avatar
Simon Marlow committed
5
-- (c) The University of Glasgow 2004-2006
6 7 8
--
-----------------------------------------------------------------------------

9
module CmmUtils(
10 11 12
	CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
	isNopStmt,

13 14 15
	primRepCmmType, primRepForeignHint,
	typeCmmType, typeForeignHint,

16
	isTrivialCmmExpr, hasNoGlobalRegs,
17 18 19 20 21 22 23

	cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
	cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,

 	mkIntCLit, zeroCLit,

	mkLblExpr,
24

25
        maybeAssignTemp, loadArgsIntoTemps
26 27 28 29
  ) where

#include "HsVersions.h"

30 31 32
import TyCon	( PrimRep(..) )
import Type	( Type, typePrimRep )

Simon Marlow's avatar
Simon Marlow committed
33
import CLabel
34 35 36
import Cmm
import OrdList
import Outputable
37
import Unique
38

39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
---------------------------------------------------
--
--	CmmTypes
--
---------------------------------------------------

primRepCmmType :: PrimRep -> CmmType
primRepCmmType VoidRep    = panic "primRepCmmType:VoidRep"
primRepCmmType PtrRep     = gcWord
primRepCmmType IntRep	  = bWord
primRepCmmType WordRep	  = bWord
primRepCmmType Int64Rep   = b64
primRepCmmType Word64Rep  = b64
primRepCmmType AddrRep    = bWord
primRepCmmType FloatRep   = f32
primRepCmmType DoubleRep  = f64

typeCmmType :: Type -> CmmType
typeCmmType ty = primRepCmmType (typePrimRep ty)

primRepForeignHint :: PrimRep -> ForeignHint
primRepForeignHint VoidRep	= panic "primRepForeignHint:VoidRep"
primRepForeignHint PtrRep	= AddrHint
primRepForeignHint IntRep	= SignedHint
primRepForeignHint WordRep	= NoHint
primRepForeignHint Int64Rep	= SignedHint
primRepForeignHint Word64Rep	= NoHint
66
primRepForeignHint AddrRep      = AddrHint -- NB! AddrHint, but NonPtrArg
67 68 69 70 71 72 73
primRepForeignHint FloatRep	= NoHint
primRepForeignHint DoubleRep	= NoHint

typeForeignHint :: Type -> ForeignHint
typeForeignHint = primRepForeignHint . typePrimRep


74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
---------------------------------------------------
--
--	CmmStmts
--
---------------------------------------------------

type CmmStmts = OrdList CmmStmt

noStmts :: CmmStmts
noStmts = nilOL

oneStmt :: CmmStmt -> CmmStmts
oneStmt = unitOL

mkStmts :: [CmmStmt] -> CmmStmts
mkStmts = toOL

plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
plusStmts = appOL

stmtList :: CmmStmts -> [CmmStmt]
stmtList = fromOL


---------------------------------------------------
--
--	CmmStmt
--
---------------------------------------------------

isNopStmt :: CmmStmt -> Bool
-- If isNopStmt returns True, the stmt is definitely a no-op;
-- but it might be a no-op even if isNopStmt returns False
isNopStmt CmmNop 		       = True
isNopStmt (CmmAssign r e) 	       = cheapEqReg r e
isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
Ian Lynagh's avatar
Ian Lynagh committed
110
isNopStmt _ 			       = False
111 112 113 114 115

cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
cheapEqExpr (CmmReg r)      e 		      = cheapEqReg r e
cheapEqExpr (CmmRegOff r 0) e 		      = cheapEqReg r e
cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
Ian Lynagh's avatar
Ian Lynagh committed
116
cheapEqExpr _  		    _ 		      = False
117 118 119 120

cheapEqReg :: CmmReg -> CmmExpr -> Bool
cheapEqReg r (CmmReg r')      = r==r'
cheapEqReg r (CmmRegOff r' 0) = r==r'
Ian Lynagh's avatar
Ian Lynagh committed
121
cheapEqReg _ _		      = False
122 123 124 125 126 127 128 129 130 131 132 133 134

---------------------------------------------------
--
--	CmmExpr
--
---------------------------------------------------

isTrivialCmmExpr :: CmmExpr -> Bool
isTrivialCmmExpr (CmmLoad _ _)   = False
isTrivialCmmExpr (CmmMachOp _ _) = False
isTrivialCmmExpr (CmmLit _)      = True
isTrivialCmmExpr (CmmReg _)      = True
isTrivialCmmExpr (CmmRegOff _ _) = True
Ian Lynagh's avatar
Ian Lynagh committed
135
isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
136

137 138 139 140 141 142 143 144
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs (CmmLoad e _)   	   = hasNoGlobalRegs e
hasNoGlobalRegs (CmmMachOp _ es) 	   = all hasNoGlobalRegs es
hasNoGlobalRegs (CmmLit _)      	   = True
hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
hasNoGlobalRegs _ = False

145 146 147 148 149 150 151
---------------------------------------------------
--
--	Expr Construction helpers
--
---------------------------------------------------

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 157 158 159 160 161 162 163

-- NB. Do *not* inspect the value of the offset in these smart constructors!!!
-- because the offset is sometimes involved in a loop in the code generator
-- (we don't know the real Hp offset until we've generated code for the entire
-- basic block, for example).  So we cannot eliminate zero offsets at this
-- stage; they're eliminated later instead (either during printing or
-- a later optimisation step on Cmm).
--
cmmOffset :: CmmExpr -> Int -> CmmExpr
164
cmmOffset e                 0        = e
165 166 167 168 169 170 171
cmmOffset (CmmReg reg)      byte_off = cmmRegOff reg byte_off
cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
cmmOffset (CmmLit lit)      byte_off = CmmLit (cmmOffsetLit lit byte_off)
cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
  = CmmMachOp (MO_Add rep) 
	      [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
cmmOffset expr byte_off
172
  = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]
173
  where
174
    width = cmmExprWidth expr
175 176 177 178 179 180 181 182 183

-- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.
cmmRegOff :: CmmReg -> Int -> CmmExpr
cmmRegOff reg byte_off = CmmRegOff reg byte_off

cmmOffsetLit :: CmmLit -> Int -> CmmLit
cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff	l byte_off
cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff	l (m+byte_off)
cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
Ian Lynagh's avatar
Ian Lynagh committed
184
cmmOffsetLit _    	       byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
185 186 187 188 189 190 191

cmmLabelOff :: CLabel -> Int -> CmmLit
-- Smart constructor for CmmLabelOff
cmmLabelOff lbl 0        = CmmLabel lbl
cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off

-- | Useful for creating an index into an array, with a staticaly known offset.
192 193 194 195 196 197
-- The type is the element type; used for making the multiplier
cmmIndex :: Width	-- Width w
	 -> CmmExpr	-- Address of vector of items of width w
	 -> Int		-- Which element of the vector (0 based)
	 -> CmmExpr	-- Address of i'th element
cmmIndex width base idx = cmmOffset base (idx * widthInBytes width)
198 199

-- | Useful for creating an index into an array, with an unknown offset.
200 201 202 203 204 205
cmmIndexExpr :: Width		-- Width w
	     -> CmmExpr		-- Address of vector of items of width w
	     -> CmmExpr		-- Which element of the vector (0 based)
	     -> CmmExpr		-- Address of i'th element
cmmIndexExpr width base (CmmLit (CmmInt n _)) = cmmIndex width base (fromInteger n)
cmmIndexExpr width base idx =
206 207
  cmmOffsetExpr base byte_off
  where
208 209
    idx_w = cmmExprWidth idx
    byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))]
210

211 212
cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
213 214 215 216 217 218 219 220

---------------------------------------------------
--
--	Literal construction functions
--
---------------------------------------------------

mkIntCLit :: Int -> CmmLit
221
mkIntCLit i = CmmInt (toInteger i) wordWidth
222 223

zeroCLit :: CmmLit
224
zeroCLit = CmmInt 0 wordWidth
225 226 227

mkLblExpr :: CLabel -> CmmExpr
mkLblExpr lbl = CmmLit (CmmLabel lbl)
228 229 230 231 232 233 234 235

---------------------------------------------------
--
--	Helpers for foreign call arguments
--
---------------------------------------------------

loadArgsIntoTemps :: [Unique]
236 237
                  -> HintedCmmActuals
                  -> ([Unique], [CmmStmt], HintedCmmActuals)
238
loadArgsIntoTemps uniques [] = (uniques, [], [])
239
loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
240 241
    (uniques'',
     new_stmts ++ remaining_stmts,
242
     (CmmHinted new_e hint) : remaining_e)
243 244 245 246 247
    where
      (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
      (uniques'', remaining_stmts, remaining_e) =
          loadArgsIntoTemps uniques' args

248

249 250 251 252
maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
maybeAssignTemp uniques e
    | hasNoGlobalRegs e = (uniques, [], e)
    | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
253
    where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))