Implement regslot inlining, document soundness concerns.
[ghc.git] / compiler / cmm / CmmExpr.hs
1
2 module CmmExpr
3 ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
4 , CmmReg(..), cmmRegType
5 , CmmLit(..), cmmLitType
6 , LocalReg(..), localRegType
7 , GlobalReg(..), globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
8 , VGcPtr(..), vgcFlag -- Temporary!
9 , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
10 , DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed
11 , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
12 , plusRegSet, minusRegSet, timesRegSet
13 , regUsedIn, regSlot
14 , Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
15 , module CmmMachOp
16 , module CmmType
17 )
18 where
19
20 #include "HsVersions.h"
21
22 import CmmType
23 import CmmMachOp
24 import BlockId
25 import CLabel
26 import Unique
27 import UniqSet
28
29 import Data.Map (Map)
30
31 -----------------------------------------------------------------------------
32 -- CmmExpr
33 -- An expression. Expressions have no side effects.
34 -----------------------------------------------------------------------------
35
36 data CmmExpr
37 = CmmLit CmmLit -- Literal
38 | CmmLoad CmmExpr CmmType -- Read memory location
39 | CmmReg CmmReg -- Contents of register
40 | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.)
41 | CmmStackSlot Area Int -- addressing expression of a stack slot
42 | CmmRegOff CmmReg Int
43 -- CmmRegOff reg i
44 -- ** is shorthand only, meaning **
45 -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
46 -- where rep = typeWidth (cmmRegType reg)
47
48 instance Eq CmmExpr where -- Equality ignores the types
49 CmmLit l1 == CmmLit l2 = l1==l2
50 CmmLoad e1 _ == CmmLoad e2 _ = e1==e2
51 CmmReg r1 == CmmReg r2 = r1==r2
52 CmmRegOff r1 i1 == CmmRegOff r2 i2 = r1==r2 && i1==i2
53 CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2
54 CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2
55 _e1 == _e2 = False
56
57 data CmmReg
58 = CmmLocal LocalReg
59 | CmmGlobal GlobalReg
60 deriving( Eq, Ord )
61
62 -- | A stack area is either the stack slot where a variable is spilled
63 -- or the stack space where function arguments and results are passed.
64 data Area
65 = RegSlot LocalReg
66 | CallArea AreaId
67 deriving (Eq, Ord)
68
69 data AreaId
70 = Old -- See Note [Old Area]
71 | Young BlockId
72 deriving (Eq, Ord)
73
74 {- Note [Old Area]
75 ~~~~~~~~~~~~~~~~~~
76 There is a single call area 'Old', allocated at the extreme old
77 end of the stack frame (ie just younger than the return address)
78 which holds:
79 * incoming (overflow) parameters,
80 * outgoing (overflow) parameter to tail calls,
81 * outgoing (overflow) result values
82 * the update frame (if any)
83
84 Its size is the max of all these requirements. On entry, the stack
85 pointer will point to the youngest incoming parameter, which is not
86 necessarily at the young end of the Old area.
87
88 End of note -}
89
90 type SubArea = (Area, Int, Int) -- area, offset, width
91 type SubAreaSet = Map Area [SubArea]
92
93 type AreaMap = Map Area Int
94 -- Byte offset of the oldest byte of the Area,
95 -- relative to the oldest byte of the Old Area
96
97 data CmmLit
98 = CmmInt Integer Width
99 -- Interpretation: the 2's complement representation of the value
100 -- is truncated to the specified size. This is easier than trying
101 -- to keep the value within range, because we don't know whether
102 -- it will be used as a signed or unsigned value (the CmmType doesn't
103 -- distinguish between signed & unsigned).
104 | CmmFloat Rational Width
105 | CmmLabel CLabel -- Address of label
106 | CmmLabelOff CLabel Int -- Address of label + byte offset
107
108 -- Due to limitations in the C backend, the following
109 -- MUST ONLY be used inside the info table indicated by label2
110 -- (label2 must be the info label), and label1 must be an
111 -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
112 -- Don't use it at all unless tablesNextToCode.
113 -- It is also used inside the NCG during when generating
114 -- position-independent code.
115 | CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset
116 | CmmBlock BlockId -- Code label
117 | CmmHighStackMark -- stands for the max stack space used during a procedure
118 deriving Eq
119
120 cmmExprType :: CmmExpr -> CmmType
121 cmmExprType (CmmLit lit) = cmmLitType lit
122 cmmExprType (CmmLoad _ rep) = rep
123 cmmExprType (CmmReg reg) = cmmRegType reg
124 cmmExprType (CmmMachOp op args) = machOpResultType op (map cmmExprType args)
125 cmmExprType (CmmRegOff reg _) = cmmRegType reg
126 cmmExprType (CmmStackSlot _ _) = bWord -- an address
127 -- Careful though: what is stored at the stack slot may be bigger than
128 -- an address
129
130 cmmLitType :: CmmLit -> CmmType
131 cmmLitType (CmmInt _ width) = cmmBits width
132 cmmLitType (CmmFloat _ width) = cmmFloat width
133 cmmLitType (CmmLabel lbl) = cmmLabelType lbl
134 cmmLitType (CmmLabelOff lbl _) = cmmLabelType lbl
135 cmmLitType (CmmLabelDiffOff {}) = bWord
136 cmmLitType (CmmBlock _) = bWord
137 cmmLitType (CmmHighStackMark) = bWord
138
139 cmmLabelType :: CLabel -> CmmType
140 cmmLabelType lbl | isGcPtrLabel lbl = gcWord
141 | otherwise = bWord
142
143 cmmExprWidth :: CmmExpr -> Width
144 cmmExprWidth e = typeWidth (cmmExprType e)
145
146 --------
147 --- Negation for conditional branches
148
149 maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
150 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
151 return (CmmMachOp op' args)
152 maybeInvertCmmExpr _ = Nothing
153
154 -----------------------------------------------------------------------------
155 -- Local registers
156 -----------------------------------------------------------------------------
157
158 data LocalReg
159 = LocalReg !Unique CmmType
160 -- ^ Parameters:
161 -- 1. Identifier
162 -- 2. Type
163
164 instance Eq LocalReg where
165 (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
166
167 instance Ord LocalReg where
168 compare (LocalReg u1 _) (LocalReg u2 _) = compare u1 u2
169
170 instance Uniquable LocalReg where
171 getUnique (LocalReg uniq _) = uniq
172
173 cmmRegType :: CmmReg -> CmmType
174 cmmRegType (CmmLocal reg) = localRegType reg
175 cmmRegType (CmmGlobal reg) = globalRegType reg
176
177 localRegType :: LocalReg -> CmmType
178 localRegType (LocalReg _ rep) = rep
179
180 -----------------------------------------------------------------------------
181 -- Register-use information for expressions and other types
182 -----------------------------------------------------------------------------
183
184 -- | Sets of local registers
185 type RegSet = UniqSet LocalReg
186 emptyRegSet :: RegSet
187 elemRegSet :: LocalReg -> RegSet -> Bool
188 extendRegSet :: RegSet -> LocalReg -> RegSet
189 deleteFromRegSet :: RegSet -> LocalReg -> RegSet
190 mkRegSet :: [LocalReg] -> RegSet
191 minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
192
193 emptyRegSet = emptyUniqSet
194 elemRegSet = elementOfUniqSet
195 extendRegSet = addOneToUniqSet
196 deleteFromRegSet = delOneFromUniqSet
197 mkRegSet = mkUniqSet
198 minusRegSet = minusUniqSet
199 plusRegSet = unionUniqSets
200 timesRegSet = intersectUniqSets
201
202 class UserOfLocalRegs a where
203 foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
204
205 class DefinerOfLocalRegs a where
206 foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
207
208 filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
209 filterRegsUsed p e =
210 foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
211 emptyRegSet e
212
213 instance UserOfLocalRegs CmmReg where
214 foldRegsUsed f z (CmmLocal reg) = f z reg
215 foldRegsUsed _ z (CmmGlobal _) = z
216
217 instance DefinerOfLocalRegs CmmReg where
218 foldRegsDefd f z (CmmLocal reg) = f z reg
219 foldRegsDefd _ z (CmmGlobal _) = z
220
221 instance UserOfLocalRegs LocalReg where
222 foldRegsUsed f z r = f z r
223
224 instance DefinerOfLocalRegs LocalReg where
225 foldRegsDefd f z r = f z r
226
227 instance UserOfLocalRegs RegSet where
228 foldRegsUsed f = foldUniqSet (flip f)
229
230 instance UserOfLocalRegs CmmExpr where
231 foldRegsUsed f z e = expr z e
232 where expr z (CmmLit _) = z
233 expr z (CmmLoad addr _) = foldRegsUsed f z addr
234 expr z (CmmReg r) = foldRegsUsed f z r
235 expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
236 expr z (CmmRegOff r _) = foldRegsUsed f z r
237 expr z (CmmStackSlot _ _) = z
238
239 instance UserOfLocalRegs a => UserOfLocalRegs [a] where
240 foldRegsUsed _ set [] = set
241 foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
242
243 instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
244 foldRegsDefd _ set [] = set
245 foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
246
247 instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
248 foldRegsDefd _ set Nothing = set
249 foldRegsDefd f set (Just x) = foldRegsDefd f set x
250
251 -----------------------------------------------------------------------------
252 -- Another reg utility
253
254 regUsedIn :: CmmReg -> CmmExpr -> Bool
255 _ `regUsedIn` CmmLit _ = False
256 reg `regUsedIn` CmmLoad e _ = reg `regUsedIn` e
257 reg `regUsedIn` CmmReg reg' = reg == reg'
258 reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
259 reg `regUsedIn` CmmMachOp _ es = any (reg `regUsedIn`) es
260 _ `regUsedIn` CmmStackSlot _ _ = False
261
262 -----------------------------------------------------------------------------
263 -- Stack slots
264 -----------------------------------------------------------------------------
265
266 isStackSlotOf :: CmmExpr -> LocalReg -> Bool
267 isStackSlotOf (CmmStackSlot (RegSlot r) _) r' = r == r'
268 isStackSlotOf _ _ = False
269
270 regSlot :: LocalReg -> CmmExpr
271 regSlot r = CmmStackSlot (RegSlot r) (widthInBytes $ typeWidth $ localRegType r)
272
273 -----------------------------------------------------------------------------
274 -- Stack slot use information for expressions and other types [_$_]
275 -----------------------------------------------------------------------------
276
277 -- Fold over the area, the offset into the area, and the width of the subarea.
278 class UserOfSlots a where
279 foldSlotsUsed :: (b -> SubArea -> b) -> b -> a -> b
280
281 class DefinerOfSlots a where
282 foldSlotsDefd :: (b -> SubArea -> b) -> b -> a -> b
283
284 instance UserOfSlots CmmExpr where
285 foldSlotsUsed f z e = expr z e
286 where expr z (CmmLit _) = z
287 expr z (CmmLoad (CmmStackSlot a i) ty) = f z (a, i, widthInBytes $ typeWidth ty)
288 expr z (CmmLoad addr _) = foldSlotsUsed f z addr
289 expr z (CmmReg _) = z
290 expr z (CmmMachOp _ exprs) = foldSlotsUsed f z exprs
291 expr z (CmmRegOff _ _) = z
292 expr z (CmmStackSlot _ _) = z
293
294 instance UserOfSlots a => UserOfSlots [a] where
295 foldSlotsUsed _ set [] = set
296 foldSlotsUsed f set (x:xs) = foldSlotsUsed f (foldSlotsUsed f set x) xs
297
298 instance DefinerOfSlots a => DefinerOfSlots [a] where
299 foldSlotsDefd _ set [] = set
300 foldSlotsDefd f set (x:xs) = foldSlotsDefd f (foldSlotsDefd f set x) xs
301
302 instance DefinerOfSlots SubArea where
303 foldSlotsDefd f z a = f z a
304
305 -----------------------------------------------------------------------------
306 -- Global STG registers
307 -----------------------------------------------------------------------------
308
309 data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
310 -- TEMPORARY!!!
311
312 -----------------------------------------------------------------------------
313 -- Global STG registers
314 -----------------------------------------------------------------------------
315 vgcFlag :: CmmType -> VGcPtr
316 vgcFlag ty | isGcPtrType ty = VGcPtr
317 | otherwise = VNonGcPtr
318
319 data GlobalReg
320 -- Argument and return registers
321 = VanillaReg -- pointers, unboxed ints and chars
322 {-# UNPACK #-} !Int -- its number
323 VGcPtr
324
325 | FloatReg -- single-precision floating-point registers
326 {-# UNPACK #-} !Int -- its number
327
328 | DoubleReg -- double-precision floating-point registers
329 {-# UNPACK #-} !Int -- its number
330
331 | LongReg -- long int registers (64-bit, really)
332 {-# UNPACK #-} !Int -- its number
333
334 -- STG registers
335 | Sp -- Stack ptr; points to last occupied stack location.
336 | SpLim -- Stack limit
337 | Hp -- Heap ptr; points to last occupied heap location.
338 | HpLim -- Heap limit register
339 | CurrentTSO -- pointer to current thread's TSO
340 | CurrentNursery -- pointer to allocation area
341 | HpAlloc -- allocation count for heap check failure
342
343 -- We keep the address of some commonly-called
344 -- functions in the register table, to keep code
345 -- size down:
346 | EagerBlackholeInfo -- stg_EAGER_BLACKHOLE_info
347 | GCEnter1 -- stg_gc_enter_1
348 | GCFun -- stg_gc_fun
349
350 -- Base offset for the register table, used for accessing registers
351 -- which do not have real registers assigned to them. This register
352 -- will only appear after we have expanded GlobalReg into memory accesses
353 -- (where necessary) in the native code generator.
354 | BaseReg
355
356 -- Base Register for PIC (position-independent code) calculations
357 -- Only used inside the native code generator. It's exact meaning differs
358 -- from platform to platform (see module PositionIndependentCode).
359 | PicBaseReg
360
361 deriving( Show )
362
363 instance Eq GlobalReg where
364 VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
365 FloatReg i == FloatReg j = i==j
366 DoubleReg i == DoubleReg j = i==j
367 LongReg i == LongReg j = i==j
368 Sp == Sp = True
369 SpLim == SpLim = True
370 Hp == Hp = True
371 HpLim == HpLim = True
372 CurrentTSO == CurrentTSO = True
373 CurrentNursery == CurrentNursery = True
374 HpAlloc == HpAlloc = True
375 GCEnter1 == GCEnter1 = True
376 GCFun == GCFun = True
377 BaseReg == BaseReg = True
378 PicBaseReg == PicBaseReg = True
379 _r1 == _r2 = False
380
381 instance Ord GlobalReg where
382 compare (VanillaReg i _) (VanillaReg j _) = compare i j
383 -- Ignore type when seeking clashes
384 compare (FloatReg i) (FloatReg j) = compare i j
385 compare (DoubleReg i) (DoubleReg j) = compare i j
386 compare (LongReg i) (LongReg j) = compare i j
387 compare Sp Sp = EQ
388 compare SpLim SpLim = EQ
389 compare Hp Hp = EQ
390 compare HpLim HpLim = EQ
391 compare CurrentTSO CurrentTSO = EQ
392 compare CurrentNursery CurrentNursery = EQ
393 compare HpAlloc HpAlloc = EQ
394 compare EagerBlackholeInfo EagerBlackholeInfo = EQ
395 compare GCEnter1 GCEnter1 = EQ
396 compare GCFun GCFun = EQ
397 compare BaseReg BaseReg = EQ
398 compare PicBaseReg PicBaseReg = EQ
399 compare (VanillaReg _ _) _ = LT
400 compare _ (VanillaReg _ _) = GT
401 compare (FloatReg _) _ = LT
402 compare _ (FloatReg _) = GT
403 compare (DoubleReg _) _ = LT
404 compare _ (DoubleReg _) = GT
405 compare (LongReg _) _ = LT
406 compare _ (LongReg _) = GT
407 compare Sp _ = LT
408 compare _ Sp = GT
409 compare SpLim _ = LT
410 compare _ SpLim = GT
411 compare Hp _ = LT
412 compare _ Hp = GT
413 compare HpLim _ = LT
414 compare _ HpLim = GT
415 compare CurrentTSO _ = LT
416 compare _ CurrentTSO = GT
417 compare CurrentNursery _ = LT
418 compare _ CurrentNursery = GT
419 compare HpAlloc _ = LT
420 compare _ HpAlloc = GT
421 compare GCEnter1 _ = LT
422 compare _ GCEnter1 = GT
423 compare GCFun _ = LT
424 compare _ GCFun = GT
425 compare BaseReg _ = LT
426 compare _ BaseReg = GT
427 compare EagerBlackholeInfo _ = LT
428 compare _ EagerBlackholeInfo = GT
429
430 -- convenient aliases
431 baseReg, spReg, hpReg, spLimReg, nodeReg :: CmmReg
432 baseReg = CmmGlobal BaseReg
433 spReg = CmmGlobal Sp
434 hpReg = CmmGlobal Hp
435 spLimReg = CmmGlobal SpLim
436 nodeReg = CmmGlobal node
437
438 node :: GlobalReg
439 node = VanillaReg 1 VGcPtr
440
441 globalRegType :: GlobalReg -> CmmType
442 globalRegType (VanillaReg _ VGcPtr) = gcWord
443 globalRegType (VanillaReg _ VNonGcPtr) = bWord
444 globalRegType (FloatReg _) = cmmFloat W32
445 globalRegType (DoubleReg _) = cmmFloat W64
446 globalRegType (LongReg _) = cmmBits W64
447 globalRegType Hp = gcWord -- The initialiser for all
448 -- dynamically allocated closures
449 globalRegType _ = bWord