1 -----------------------------------------------------------------------------
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
17 CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
20 isTrivialCmmExpr, hasNoGlobalRegs,
22 cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
23 cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
29 loadArgsIntoTemps, maybeAssignTemp,
32 #include "HsVersions.h"
41 ---------------------------------------------------
45 ---------------------------------------------------
47 type CmmStmts = OrdList CmmStmt
52 oneStmt :: CmmStmt -> CmmStmts
55 mkStmts :: [CmmStmt] -> CmmStmts
58 plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
61 stmtList :: CmmStmts -> [CmmStmt]
65 ---------------------------------------------------
69 ---------------------------------------------------
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
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
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
90 ---------------------------------------------------
94 ---------------------------------------------------
96 isTrivialCmmExpr :: CmmExpr -> Bool
97 isTrivialCmmExpr (CmmLoad _ _) = False
98 isTrivialCmmExpr (CmmMachOp _ _) = False
99 isTrivialCmmExpr (CmmLit _) = True
100 isTrivialCmmExpr (CmmReg _) = True
101 isTrivialCmmExpr (CmmRegOff _ _) = True
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
111 ---------------------------------------------------
113 -- Expr Construction helpers
115 ---------------------------------------------------
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]
122 -- NB. Do *not* inspect the value of the offset in these smart constructors!!!
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).
130 cmmOffset :: CmmExpr -> Int -> CmmExpr
131 cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off
132 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
133 cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
134 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
135 = CmmMachOp (MO_Add rep)
136 [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
137 cmmOffset expr byte_off
138 = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
140 rep = cmmExprRep expr
142 -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
143 cmmRegOff :: CmmReg -> Int -> CmmExpr
144 cmmRegOff reg byte_off = CmmRegOff reg byte_off
146 cmmOffsetLit :: CmmLit -> Int -> CmmLit
147 cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off
148 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
149 cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep
150 cmmOffsetLit other byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
152 cmmLabelOff :: CLabel -> Int -> CmmLit
153 -- Smart constructor for CmmLabelOff
154 cmmLabelOff lbl 0 = CmmLabel lbl
155 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
157 -- | Useful for creating an index into an array, with a staticaly known offset.
158 cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
159 cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
161 -- | Useful for creating an index into an array, with an unknown offset.
162 cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
163 cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
164 cmmIndexExpr rep base idx =
165 cmmOffsetExpr base byte_off
167 idx_rep = cmmExprRep idx
168 byte_off = CmmMachOp (MO_Shl idx_rep) [
169 idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
171 cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
172 cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
174 ---------------------------------------------------
176 -- Literal construction functions
178 ---------------------------------------------------
180 mkIntCLit :: Int -> CmmLit
181 mkIntCLit i = CmmInt (toInteger i) wordRep
184 zeroCLit = CmmInt 0 wordRep
186 mkLblExpr :: CLabel -> CmmExpr
187 mkLblExpr lbl = CmmLit (CmmLabel lbl)
189 ---------------------------------------------------
191 -- Helpers for foreign call arguments
193 ---------------------------------------------------
195 loadArgsIntoTemps :: [Unique]
197 -> ([Unique], [CmmStmt], CmmActuals)
198 loadArgsIntoTemps uniques [] = (uniques, [], [])
199 loadArgsIntoTemps uniques ((e, hint):args) =
201 new_stmts ++ remaining_stmts,
202 (new_e, hint) : remaining_e)
204 (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
205 (uniques'', remaining_stmts, remaining_e) =
206 loadArgsIntoTemps uniques' args
208 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
209 maybeAssignTemp uniques e
210 | hasNoGlobalRegs e = (uniques, [], e)
211 | otherwise = (tail uniques, [CmmAssign local e], CmmReg local)
212 where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) KindNonPtr)