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
14 , Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
20 #include "HsVersions.h"
31 -----------------------------------------------------------------------------
33 -- An expression. Expressions have no side effects.
34 -----------------------------------------------------------------------------
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
44 -- ** is shorthand only, meaning **
45 -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
46 -- where rep = typeWidth (cmmRegType reg)
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
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.
70 = Old -- See Note [Old Area]
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)
79 * incoming (overflow) parameters,
80 * outgoing (overflow) parameter to tail calls,
81 * outgoing (overflow) result values
82 * the update frame (if any)
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.
90 type SubArea = (Area, Int, Int) -- area, offset, width
91 type SubAreaSet = Map Area [SubArea]
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
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
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
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
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
139 cmmLabelType :: CLabel -> CmmType
140 cmmLabelType lbl | isGcPtrLabel lbl = gcWord
143 cmmExprWidth :: CmmExpr -> Width
144 cmmExprWidth e = typeWidth (cmmExprType e)
147 --- Negation for conditional branches
149 maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
150 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
151 return (CmmMachOp op' args)
152 maybeInvertCmmExpr _ = Nothing
154 -----------------------------------------------------------------------------
156 -----------------------------------------------------------------------------
159 = LocalReg !Unique CmmType
164 instance Eq LocalReg where
165 (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
167 instance Ord LocalReg where
168 compare (LocalReg u1 _) (LocalReg u2 _) = compare u1 u2
170 instance Uniquable LocalReg where
171 getUnique (LocalReg uniq _) = uniq
173 cmmRegType :: CmmReg -> CmmType
174 cmmRegType (CmmLocal reg) = localRegType reg
175 cmmRegType (CmmGlobal reg) = globalRegType reg
177 localRegType :: LocalReg -> CmmType
178 localRegType (LocalReg _ rep) = rep
180 -----------------------------------------------------------------------------
181 -- Register-use information for expressions and other types
182 -----------------------------------------------------------------------------
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
193 emptyRegSet = emptyUniqSet
194 elemRegSet = elementOfUniqSet
195 extendRegSet = addOneToUniqSet
196 deleteFromRegSet = delOneFromUniqSet
198 minusRegSet = minusUniqSet
199 plusRegSet = unionUniqSets
200 timesRegSet = intersectUniqSets
202 class UserOfLocalRegs a where
203 foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
205 class DefinerOfLocalRegs a where
206 foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
208 filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
210 foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
213 instance UserOfLocalRegs CmmReg where
214 foldRegsUsed f z (CmmLocal reg) = f z reg
215 foldRegsUsed _ z (CmmGlobal _) = z
217 instance DefinerOfLocalRegs CmmReg where
218 foldRegsDefd f z (CmmLocal reg) = f z reg
219 foldRegsDefd _ z (CmmGlobal _) = z
221 instance UserOfLocalRegs LocalReg where
222 foldRegsUsed f z r = f z r
224 instance DefinerOfLocalRegs LocalReg where
225 foldRegsDefd f z r = f z r
227 instance UserOfLocalRegs RegSet where
228 foldRegsUsed f = foldUniqSet (flip f)
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
239 instance UserOfLocalRegs a => UserOfLocalRegs [a] where
240 foldRegsUsed _ set [] = set
241 foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
243 instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
244 foldRegsDefd _ set [] = set
245 foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
247 instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
248 foldRegsDefd _ set Nothing = set
249 foldRegsDefd f set (Just x) = foldRegsDefd f set x
251 -----------------------------------------------------------------------------
252 -- Another reg utility
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
262 -----------------------------------------------------------------------------
264 -----------------------------------------------------------------------------
266 isStackSlotOf :: CmmExpr -> LocalReg -> Bool
267 isStackSlotOf (CmmStackSlot (RegSlot r) _) r' = r == r'
268 isStackSlotOf _ _ = False
270 regSlot :: LocalReg -> CmmExpr
271 regSlot r = CmmStackSlot (RegSlot r) (widthInBytes $ typeWidth $ localRegType r)
273 -----------------------------------------------------------------------------
274 -- Stack slot use information for expressions and other types [_$_]
275 -----------------------------------------------------------------------------
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
281 class DefinerOfSlots a where
282 foldSlotsDefd :: (b -> SubArea -> b) -> b -> a -> b
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
294 instance UserOfSlots a => UserOfSlots [a] where
295 foldSlotsUsed _ set [] = set
296 foldSlotsUsed f set (x:xs) = foldSlotsUsed f (foldSlotsUsed f set x) xs
298 instance DefinerOfSlots a => DefinerOfSlots [a] where
299 foldSlotsDefd _ set [] = set
300 foldSlotsDefd f set (x:xs) = foldSlotsDefd f (foldSlotsDefd f set x) xs
302 instance DefinerOfSlots SubArea where
303 foldSlotsDefd f z a = f z a
305 -----------------------------------------------------------------------------
306 -- Global STG registers
307 -----------------------------------------------------------------------------
309 data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
312 -----------------------------------------------------------------------------
313 -- Global STG registers
314 -----------------------------------------------------------------------------
315 vgcFlag :: CmmType -> VGcPtr
316 vgcFlag ty | isGcPtrType ty = VGcPtr
317 | otherwise = VNonGcPtr
320 -- Argument and return registers
321 = VanillaReg -- pointers, unboxed ints and chars
322 {-# UNPACK #-} !Int -- its number
325 | FloatReg -- single-precision floating-point registers
326 {-# UNPACK #-} !Int -- its number
328 | DoubleReg -- double-precision floating-point registers
329 {-# UNPACK #-} !Int -- its number
331 | LongReg -- long int registers (64-bit, really)
332 {-# UNPACK #-} !Int -- its number
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
343 -- We keep the address of some commonly-called
344 -- functions in the register table, to keep code
346 | EagerBlackholeInfo -- stg_EAGER_BLACKHOLE_info
347 | GCEnter1 -- stg_gc_enter_1
348 | GCFun -- stg_gc_fun
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.
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).
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
369 SpLim == SpLim = 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
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
388 compare SpLim SpLim = 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
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
425 compare BaseReg _ = LT
426 compare _ BaseReg = GT
427 compare EagerBlackholeInfo _ = LT
428 compare _ EagerBlackholeInfo = GT
430 -- convenient aliases
431 baseReg, spReg, hpReg, spLimReg, nodeReg :: CmmReg
432 baseReg = CmmGlobal BaseReg
435 spLimReg = CmmGlobal SpLim
436 nodeReg = CmmGlobal node
439 node = VanillaReg 1 VGcPtr
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