1 -----------------------------------------------------------------------------
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
10 CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
13 isTrivialCmmExpr, hasNoGlobalRegs,
15 cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
16 cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
22 loadArgsIntoTemps, maybeAssignTemp,
25 #include "HsVersions.h"
34 ---------------------------------------------------
38 ---------------------------------------------------
40 type CmmStmts = OrdList CmmStmt
45 oneStmt :: CmmStmt -> CmmStmts
48 mkStmts :: [CmmStmt] -> CmmStmts
51 plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
54 stmtList :: CmmStmts -> [CmmStmt]
58 ---------------------------------------------------
62 ---------------------------------------------------
64 isNopStmt :: CmmStmt -> Bool
65 -- If isNopStmt returns True, the stmt is definitely a no-op;
66 -- but it might be a no-op even if isNopStmt returns False
67 isNopStmt CmmNop = True
68 isNopStmt (CmmAssign r e) = cheapEqReg r e
69 isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
72 cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
73 cheapEqExpr (CmmReg r) e = cheapEqReg r e
74 cheapEqExpr (CmmRegOff r 0) e = cheapEqReg r e
75 cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
76 cheapEqExpr e1 e2 = False
78 cheapEqReg :: CmmReg -> CmmExpr -> Bool
79 cheapEqReg r (CmmReg r') = r==r'
80 cheapEqReg r (CmmRegOff r' 0) = r==r'
81 cheapEqReg r e = False
83 ---------------------------------------------------
87 ---------------------------------------------------
89 isTrivialCmmExpr :: CmmExpr -> Bool
90 isTrivialCmmExpr (CmmLoad _ _) = False
91 isTrivialCmmExpr (CmmMachOp _ _) = False
92 isTrivialCmmExpr (CmmLit _) = True
93 isTrivialCmmExpr (CmmReg _) = True
94 isTrivialCmmExpr (CmmRegOff _ _) = True
96 hasNoGlobalRegs :: CmmExpr -> Bool
97 hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
98 hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es
99 hasNoGlobalRegs (CmmLit _) = True
100 hasNoGlobalRegs (CmmReg (CmmLocal _)) = True
101 hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
102 hasNoGlobalRegs _ = False
104 ---------------------------------------------------
106 -- Expr Construction helpers
108 ---------------------------------------------------
110 cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
111 -- assumes base and offset have the same MachRep
112 cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
113 cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprRep e)) [e, byte_off]
115 -- NB. Do *not* inspect the value of the offset in these smart constructors!!!
117 -- because the offset is sometimes involved in a loop in the code generator
118 -- (we don't know the real Hp offset until we've generated code for the entire
119 -- basic block, for example). So we cannot eliminate zero offsets at this
120 -- stage; they're eliminated later instead (either during printing or
121 -- a later optimisation step on Cmm).
123 cmmOffset :: CmmExpr -> Int -> CmmExpr
124 cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off
125 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
126 cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
127 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
128 = CmmMachOp (MO_Add rep)
129 [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
130 cmmOffset expr byte_off
131 = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
133 rep = cmmExprRep expr
135 -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
136 cmmRegOff :: CmmReg -> Int -> CmmExpr
137 cmmRegOff reg byte_off = CmmRegOff reg byte_off
139 cmmOffsetLit :: CmmLit -> Int -> CmmLit
140 cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off
141 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
142 cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep
143 cmmOffsetLit other byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
145 cmmLabelOff :: CLabel -> Int -> CmmLit
146 -- Smart constructor for CmmLabelOff
147 cmmLabelOff lbl 0 = CmmLabel lbl
148 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
150 -- | Useful for creating an index into an array, with a staticaly known offset.
151 cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
152 cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
154 -- | Useful for creating an index into an array, with an unknown offset.
155 cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
156 cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
157 cmmIndexExpr rep base idx =
158 cmmOffsetExpr base byte_off
160 idx_rep = cmmExprRep idx
161 byte_off = CmmMachOp (MO_Shl idx_rep) [
162 idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
164 cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
165 cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
167 ---------------------------------------------------
169 -- Literal construction functions
171 ---------------------------------------------------
173 mkIntCLit :: Int -> CmmLit
174 mkIntCLit i = CmmInt (toInteger i) wordRep
177 zeroCLit = CmmInt 0 wordRep
179 mkLblExpr :: CLabel -> CmmExpr
180 mkLblExpr lbl = CmmLit (CmmLabel lbl)
182 ---------------------------------------------------
184 -- Helpers for foreign call arguments
186 ---------------------------------------------------
188 loadArgsIntoTemps :: [Unique]
190 -> ([Unique], [CmmStmt], CmmActuals)
191 loadArgsIntoTemps uniques [] = (uniques, [], [])
192 loadArgsIntoTemps uniques ((e, hint):args) =
194 new_stmts ++ remaining_stmts,
195 (new_e, hint) : remaining_e)
197 (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
198 (uniques'', remaining_stmts, remaining_e) =
199 loadArgsIntoTemps uniques' args
201 maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
202 maybeAssignTemp uniques e
203 | hasNoGlobalRegs e = (uniques, [], e)
204 | otherwise = (tail uniques, [CmmAssign local e], CmmReg local)
205 where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) KindNonPtr)