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 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
132 cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off
133 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
134 cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
135 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
136 = CmmMachOp (MO_Add rep)
137 [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
138 cmmOffset expr byte_off
139 = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
141 rep = cmmExprRep expr
143 -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
144 cmmRegOff :: CmmReg -> Int -> CmmExpr
145 cmmRegOff reg byte_off = CmmRegOff reg byte_off
147 cmmOffsetLit :: CmmLit -> Int -> CmmLit
148 cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off
149 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
150 cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep
151 cmmOffsetLit other byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
153 cmmLabelOff :: CLabel -> Int -> CmmLit
154 -- Smart constructor for CmmLabelOff
155 cmmLabelOff lbl 0 = CmmLabel lbl
156 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
158 -- | Useful for creating an index into an array, with a staticaly known offset.
159 cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
160 cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
162 -- | Useful for creating an index into an array, with an unknown offset.
163 cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
164 cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
165 cmmIndexExpr rep base idx =
166 cmmOffsetExpr base byte_off
168 idx_rep = cmmExprRep idx
169 byte_off = CmmMachOp (MO_Shl idx_rep) [
170 idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
172 cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
173 cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
175 ---------------------------------------------------
177 -- Literal construction functions
179 ---------------------------------------------------
181 mkIntCLit :: Int -> CmmLit
182 mkIntCLit i = CmmInt (toInteger i) wordRep
185 zeroCLit = CmmInt 0 wordRep
187 mkLblExpr :: CLabel -> CmmExpr
188 mkLblExpr lbl = CmmLit (CmmLabel lbl)
190 ---------------------------------------------------
192 -- Helpers for foreign call arguments
194 ---------------------------------------------------
196 loadArgsIntoTemps :: [Unique]
198 -> ([Unique], [CmmStmt], CmmActuals)
199 loadArgsIntoTemps uniques [] = (uniques, [], [])
200 loadArgsIntoTemps uniques ((CmmKinded e hint):args) =
202 new_stmts ++ remaining_stmts,
203 (CmmKinded new_e hint) : remaining_e)
205 (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
206 (uniques'', remaining_stmts, remaining_e) =
207 loadArgsIntoTemps uniques' args
209 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
210 maybeAssignTemp uniques e
211 | hasNoGlobalRegs e = (uniques, [], e)
212 | otherwise = (tail uniques, [CmmAssign local e], CmmReg local)
213 where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) GCKindNonPtr)