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