Remove Control.Parallel*, now in package parallel
[packages/random.git] / cbits / longlong.c
1 /* -----------------------------------------------------------------------------
2 * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
3 *
4 * (c) The GHC Team, 1998-1999
5 *
6 * Primitive operations over (64-bit) long longs
7 * (only used on 32-bit platforms.)
8 *
9 * ---------------------------------------------------------------------------*/
10
11
12 /*
13 Miscellaneous primitive operations on HsInt64 and HsWord64s.
14 N.B. These are not primops!
15
16 Instead of going the normal (boring) route of making the list
17 of primitive operations even longer to cope with operations
18 over 64-bit entities, we implement them instead 'out-of-line'.
19
20 The primitive ops get their own routine (in C) that implements
21 the operation, requiring the caller to _ccall_ out. This has
22 performance implications of course, but we currently don't
23 expect intensive use of either Int64 or Word64 types.
24
25 The exceptions to the rule are primops that cast to and from
26 64-bit entities (these are defined in PrimOps.h)
27 */
28
29 #include "Rts.h"
30
31 #ifdef SUPPORT_LONG_LONGS
32
33 /* Relational operators */
34
35 static inline HsBool mkBool(int b) { return b ? HS_BOOL_TRUE : HS_BOOL_FALSE; }
36
37 HsBool hs_gtWord64 (HsWord64 a, HsWord64 b) {return mkBool(a > b);}
38 HsBool hs_geWord64 (HsWord64 a, HsWord64 b) {return mkBool(a >= b);}
39 HsBool hs_eqWord64 (HsWord64 a, HsWord64 b) {return mkBool(a == b);}
40 HsBool hs_neWord64 (HsWord64 a, HsWord64 b) {return mkBool(a != b);}
41 HsBool hs_ltWord64 (HsWord64 a, HsWord64 b) {return mkBool(a < b);}
42 HsBool hs_leWord64 (HsWord64 a, HsWord64 b) {return mkBool(a <= b);}
43
44 HsBool hs_gtInt64 (HsInt64 a, HsInt64 b) {return mkBool(a > b);}
45 HsBool hs_geInt64 (HsInt64 a, HsInt64 b) {return mkBool(a >= b);}
46 HsBool hs_eqInt64 (HsInt64 a, HsInt64 b) {return mkBool(a == b);}
47 HsBool hs_neInt64 (HsInt64 a, HsInt64 b) {return mkBool(a != b);}
48 HsBool hs_ltInt64 (HsInt64 a, HsInt64 b) {return mkBool(a < b);}
49 HsBool hs_leInt64 (HsInt64 a, HsInt64 b) {return mkBool(a <= b);}
50
51 /* Arithmetic operators */
52
53 HsWord64 hs_remWord64 (HsWord64 a, HsWord64 b) {return a % b;}
54 HsWord64 hs_quotWord64 (HsWord64 a, HsWord64 b) {return a / b;}
55
56 HsInt64 hs_remInt64 (HsInt64 a, HsInt64 b) {return a % b;}
57 HsInt64 hs_quotInt64 (HsInt64 a, HsInt64 b) {return a / b;}
58 HsInt64 hs_negateInt64 (HsInt64 a) {return -a;}
59 HsInt64 hs_plusInt64 (HsInt64 a, HsInt64 b) {return a + b;}
60 HsInt64 hs_minusInt64 (HsInt64 a, HsInt64 b) {return a - b;}
61 HsInt64 hs_timesInt64 (HsInt64 a, HsInt64 b) {return a * b;}
62
63 /* Logical operators: */
64
65 HsWord64 hs_and64 (HsWord64 a, HsWord64 b) {return a & b;}
66 HsWord64 hs_or64 (HsWord64 a, HsWord64 b) {return a | b;}
67 HsWord64 hs_xor64 (HsWord64 a, HsWord64 b) {return a ^ b;}
68 HsWord64 hs_not64 (HsWord64 a) {return ~a;}
69
70 HsWord64 hs_uncheckedShiftL64 (HsWord64 a, HsInt b) {return a << b;}
71 HsWord64 hs_uncheckedShiftRL64 (HsWord64 a, HsInt b) {return a >> b;}
72 /* Right shifting of signed quantities is not portable in C, so
73 the behaviour you'll get from using these primops depends
74 on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
75 */
76 HsInt64 hs_uncheckedIShiftL64 (HsInt64 a, HsInt b) {return a << b;}
77 HsInt64 hs_uncheckedIShiftRA64 (HsInt64 a, HsInt b) {return a >> b;}
78 HsInt64 hs_uncheckedIShiftRL64 (HsInt64 a, HsInt b)
79 {return (HsInt64) ((HsWord64) a >> b);}
80
81 /* Casting between longs and longer longs.
82 (the primops that cast from long longs to Integers
83 expressed as macros, since these may cause some heap allocation).
84 */
85
86 HsInt64 hs_intToInt64 (HsInt i) {return (HsInt64) i;}
87 HsInt hs_int64ToInt (HsInt64 i) {return (HsInt) i;}
88 HsWord64 hs_int64ToWord64 (HsInt64 i) {return (HsWord64) i;}
89 HsWord64 hs_wordToWord64 (HsWord w) {return (HsWord64) w;}
90 HsWord hs_word64ToWord (HsWord64 w) {return (HsWord) w;}
91 HsInt64 hs_word64ToInt64 (HsWord64 w) {return (HsInt64) w;}
92
93 HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da)
94 {
95 mp_limb_t* d;
96 HsInt s;
97 HsWord64 res;
98 d = (mp_limb_t *)da;
99 s = sa;
100 switch (s) {
101 case 0: res = 0; break;
102 case 1: res = d[0]; break;
103 case -1: res = -(HsWord64)d[0]; break;
104 default:
105 res = (HsWord64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t)));
106 if (s < 0) res = -res;
107 }
108 return res;
109 }
110
111 HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da)
112 {
113 mp_limb_t* d;
114 HsInt s;
115 HsInt64 res;
116 d = (mp_limb_t *)da;
117 s = (sa);
118 switch (s) {
119 case 0: res = 0; break;
120 case 1: res = d[0]; break;
121 case -1: res = -(HsInt64)d[0]; break;
122 default:
123 res = (HsInt64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t)));
124 if (s < 0) res = -res;
125 }
126 return res;
127 }
128
129 #endif /* SUPPORT_LONG_LONGS */