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
8 -----------------------------------------------------------------------------
12 -- (c) The University of Glasgow 2004-2006
14 -----------------------------------------------------------------------------
17 CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
20 primRepCmmType, primRepForeignHint,
21 typeCmmType, typeForeignHint,
23 isTrivialCmmExpr, hasNoGlobalRegs,
25 cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
26 cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
32 maybeAssignTemp, loadArgsIntoTemps
35 #include "HsVersions.h"
37 import TyCon ( PrimRep(..) )
38 import Type ( Type, typePrimRep )
46 ---------------------------------------------------
50 ---------------------------------------------------
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
63 typeCmmType :: Type -> CmmType
64 typeCmmType ty = primRepCmmType (typePrimRep ty)
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
77 typeForeignHint :: Type -> ForeignHint
78 typeForeignHint = primRepForeignHint . typePrimRep
81 ---------------------------------------------------
85 ---------------------------------------------------
87 type CmmStmts = OrdList CmmStmt
92 oneStmt :: CmmStmt -> CmmStmts
95 mkStmts :: [CmmStmt] -> CmmStmts
98 plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
101 stmtList :: CmmStmts -> [CmmStmt]
105 ---------------------------------------------------
109 ---------------------------------------------------
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
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
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
130 ---------------------------------------------------
134 ---------------------------------------------------
136 isTrivialCmmExpr :: CmmExpr -> Bool
137 isTrivialCmmExpr (CmmLoad _ _) = False
138 isTrivialCmmExpr (CmmMachOp _ _) = False
139 isTrivialCmmExpr (CmmLit _) = True
140 isTrivialCmmExpr (CmmReg _) = True
141 isTrivialCmmExpr (CmmRegOff _ _) = True
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
151 ---------------------------------------------------
153 -- Expr Construction helpers
155 ---------------------------------------------------
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]
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).
169 cmmOffset :: CmmExpr -> Int -> CmmExpr
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)]
180 width = cmmExprWidth expr
182 -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
183 cmmRegOff :: CmmReg -> Int -> CmmExpr
184 cmmRegOff reg byte_off = CmmRegOff reg byte_off
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)
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
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)
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
214 idx_w = cmmExprWidth idx
215 byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))]
217 cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
218 cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
220 ---------------------------------------------------
222 -- Literal construction functions
224 ---------------------------------------------------
226 mkIntCLit :: Int -> CmmLit
227 mkIntCLit i = CmmInt (toInteger i) wordWidth
230 zeroCLit = CmmInt 0 wordWidth
232 mkLblExpr :: CLabel -> CmmExpr
233 mkLblExpr lbl = CmmLit (CmmLabel lbl)
235 ---------------------------------------------------
237 -- Helpers for foreign call arguments
239 ---------------------------------------------------
241 loadArgsIntoTemps :: [Unique]
243 -> ([Unique], [CmmStmt], HintedCmmActuals)
244 loadArgsIntoTemps uniques [] = (uniques, [], [])
245 loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
247 new_stmts ++ remaining_stmts,
248 (CmmHinted new_e hint) : remaining_e)
250 (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
251 (uniques'', remaining_stmts, remaining_e) =
252 loadArgsIntoTemps uniques' args
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))