Replacing copyins and copyouts with data-movement instructions
[ghc.git] / compiler / cmm / CmmExpr.hs
1
2 module CmmExpr
3 ( CmmExpr(..), cmmExprRep, maybeInvertCmmExpr
4 , CmmReg(..), cmmRegRep
5 , CmmLit(..), cmmLitRep
6 , LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
7 , GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
8 , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
9 , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
10 , plusRegSet, minusRegSet, timesRegSet
11 , Area(..), StackSlotMap, getSlot, mkCallArea, outgoingSlot, areaId, areaSize
12 ) where
13
14 import BlockId
15 import CLabel
16 import FiniteMap
17 import MachOp
18 import Maybes
19 import Monad
20 import Panic
21 import Unique
22 import UniqSet
23
24 -----------------------------------------------------------------------------
25 -- CmmExpr
26 -- An expression. Expressions have no side effects.
27 -----------------------------------------------------------------------------
28
29 data CmmExpr
30 = CmmLit CmmLit -- Literal
31 | CmmLoad CmmExpr MachRep -- Read memory location
32 | CmmReg CmmReg -- Contents of register
33 | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.)
34 | CmmRegOff CmmReg Int
35 -- CmmRegOff reg i
36 -- ** is shorthand only, meaning **
37 -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
38 -- where rep = cmmRegRep reg
39 | CmmStackSlot Area Int
40 deriving Eq
41
42 data CmmReg
43 = CmmLocal LocalReg
44 | CmmGlobal GlobalReg
45 deriving( Eq, Ord )
46
47 -- | A stack area is either the stack slot where a variable is spilled
48 -- or the stack space where function arguments and results are passed.
49 data Area
50 = RegSlot LocalReg
51 | CallArea BlockId Int Int
52 deriving (Eq, Ord)
53
54 data CmmLit
55 = CmmInt Integer MachRep
56 -- Interpretation: the 2's complement representation of the value
57 -- is truncated to the specified size. This is easier than trying
58 -- to keep the value within range, because we don't know whether
59 -- it will be used as a signed or unsigned value (the MachRep doesn't
60 -- distinguish between signed & unsigned).
61 | CmmFloat Rational MachRep
62 | CmmLabel CLabel -- Address of label
63 | CmmLabelOff CLabel Int -- Address of label + byte offset
64
65 -- Due to limitations in the C backend, the following
66 -- MUST ONLY be used inside the info table indicated by label2
67 -- (label2 must be the info label), and label1 must be an
68 -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
69 -- Don't use it at all unless tablesNextToCode.
70 -- It is also used inside the NCG during when generating
71 -- position-independent code.
72 | CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset
73 deriving Eq
74
75 instance Eq LocalReg where
76 (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
77
78 instance Ord LocalReg where
79 compare (LocalReg u1 _ _) (LocalReg u2 _ _) = compare u1 u2
80
81 instance Uniquable LocalReg where
82 getUnique (LocalReg uniq _ _) = uniq
83
84 --------
85 --- Negation for conditional branches
86
87 maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
88 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
89 return (CmmMachOp op' args)
90 maybeInvertCmmExpr _ = Nothing
91
92 -----------------------------------------------------------------------------
93 -- Local registers
94 -----------------------------------------------------------------------------
95
96 -- | Whether a 'LocalReg' is a GC followable pointer
97 data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
98
99 data LocalReg
100 = LocalReg
101 !Unique -- ^ Identifier
102 MachRep -- ^ Type
103 GCKind -- ^ Should the GC follow as a pointer
104
105 -- | Sets of local registers
106
107 type RegSet = UniqSet LocalReg
108 emptyRegSet :: RegSet
109 elemRegSet :: LocalReg -> RegSet -> Bool
110 extendRegSet :: RegSet -> LocalReg -> RegSet
111 deleteFromRegSet :: RegSet -> LocalReg -> RegSet
112 mkRegSet :: [LocalReg] -> RegSet
113 minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
114
115 emptyRegSet = emptyUniqSet
116 elemRegSet = elementOfUniqSet
117 extendRegSet = addOneToUniqSet
118 deleteFromRegSet = delOneFromUniqSet
119 mkRegSet = mkUniqSet
120 minusRegSet = minusUniqSet
121 plusRegSet = unionUniqSets
122 timesRegSet = intersectUniqSets
123
124 -----------------------------------------------------------------------------
125 -- Stack slots
126 -----------------------------------------------------------------------------
127
128 mkVarSlot :: LocalReg -> CmmExpr
129 mkVarSlot r = CmmStackSlot (RegSlot r) 0
130
131 -- Usually, we either want to lookup a variable's spill slot in an environment
132 -- or else allocate it and add it to the environment.
133 -- For a variable, we just need a single area of the appropriate size.
134 type StackSlotMap = FiniteMap LocalReg CmmExpr
135 getSlot :: StackSlotMap -> LocalReg -> (StackSlotMap, CmmExpr)
136 getSlot map r = case lookupFM map r of
137 Just s -> (map, s)
138 Nothing -> (addToFM map r s, s) where s = mkVarSlot r
139
140 -- Eventually, we'll want something proper that takes arguments and formals
141 -- and gives you back the calling convention code, as well as the stack area.
142 mkCallArea :: BlockId -> [a] -> Maybe [b] -> Area
143 mkCallArea id as fs = CallArea id (length as) (liftM length fs `orElse` 0)
144
145 -- Return the last slot in the outgoing parameter area.
146 outgoingSlot :: Area -> CmmExpr
147 outgoingSlot a@(RegSlot _) = CmmStackSlot a 0
148 outgoingSlot a@(CallArea _ outN _) = CmmStackSlot a outN
149
150 areaId :: Area -> BlockId
151 areaId (RegSlot _) = panic "Register stack slots don't have IDs!"
152 areaId (CallArea id _ _) = id
153
154 areaSize :: Area -> Int
155 areaSize (RegSlot _) = 1
156 areaSize (CallArea _ outN inN) = max outN inN
157
158
159 -----------------------------------------------------------------------------
160 -- Register-use information for expressions and other types
161 -----------------------------------------------------------------------------
162
163 class UserOfLocalRegs a where
164 foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
165
166 class DefinerOfLocalRegs a where
167 foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
168
169 filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
170 filterRegsUsed p e =
171 foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
172 emptyRegSet e
173
174 instance UserOfLocalRegs CmmReg where
175 foldRegsUsed f z (CmmLocal reg) = f z reg
176 foldRegsUsed _ z (CmmGlobal _) = z
177
178 instance DefinerOfLocalRegs CmmReg where
179 foldRegsDefd f z (CmmLocal reg) = f z reg
180 foldRegsDefd _ z (CmmGlobal _) = z
181
182 instance UserOfLocalRegs LocalReg where
183 foldRegsUsed f z r = f z r
184
185 instance DefinerOfLocalRegs LocalReg where
186 foldRegsDefd f z r = f z r
187
188 instance UserOfLocalRegs RegSet where
189 foldRegsUsed f = foldUniqSet (flip f)
190
191 instance UserOfLocalRegs CmmExpr where
192 foldRegsUsed f z e = expr z e
193 where expr z (CmmLit _) = z
194 expr z (CmmLoad addr _) = foldRegsUsed f z addr
195 expr z (CmmReg r) = foldRegsUsed f z r
196 expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
197 expr z (CmmRegOff r _) = foldRegsUsed f z r
198 expr z (CmmStackSlot _ _) = z
199
200 instance UserOfLocalRegs a => UserOfLocalRegs [a] where
201 foldRegsUsed _ set [] = set
202 foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
203
204 instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
205 foldRegsDefd _ set [] = set
206 foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
207
208 -----------------------------------------------------------------------------
209 -- MachRep
210 -----------------------------------------------------------------------------
211
212
213
214 cmmExprRep :: CmmExpr -> MachRep
215 cmmExprRep (CmmLit lit) = cmmLitRep lit
216 cmmExprRep (CmmLoad _ rep) = rep
217 cmmExprRep (CmmReg reg) = cmmRegRep reg
218 cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
219 cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
220 cmmExprRep (CmmStackSlot _ _) = wordRep
221
222 cmmRegRep :: CmmReg -> MachRep
223 cmmRegRep (CmmLocal reg) = localRegRep reg
224 cmmRegRep (CmmGlobal reg) = globalRegRep reg
225
226 localRegRep :: LocalReg -> MachRep
227 localRegRep (LocalReg _ rep _) = rep
228
229
230 localRegGCFollow :: LocalReg -> GCKind
231 localRegGCFollow (LocalReg _ _ p) = p
232
233 cmmLitRep :: CmmLit -> MachRep
234 cmmLitRep (CmmInt _ rep) = rep
235 cmmLitRep (CmmFloat _ rep) = rep
236 cmmLitRep (CmmLabel _) = wordRep
237 cmmLitRep (CmmLabelOff _ _) = wordRep
238 cmmLitRep (CmmLabelDiffOff _ _ _) = wordRep
239
240 -----------------------------------------------------------------------------
241 -- Global STG registers
242 -----------------------------------------------------------------------------
243
244 data GlobalReg
245 -- Argument and return registers
246 = VanillaReg -- pointers, unboxed ints and chars
247 {-# UNPACK #-} !Int -- its number
248
249 | FloatReg -- single-precision floating-point registers
250 {-# UNPACK #-} !Int -- its number
251
252 | DoubleReg -- double-precision floating-point registers
253 {-# UNPACK #-} !Int -- its number
254
255 | LongReg -- long int registers (64-bit, really)
256 {-# UNPACK #-} !Int -- its number
257
258 -- STG registers
259 | Sp -- Stack ptr; points to last occupied stack location.
260 | SpLim -- Stack limit
261 | Hp -- Heap ptr; points to last occupied heap location.
262 | HpLim -- Heap limit register
263 | CurrentTSO -- pointer to current thread's TSO
264 | CurrentNursery -- pointer to allocation area
265 | HpAlloc -- allocation count for heap check failure
266
267 -- We keep the address of some commonly-called
268 -- functions in the register table, to keep code
269 -- size down:
270 | GCEnter1 -- stg_gc_enter_1
271 | GCFun -- stg_gc_fun
272
273 -- Base offset for the register table, used for accessing registers
274 -- which do not have real registers assigned to them. This register
275 -- will only appear after we have expanded GlobalReg into memory accesses
276 -- (where necessary) in the native code generator.
277 | BaseReg
278
279 -- Base Register for PIC (position-independent code) calculations
280 -- Only used inside the native code generator. It's exact meaning differs
281 -- from platform to platform (see module PositionIndependentCode).
282 | PicBaseReg
283
284 deriving( Eq, Ord, Show )
285
286 -- convenient aliases
287 spReg, hpReg, spLimReg, nodeReg :: CmmReg
288 spReg = CmmGlobal Sp
289 hpReg = CmmGlobal Hp
290 spLimReg = CmmGlobal SpLim
291 nodeReg = CmmGlobal node
292
293 node :: GlobalReg
294 node = VanillaReg 1
295
296 globalRegRep :: GlobalReg -> MachRep
297 globalRegRep (VanillaReg _) = wordRep
298 globalRegRep (FloatReg _) = F32
299 globalRegRep (DoubleReg _) = F64
300 globalRegRep (LongReg _) = I64
301 globalRegRep _ = wordRep