CmmUtils.hs 6.76 KB
Newer Older
1 2 3 4 5 6 7
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details

8 9 10 11
-----------------------------------------------------------------------------
--
-- Cmm utilities.
--
Simon Marlow's avatar
Simon Marlow committed
12
-- (c) The University of Glasgow 2004-2006
13 14 15 16 17 18 19
--
-----------------------------------------------------------------------------

module CmmUtils( 
	CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
	isNopStmt,

20
	isTrivialCmmExpr, hasNoGlobalRegs,
21 22 23 24 25 26 27

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

 	mkIntCLit, zeroCLit,

	mkLblExpr,
28 29

        loadArgsIntoTemps, maybeAssignTemp,
30 31 32 33
  ) where

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
34
import CLabel
35 36 37 38
import Cmm
import MachOp
import OrdList
import Outputable
39
import Unique
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 66 67 68 69 70 71 72 73 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

---------------------------------------------------
--
--	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
isNopStmt s 			       = False

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'
cheapEqExpr e1 		    e2		      = False

cheapEqReg :: CmmReg -> CmmExpr -> Bool
cheapEqReg r (CmmReg r')      = r==r'
cheapEqReg r (CmmRegOff r' 0) = r==r'
cheapEqReg r e		      = False

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

isTrivialCmmExpr :: CmmExpr -> Bool
isTrivialCmmExpr (CmmLoad _ _)   = False
isTrivialCmmExpr (CmmMachOp _ _) = False
isTrivialCmmExpr (CmmLit _)      = True
isTrivialCmmExpr (CmmReg _)      = True
isTrivialCmmExpr (CmmRegOff _ _) = True

103 104 105 106 107 108 109 110
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

111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
---------------------------------------------------
--
--	Expr Construction helpers
--
---------------------------------------------------

cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
-- assumes base and offset have the same MachRep
cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprRep e)) [e, byte_off]

-- 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
131
cmmOffset e                 0        = e
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
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
  = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
  where
    rep = cmmExprRep expr

-- 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
cmmOffsetLit other	       byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)

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.
cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)

-- | Useful for creating an index into an array, with an unknown offset.
cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
cmmIndexExpr rep base idx =
  cmmOffsetExpr base byte_off
  where
    idx_rep = cmmExprRep idx
    byte_off = CmmMachOp (MO_Shl idx_rep) [
		  idx, CmmLit (mkIntCLit (machRepLogWidth rep))]

cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep

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

mkIntCLit :: Int -> CmmLit
mkIntCLit i = CmmInt (toInteger i) wordRep

zeroCLit :: CmmLit
zeroCLit = CmmInt 0 wordRep

mkLblExpr :: CLabel -> CmmExpr
mkLblExpr lbl = CmmLit (CmmLabel lbl)
189 190 191 192 193 194 195 196 197 198 199

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

loadArgsIntoTemps :: [Unique]
                  -> CmmActuals
                  -> ([Unique], [CmmStmt], CmmActuals)
loadArgsIntoTemps uniques [] = (uniques, [], [])
200
loadArgsIntoTemps uniques ((CmmKinded e hint):args) =
201 202
    (uniques'',
     new_stmts ++ remaining_stmts,
203
     (CmmKinded new_e hint) : remaining_e)
204 205 206 207 208 209 210 211 212
    where
      (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
      (uniques'', remaining_stmts, remaining_e) =
          loadArgsIntoTemps uniques' args

maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
maybeAssignTemp uniques e
    | hasNoGlobalRegs e = (uniques, [], e)
    | otherwise         = (tail uniques, [CmmAssign local e], CmmReg local)
213
    where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) GCKindNonPtr)