766f4f36a9c8bdbdcefba33920cb22173996e57f
[ghc-hetmet.git] / compiler / cmm / MachOp.hs
1 -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow 2002-2006
4 --
5 -- Low-level machine operations, used in the Cmm datatype.
6 --
7 -----------------------------------------------------------------------------
8
9 {-# OPTIONS_GHC -w #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 --     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
14 -- for details
15
16 module MachOp   ( 
17         MachRep(..), 
18         machRepBitWidth,
19         machRepByteWidth,
20         machRepLogWidth,
21         isFloatingRep,
22
23         MachHint(..),
24
25         MachOp(..), 
26         pprMachOp,
27         isCommutableMachOp,
28         isAssociativeMachOp,
29         isComparisonMachOp,
30         resultRepOfMachOp,
31         machOpArgReps,
32         maybeInvertComparison,
33
34         CallishMachOp(..),
35         pprCallishMachOp,
36
37         wordRep,
38         halfWordRep,
39         cIntRep, cLongRep,
40
41         mo_wordAdd,
42         mo_wordSub,
43         mo_wordEq,
44         mo_wordNe,
45         mo_wordMul,
46         mo_wordSQuot,
47         mo_wordSRem,
48         mo_wordSNeg,
49         mo_wordUQuot,
50         mo_wordURem,
51
52         mo_wordSGe,
53         mo_wordSLe,
54         mo_wordSGt,
55         mo_wordSLt,
56
57         mo_wordUGe,
58         mo_wordULe,
59         mo_wordUGt,
60         mo_wordULt,
61
62         mo_wordAnd,
63         mo_wordOr,
64         mo_wordXor,
65         mo_wordNot,
66         mo_wordShl,
67         mo_wordSShr,
68         mo_wordUShr,
69
70         mo_u_8To32,
71         mo_s_8To32,
72         mo_u_16To32,
73         mo_s_16To32,
74
75         mo_u_8ToWord,
76         mo_s_8ToWord,
77         mo_u_16ToWord,
78         mo_s_16ToWord,
79         mo_u_32ToWord,
80         mo_s_32ToWord,
81
82         mo_32To8,
83         mo_32To16,
84         mo_WordTo8,
85         mo_WordTo16,
86         mo_WordTo32,
87   ) where
88
89 #include "HsVersions.h"
90
91 import Constants
92 import Outputable
93
94 -- -----------------------------------------------------------------------------
95 -- MachRep
96
97 {- |
98 A MachRep is the "representation" of a value in Cmm.  It is used for
99 resource allocation: eg. which kind of register a value should be
100 stored in.  
101
102 The primary requirement is that there exists a function
103
104   cmmExprRep :: CmmExpr -> MachRep
105
106 This means that:
107
108   - a register has an implicit MachRep
109   - a literal has an implicit MachRep
110   - an operation (MachOp) has an implicit result MachRep
111
112 It also means that we can check that the arguments to a MachOp have
113 the correct MachRep, i.e. we can do a kind of lint-style type checking
114 on Cmm.
115 -}
116
117 data MachRep
118   = I8
119   | I16
120   | I32
121   | I64
122   | I128
123   | F32
124   | F64
125   | F80         -- extended double-precision, used in x86 native codegen only.
126   deriving (Eq, Ord, Show)
127
128 mrStr I8   = SLIT("I8")
129 mrStr I16  = SLIT("I16")
130 mrStr I32  = SLIT("I32")
131 mrStr I64  = SLIT("I64")
132 mrStr I128 = SLIT("I128")
133 mrStr F32  = SLIT("F32")
134 mrStr F64  = SLIT("F64")
135 mrStr F80  = SLIT("F80")
136
137 instance Outputable MachRep where
138    ppr rep = ptext (mrStr rep)
139
140 {- 
141 Implementation notes:
142
143 It might suffice to keep just a width, without distinguishing between
144 floating and integer types.  However, keeping the distinction will
145 help the native code generator to assign registers more easily.
146 -}
147
148 {-
149 Should a MachRep include a signed vs. unsigned distinction?
150
151 This is very much like a "hint" in C-- terminology: it isn't necessary
152 in order to generate correct code, but it might be useful in that the
153 compiler can generate better code if it has access to higher-level
154 hints about data.  This is important at call boundaries, because the
155 definition of a function is not visible at all of its call sites, so
156 the compiler cannot infer the hints.
157
158 Here in Cmm, we're taking a slightly different approach.  We include
159 the int vs. float hint in the MachRep, because (a) the majority of
160 platforms have a strong distinction between float and int registers,
161 and (b) we don't want to do any heavyweight hint-inference in the
162 native code backend in order to get good code.  We're treating the
163 hint more like a type: our Cmm is always completely consistent with
164 respect to hints.  All coercions between float and int are explicit.
165
166 What about the signed vs. unsigned hint?  This information might be
167 useful if we want to keep sub-word-sized values in word-size
168 registers, which we must do if we only have word-sized registers.
169
170 On such a system, there are two straightforward conventions for
171 representing sub-word-sized values:
172
173 (a) Leave the upper bits undefined.  Comparison operations must
174     sign- or zero-extend both operands before comparing them,
175     depending on whether the comparison is signed or unsigned.
176
177 (b) Always keep the values sign- or zero-extended as appropriate.
178     Arithmetic operations must narrow the result to the appropriate
179     size.
180
181 A clever compiler might not use either (a) or (b) exclusively, instead
182 it would attempt to minimize the coercions by analysis: the same kind
183 of analysis that propagates hints around.  In Cmm we don't want to
184 have to do this, so we plump for having richer types and keeping the
185 type information consistent.
186
187 If signed/unsigned hints are missing from MachRep, then the only
188 choice we have is (a), because we don't know whether the result of an
189 operation should be sign- or zero-extended.
190
191 Many architectures have extending load operations, which work well
192 with (b).  To make use of them with (a), you need to know whether the
193 value is going to be sign- or zero-extended by an enclosing comparison
194 (for example), which involves knowing above the context.  This is
195 doable but more complex.
196
197 Further complicating the issue is foreign calls: a foreign calling
198 convention can specify that signed 8-bit quantities are passed as
199 sign-extended 32 bit quantities, for example (this is the case on the
200 PowerPC).  So we *do* need sign information on foreign call arguments.
201
202 Pros for adding signed vs. unsigned to MachRep:
203
204   - It would let us use convention (b) above, and get easier
205     code generation for extending loads.
206
207   - Less information required on foreign calls.
208   
209   - MachOp type would be simpler
210
211 Cons:
212
213   - More complexity
214
215   - What is the MachRep for a VanillaReg?  Currently it is
216     always wordRep, but now we have to decide whether it is
217     signed or unsigned.  The same VanillaReg can thus have
218     different MachReps in different parts of the program.
219
220   - Extra coercions cluttering up expressions.
221
222 Currently for GHC, the foreign call point is moot, because we do our
223 own promotion of sub-word-sized values to word-sized values.  The Int8
224 type is represnted by an Int# which is kept sign-extended at all times
225 (this is slightly naughty, because we're making assumptions about the
226 C calling convention rather early on in the compiler).  However, given
227 this, the cons outweigh the pros.
228
229 -}
230
231
232 machRepBitWidth :: MachRep -> Int
233 machRepBitWidth I8   = 8
234 machRepBitWidth I16  = 16
235 machRepBitWidth I32  = 32
236 machRepBitWidth I64  = 64
237 machRepBitWidth I128 = 128
238 machRepBitWidth F32  = 32
239 machRepBitWidth F64  = 64
240 machRepBitWidth F80  = 80
241
242 machRepByteWidth :: MachRep -> Int
243 machRepByteWidth I8   = 1
244 machRepByteWidth I16  = 2
245 machRepByteWidth I32  = 4
246 machRepByteWidth I64  = 8
247 machRepByteWidth I128 = 16
248 machRepByteWidth F32  = 4
249 machRepByteWidth F64  = 8
250 machRepByteWidth F80  = 10
251
252 -- log_2 of the width in bytes, useful for generating shifts.
253 machRepLogWidth :: MachRep -> Int
254 machRepLogWidth I8   = 0
255 machRepLogWidth I16  = 1
256 machRepLogWidth I32  = 2
257 machRepLogWidth I64  = 3
258 machRepLogWidth I128 = 4
259 machRepLogWidth F32  = 2
260 machRepLogWidth F64  = 3
261 machRepLogWidth F80  = panic "machRepLogWidth: F80"
262
263 isFloatingRep :: MachRep -> Bool
264 isFloatingRep F32 = True
265 isFloatingRep F64 = True
266 isFloatingRep F80 = True
267 isFloatingRep _   = False
268
269 -- -----------------------------------------------------------------------------
270 -- Hints
271
272 {-
273 A hint gives a little more information about a data value.  Hints are
274 used on the arguments to a foreign call, where the code generator needs
275 to know some extra information on top of the MachRep of each argument in
276 order to generate a correct call.
277 -}
278
279 data MachHint
280   = NoHint
281   | PtrHint
282   | SignedHint
283   | FloatHint
284   deriving Eq
285
286 mhStr NoHint     = SLIT("NoHint")
287 mhStr PtrHint    = SLIT("PtrHint")
288 mhStr SignedHint = SLIT("SignedHint")
289 mhStr FloatHint  = SLIT("FloatHint")
290
291 instance Outputable MachHint where
292    ppr hint = ptext (mhStr hint)
293
294 -- -----------------------------------------------------------------------------
295 -- MachOp
296
297 {- |
298 Machine-level primops; ones which we can reasonably delegate to the
299 native code generators to handle.  Basically contains C's primops
300 and no others.
301
302 Nomenclature: all ops indicate width and signedness, where
303 appropriate.  Widths: 8\/16\/32\/64 means the given size, obviously.
304 Nat means the operation works on STG word sized objects.
305 Signedness: S means signed, U means unsigned.  For operations where
306 signedness is irrelevant or makes no difference (for example
307 integer add), the signedness component is omitted.
308
309 An exception: NatP is a ptr-typed native word.  From the point of
310 view of the native code generators this distinction is irrelevant,
311 but the C code generator sometimes needs this info to emit the
312 right casts.  
313 -}
314
315 data MachOp
316
317   -- Integer operations
318   = MO_Add    MachRep
319   | MO_Sub    MachRep
320   | MO_Eq     MachRep
321   | MO_Ne     MachRep
322   | MO_Mul    MachRep           -- low word of multiply
323   | MO_S_MulMayOflo MachRep     -- nonzero if signed multiply overflows
324   | MO_S_Quot MachRep           -- signed / (same semantics as IntQuotOp)
325   | MO_S_Rem  MachRep           -- signed % (same semantics as IntRemOp)
326   | MO_S_Neg  MachRep           -- unary -
327   | MO_U_MulMayOflo MachRep     -- nonzero if unsigned multiply overflows
328   | MO_U_Quot MachRep           -- unsigned / (same semantics as WordQuotOp)
329   | MO_U_Rem  MachRep           -- unsigned % (same semantics as WordRemOp)
330
331   -- Signed comparisons (floating-point comparisons also use these)
332   | MO_S_Ge MachRep
333   | MO_S_Le MachRep
334   | MO_S_Gt MachRep
335   | MO_S_Lt MachRep
336
337   -- Unsigned comparisons
338   | MO_U_Ge MachRep
339   | MO_U_Le MachRep
340   | MO_U_Gt MachRep
341   | MO_U_Lt MachRep
342
343   -- Bitwise operations.  Not all of these may be supported at all sizes,
344   -- and only integral MachReps are valid.
345   | MO_And   MachRep
346   | MO_Or    MachRep
347   | MO_Xor   MachRep
348   | MO_Not   MachRep
349   | MO_Shl   MachRep
350   | MO_U_Shr MachRep    -- unsigned shift right
351   | MO_S_Shr MachRep    -- signed shift right
352
353   -- Conversions.  Some of these will be NOPs.
354   -- Floating-point conversions use the signed variant.
355   | MO_S_Conv MachRep{-from-} MachRep{-to-}     -- signed conversion
356   | MO_U_Conv MachRep{-from-} MachRep{-to-}     -- unsigned conversion
357
358   deriving (Eq, Show)
359
360 pprMachOp :: MachOp -> SDoc
361 pprMachOp mo = text (show mo)
362
363
364 -- These MachOps tend to be implemented by foreign calls in some backends,
365 -- so we separate them out.  In Cmm, these can only occur in a
366 -- statement position, in contrast to an ordinary MachOp which can occur
367 -- anywhere in an expression.
368 data CallishMachOp
369   = MO_F64_Pwr
370   | MO_F64_Sin
371   | MO_F64_Cos
372   | MO_F64_Tan
373   | MO_F64_Sinh
374   | MO_F64_Cosh
375   | MO_F64_Tanh
376   | MO_F64_Asin
377   | MO_F64_Acos
378   | MO_F64_Atan
379   | MO_F64_Log
380   | MO_F64_Exp
381   | MO_F64_Sqrt
382   | MO_F32_Pwr
383   | MO_F32_Sin
384   | MO_F32_Cos
385   | MO_F32_Tan
386   | MO_F32_Sinh
387   | MO_F32_Cosh
388   | MO_F32_Tanh
389   | MO_F32_Asin
390   | MO_F32_Acos
391   | MO_F32_Atan
392   | MO_F32_Log
393   | MO_F32_Exp
394   | MO_F32_Sqrt
395   | MO_WriteBarrier
396   deriving (Eq, Show)
397
398 pprCallishMachOp :: CallishMachOp -> SDoc
399 pprCallishMachOp mo = text (show mo)
400
401 -- -----------------------------------------------------------------------------
402 -- Some common MachReps
403
404 -- A 'wordRep' is a machine word on the target architecture
405 -- Specifically, it is the size of an Int#, Word#, Addr# 
406 -- and the unit of allocation on the stack and the heap
407 -- Any pointer is also guaranteed to be a wordRep.
408
409 wordRep | wORD_SIZE == 4 = I32
410         | wORD_SIZE == 8 = I64
411         | otherwise      = panic "MachOp.wordRep: Unknown word size"
412
413 halfWordRep | wORD_SIZE == 4 = I16
414             | wORD_SIZE == 8 = I32
415             | otherwise      = panic "MachOp.halfWordRep: Unknown word size"
416
417 mo_wordAdd      = MO_Add wordRep
418 mo_wordSub      = MO_Sub wordRep
419 mo_wordEq       = MO_Eq  wordRep
420 mo_wordNe       = MO_Ne  wordRep
421 mo_wordMul      = MO_Mul wordRep
422 mo_wordSQuot    = MO_S_Quot wordRep
423 mo_wordSRem     = MO_S_Rem wordRep
424 mo_wordSNeg     = MO_S_Neg wordRep
425 mo_wordUQuot    = MO_U_Quot wordRep
426 mo_wordURem     = MO_U_Rem wordRep
427
428 mo_wordSGe      = MO_S_Ge  wordRep
429 mo_wordSLe      = MO_S_Le  wordRep
430 mo_wordSGt      = MO_S_Gt  wordRep
431 mo_wordSLt      = MO_S_Lt  wordRep
432
433 mo_wordUGe      = MO_U_Ge  wordRep
434 mo_wordULe      = MO_U_Le  wordRep
435 mo_wordUGt      = MO_U_Gt  wordRep
436 mo_wordULt      = MO_U_Lt  wordRep
437
438 mo_wordAnd      = MO_And wordRep
439 mo_wordOr       = MO_Or  wordRep
440 mo_wordXor      = MO_Xor wordRep
441 mo_wordNot      = MO_Not wordRep
442 mo_wordShl      = MO_Shl wordRep
443 mo_wordSShr     = MO_S_Shr wordRep 
444 mo_wordUShr     = MO_U_Shr wordRep 
445
446 mo_u_8To32      = MO_U_Conv I8 I32
447 mo_s_8To32      = MO_S_Conv I8 I32
448 mo_u_16To32     = MO_U_Conv I16 I32
449 mo_s_16To32     = MO_S_Conv I16 I32
450
451 mo_u_8ToWord    = MO_U_Conv I8  wordRep
452 mo_s_8ToWord    = MO_S_Conv I8  wordRep
453 mo_u_16ToWord   = MO_U_Conv I16 wordRep
454 mo_s_16ToWord   = MO_S_Conv I16 wordRep
455 mo_s_32ToWord   = MO_S_Conv I32 wordRep
456 mo_u_32ToWord   = MO_U_Conv I32 wordRep
457
458 mo_WordTo8      = MO_U_Conv wordRep I8
459 mo_WordTo16     = MO_U_Conv wordRep I16
460 mo_WordTo32     = MO_U_Conv wordRep I32
461
462 mo_32To8        = MO_U_Conv I32 I8
463 mo_32To16       = MO_U_Conv I32 I16
464
465 -- cIntRep is the MachRep for a C-language 'int'
466 #if SIZEOF_INT == 4
467 cIntRep = I32
468 #elif  SIZEOF_INT == 8
469 cIntRep = I64
470 #endif
471
472 #if SIZEOF_LONG == 4
473 cLongRep = I32
474 #elif  SIZEOF_LONG == 8
475 cLongRep = I64
476 #endif
477
478 -- ----------------------------------------------------------------------------
479 -- isCommutableMachOp
480
481 {- |
482 Returns 'True' if the MachOp has commutable arguments.  This is used
483 in the platform-independent Cmm optimisations.
484
485 If in doubt, return 'False'.  This generates worse code on the
486 native routes, but is otherwise harmless.
487 -}
488 isCommutableMachOp :: MachOp -> Bool
489 isCommutableMachOp mop = 
490   case mop of
491         MO_Add _                -> True
492         MO_Eq _                 -> True
493         MO_Ne _                 -> True
494         MO_Mul _                -> True
495         MO_S_MulMayOflo _       -> True
496         MO_U_MulMayOflo _       -> True
497         MO_And _                -> True
498         MO_Or _                 -> True
499         MO_Xor _                -> True
500         _other                  -> False
501
502 -- ----------------------------------------------------------------------------
503 -- isAssociativeMachOp
504
505 {- |
506 Returns 'True' if the MachOp is associative (i.e. @(x+y)+z == x+(y+z)@)
507 This is used in the platform-independent Cmm optimisations.
508
509 If in doubt, return 'False'.  This generates worse code on the
510 native routes, but is otherwise harmless.
511 -}
512 isAssociativeMachOp :: MachOp -> Bool
513 isAssociativeMachOp mop = 
514   case mop of
515         MO_Add r        -> not (isFloatingRep r)
516         MO_Mul r        -> not (isFloatingRep r)
517         MO_And _        -> True
518         MO_Or _         -> True
519         MO_Xor _        -> True
520         _other          -> False
521
522 -- ----------------------------------------------------------------------------
523 -- isComparisonMachOp
524
525 {- | 
526 Returns 'True' if the MachOp is a comparison.
527
528 If in doubt, return False.  This generates worse code on the
529 native routes, but is otherwise harmless.
530 -}
531 isComparisonMachOp :: MachOp -> Bool
532 isComparisonMachOp mop = 
533   case mop of
534     MO_Eq   _  -> True
535     MO_Ne   _  -> True
536     MO_S_Ge _  -> True
537     MO_S_Le _  -> True
538     MO_S_Gt _  -> True
539     MO_S_Lt _  -> True
540     MO_U_Ge _  -> True
541     MO_U_Le _  -> True
542     MO_U_Gt _  -> True
543     MO_U_Lt _  -> True
544     _other     -> False
545
546 -- -----------------------------------------------------------------------------
547 -- Inverting conditions
548
549 -- Sometimes it's useful to be able to invert the sense of a
550 -- condition.  Not all conditional tests are invertible: in
551 -- particular, floating point conditionals cannot be inverted, because
552 -- there exist floating-point values which return False for both senses
553 -- of a condition (eg. !(NaN > NaN) && !(NaN /<= NaN)).
554
555 maybeInvertComparison :: MachOp -> Maybe MachOp
556 maybeInvertComparison op
557   = case op of
558         MO_Eq r    | not (isFloatingRep r) -> Just (MO_Ne r)
559         MO_Ne r    | not (isFloatingRep r) -> Just (MO_Eq r)
560         MO_U_Lt r  | not (isFloatingRep r) -> Just (MO_U_Ge r)
561         MO_U_Gt r  | not (isFloatingRep r) -> Just (MO_U_Le r)
562         MO_U_Le r  | not (isFloatingRep r) -> Just (MO_U_Gt r)
563         MO_U_Ge r  | not (isFloatingRep r) -> Just (MO_U_Lt r)
564         MO_S_Lt r  | not (isFloatingRep r) -> Just (MO_S_Ge r)
565         MO_S_Gt r  | not (isFloatingRep r) -> Just (MO_S_Le r)
566         MO_S_Le r  | not (isFloatingRep r) -> Just (MO_S_Gt r)
567         MO_S_Ge r  | not (isFloatingRep r) -> Just (MO_S_Lt r)
568         _other  -> Nothing
569
570 -- ----------------------------------------------------------------------------
571 -- resultRepOfMachOp
572
573 {- |
574 Returns the MachRep of the result of a MachOp.
575 -}
576 resultRepOfMachOp :: MachOp -> MachRep
577 resultRepOfMachOp mop =
578   case mop of
579     MO_Add    r         -> r
580     MO_Sub    r         -> r
581     MO_Eq     r         -> comparisonResultRep
582     MO_Ne     r         -> comparisonResultRep
583     MO_Mul    r         -> r
584     MO_S_MulMayOflo r   -> r
585     MO_S_Quot r         -> r
586     MO_S_Rem  r         -> r
587     MO_S_Neg  r         -> r
588     MO_U_MulMayOflo r   -> r
589     MO_U_Quot r         -> r
590     MO_U_Rem  r         -> r
591
592     MO_S_Ge r           -> comparisonResultRep
593     MO_S_Le r           -> comparisonResultRep
594     MO_S_Gt r           -> comparisonResultRep
595     MO_S_Lt r           -> comparisonResultRep
596
597     MO_U_Ge r           -> comparisonResultRep
598     MO_U_Le r           -> comparisonResultRep
599     MO_U_Gt r           -> comparisonResultRep
600     MO_U_Lt r           -> comparisonResultRep
601
602     MO_And   r          -> r
603     MO_Or    r          -> r
604     MO_Xor   r          -> r
605     MO_Not   r          -> r
606     MO_Shl   r          -> r
607     MO_U_Shr r          -> r
608     MO_S_Shr r          -> r
609
610     MO_S_Conv from to   -> to
611     MO_U_Conv from to   -> to
612
613
614 comparisonResultRep = wordRep  -- is it?
615
616
617 -- -----------------------------------------------------------------------------
618 -- machOpArgReps
619
620 -- | This function is used for debugging only: we can check whether an
621 -- application of a MachOp is "type-correct" by checking that the MachReps of
622 -- its arguments are the same as the MachOp expects.  This is used when 
623 -- linting a CmmExpr.
624
625 machOpArgReps :: MachOp -> [MachRep]
626 machOpArgReps op = 
627   case op of
628     MO_Add    r         -> [r,r]
629     MO_Sub    r         -> [r,r]
630     MO_Eq     r         -> [r,r]
631     MO_Ne     r         -> [r,r]
632     MO_Mul    r         -> [r,r]
633     MO_S_MulMayOflo r   -> [r,r]
634     MO_S_Quot r         -> [r,r]
635     MO_S_Rem  r         -> [r,r]
636     MO_S_Neg  r         -> [r]
637     MO_U_MulMayOflo r   -> [r,r]
638     MO_U_Quot r         -> [r,r]
639     MO_U_Rem  r         -> [r,r]
640
641     MO_S_Ge r           -> [r,r]
642     MO_S_Le r           -> [r,r]
643     MO_S_Gt r           -> [r,r]
644     MO_S_Lt r           -> [r,r]
645
646     MO_U_Ge r           -> [r,r]
647     MO_U_Le r           -> [r,r]
648     MO_U_Gt r           -> [r,r]
649     MO_U_Lt r           -> [r,r]
650
651     MO_And   r          -> [r,r]
652     MO_Or    r          -> [r,r]
653     MO_Xor   r          -> [r,r]
654     MO_Not   r          -> [r]
655     MO_Shl   r          -> [r,wordRep]
656     MO_U_Shr r          -> [r,wordRep]
657     MO_S_Shr r          -> [r,wordRep]
658
659     MO_S_Conv from to   -> [from]
660     MO_U_Conv from to   -> [from]