/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.13 1999/02/01 18:05:30 simonm Exp $
+ * $Id: PrimOps.h,v 1.26 1999/04/27 12:32:15 simonm Exp $
+ *
+ * (c) The GHC Team, 1998-1999
*
* Macros for primitive operations in STG-ish C code.
*
#define zlzhzh(r,a,b) r=(I_)((a) <(b))
#define zlzezhzh(r,a,b) r=(I_)((a)<=(b))
-/* used by returning comparison primops, defined in Prims.hc. */
-extern const StgClosure *PrelBase_Bool_closure_tbl[];
-
/* -----------------------------------------------------------------------------
Char# PrimOps.
-------------------------------------------------------------------------- */
#define remIntzh(r,a,b) r=(a)%(b)
#define negateIntzh(r,a) r=-(a)
-/* The following operations are the standard add,subtract and multiply
- * except that they return a carry if the operation overflows.
+/* -----------------------------------------------------------------------------
+ * Int operations with carry.
+ * -------------------------------------------------------------------------- */
+
+/* With some bit-twiddling, we can define int{Add,Sub}Czh portably in
+ * C, and without needing any comparisons. This may not be the
+ * fastest way to do it - if you have better code, please send it! --SDM
+ *
+ * Return : r = a + b, c = 0 if no overflow, 1 on overflow.
*
- * They are all defined in terms of 32-bit integers and use the GCC
- * 'long long' extension to get a 64-bit result. We'd like to use
- * 64-bit integers on 64-bit architectures, but it seems that gcc's
- * 'long long' type is set at 64-bits even on a 64-bit machine.
+ * We currently don't make use of the r value if c is != 0 (i.e.
+ * overflow), we just convert to big integers and try again. This
+ * could be improved by making r and c the correct values for
+ * plugging into a new J#.
*/
+#define addIntCzh(r,c,a,b) \
+{ r = a + b; \
+ c = ((StgWord)(~(a^b) & (a^r))) \
+ >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+}
+
+
+#define subIntCzh(r,c,a,b) \
+{ r = a - b; \
+ c = ((StgWord)((a^b) & (a^r))) \
+ >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+}
+
+/* Multiply with overflow checking.
+ *
+ * This is slightly more tricky - the usual sign rules for add/subtract
+ * don't apply.
+ *
+ * On x86 hardware we use a hand-crafted assembly fragment to do the job.
+ *
+ * On other 32-bit machines we use gcc's 'long long' types, finding
+ * overflow with some careful bit-twiddling.
+ *
+ * On 64-bit machines where gcc's 'long long' type is also 64-bits,
+ * we use a crude approximation, testing whether either operand is
+ * larger than 32-bits; if neither is, then we go ahead with the
+ * multiplication.
+ */
+
+#if i386_TARGET_ARCH
+
+#define mulIntCzh(r,c,a,b) \
+{ \
+ __asm__("xor %1,%1\n\t \
+ imull %2,%3\n\t \
+ jno 1f\n\t \
+ movl $1,%1\n\t \
+ 1:" \
+ : "=r" (r), "=r" (c) : "r" (a), "0" (b)); \
+}
+
+#elif SIZEOF_VOID_P == 4
#ifdef WORDS_BIGENDIAN
#define C 0
StgInt32 i[2];
} long_long_u ;
-#define addWithCarryzh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a + b; \
+#define mulIntCzh(r,c,a,b) \
+{ \
+ long_long_u z; \
+ z.l = (StgInt64)a * (StgInt64)b; \
r = z.i[R]; \
c = z.i[C]; \
+ if (c == 0 || c == -1) { \
+ c = ((StgWord)((a^b) ^ r)) \
+ >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+ } \
}
+/* Careful: the carry calculation above is extremely delicate. Make sure
+ * you test it thoroughly after changing it.
+ */
+
+#else
+#define HALF_INT (1 << (BITS_PER_BYTE * sizeof(I_) / 2))
-#define subWithCarryzh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a + b; \
- r = z.i[R]; \
- c = z.i[C]; \
-}
+#define stg_abs(a) ((a) < 0 ? -(a) : (a))
-#define mulWithCarryzh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a * b; \
- r = z.i[R]; \
- c = z.i[C]; \
+#define mulIntCzh(r,c,a,b) \
+{ \
+ if (stg_abs(a) >= HALF_INT \
+ stg_abs(b) >= HALF_INT) { \
+ c = 1; \
+ } else { \
+ r = a * b; \
+ c = 0; \
+ } \
}
+#endif
/* -----------------------------------------------------------------------------
Word PrimOps.
* to allocate any memory.
*/
-#define integer2Intzh(r, aa,sa,da) \
-{ MP_INT arg; \
- \
- arg._mp_alloc = (aa); \
- arg._mp_size = (sa); \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- (r) = RET_PRIM_STGCALL1(I_,mpz_get_si,&arg); \
+#define integer2Intzh(r, sa,da) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (sa); \
+ arg._mp_alloc = ((StgArrWords *)da)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ \
+ (r) = RET_PRIM_STGCALL1(I_,mpz_get_si,&arg); \
}
-#define integer2Wordzh(r, aa,sa,da) \
-{ MP_INT arg; \
- \
- arg._mp_alloc = (aa); \
- arg._mp_size = (sa); \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg); \
+#define integer2Wordzh(r, sa,da) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (sa); \
+ arg._mp_alloc = ((StgArrWords *)da)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ \
+ (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg); \
}
-#define cmpIntegerzh(r, a1,s1,d1, a2,s2,d2) \
-{ MP_INT arg1; \
- MP_INT arg2; \
- \
- arg1._mp_alloc= (a1); \
- arg1._mp_size = (s1); \
- arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
- arg2._mp_alloc= (a2); \
- arg2._mp_size = (s2); \
- arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
- \
- (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
+#define cmpIntegerzh(r, s1,d1, s2,d2) \
+{ MP_INT arg1; \
+ MP_INT arg2; \
+ \
+ arg1._mp_size = (s1); \
+ arg1._mp_alloc= ((StgArrWords *)d1)->words; \
+ arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
+ arg2._mp_size = (s2); \
+ arg2._mp_alloc= ((StgArrWords *)d2)->words; \
+ arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
+ \
+ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
}
-/* A glorious hack: calling mpz_neg would entail allocation and
- * copying, but by looking at what mpz_neg actually does, we can
- * derive a better version:
- */
-
-#define negateIntegerzh(ra, rs, rd, a, s, d) \
-{ \
- (ra) = (a); \
- (rs) = -(s); \
- (rd) = d; \
+#define cmpIntegerIntzh(r, s,d, i) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (s); \
+ arg._mp_alloc = ((StgArrWords *)d)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d)); \
+ \
+ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \
}
/* The rest are all out-of-line: -------- */
EF_(word2Integerzh_fast);
EF_(addr2Integerzh_fast);
-/* Floating-point encodings/decodings */
-EF_(encodeFloatzh_fast);
+/* Floating-point decodings */
EF_(decodeFloatzh_fast);
-
-EF_(encodeDoublezh_fast);
EF_(decodeDoublezh_fast);
/* -----------------------------------------------------------------------------
#ifdef SUPPORT_LONG_LONGS
-#define integerToWord64zh(r, aa,sa,da) \
-{ unsigned long int* d; \
- StgNat64 res; \
- \
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- if ( (aa) == 0 ) { \
- res = (LW_)0; \
- } else if ( (aa) == 1) { \
- res = (LW_)d[0]; \
- } else { \
- res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \
- } \
- (r) = res; \
+#define integerToWord64zh(r, sa,da) \
+{ unsigned long int* d; \
+ I_ aa; \
+ StgWord64 res; \
+ \
+ d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ aa = ((StgArrWords *)da)->words; \
+ if ( (aa) == 0 ) { \
+ res = (LW_)0; \
+ } else if ( (aa) == 1) { \
+ res = (LW_)d[0]; \
+ } else { \
+ res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \
+ } \
+ (r) = res; \
}
-#define integerToInt64zh(r, aa,sa,da) \
-{ unsigned long int* d; \
- StgInt64 res; \
- \
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- if ( (aa) == 0 ) { \
- res = (LI_)0; \
- } else if ( (aa) == 1) { \
- res = (LI_)d[0]; \
- } else { \
- res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \
- if ( sa < 0 ) { \
- res = (LI_)-res; \
- } \
- } \
- (r) = res; \
+#define integerToInt64zh(r, sa,da) \
+{ unsigned long int* d; \
+ I_ aa; \
+ StgInt64 res; \
+ \
+ d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ aa = ((StgArrWords *)da)->words; \
+ if ( (aa) == 0 ) { \
+ res = (LI_)0; \
+ } else if ( (aa) == 1) { \
+ res = (LI_)d[0]; \
+ } else { \
+ res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \
+ if ( sa < 0 ) { \
+ res = (LI_)-res; \
+ } \
+ } \
+ (r) = res; \
}
/* Conversions */
/* The rest are (way!) out of line, implemented via C entry points.
*/
-I_ stg_gtWord64 (StgNat64, StgNat64);
-I_ stg_geWord64 (StgNat64, StgNat64);
-I_ stg_eqWord64 (StgNat64, StgNat64);
-I_ stg_neWord64 (StgNat64, StgNat64);
-I_ stg_ltWord64 (StgNat64, StgNat64);
-I_ stg_leWord64 (StgNat64, StgNat64);
+I_ stg_gtWord64 (StgWord64, StgWord64);
+I_ stg_geWord64 (StgWord64, StgWord64);
+I_ stg_eqWord64 (StgWord64, StgWord64);
+I_ stg_neWord64 (StgWord64, StgWord64);
+I_ stg_ltWord64 (StgWord64, StgWord64);
+I_ stg_leWord64 (StgWord64, StgWord64);
I_ stg_gtInt64 (StgInt64, StgInt64);
I_ stg_geInt64 (StgInt64, StgInt64);
I_ stg_ltInt64 (StgInt64, StgInt64);
I_ stg_leInt64 (StgInt64, StgInt64);
-LW_ stg_remWord64 (StgNat64, StgNat64);
-LW_ stg_quotWord64 (StgNat64, StgNat64);
+LW_ stg_remWord64 (StgWord64, StgWord64);
+LW_ stg_quotWord64 (StgWord64, StgWord64);
LI_ stg_remInt64 (StgInt64, StgInt64);
LI_ stg_quotInt64 (StgInt64, StgInt64);
LI_ stg_minusInt64 (StgInt64, StgInt64);
LI_ stg_timesInt64 (StgInt64, StgInt64);
-LW_ stg_and64 (StgNat64, StgNat64);
-LW_ stg_or64 (StgNat64, StgNat64);
-LW_ stg_xor64 (StgNat64, StgNat64);
-LW_ stg_not64 (StgNat64);
+LW_ stg_and64 (StgWord64, StgWord64);
+LW_ stg_or64 (StgWord64, StgWord64);
+LW_ stg_xor64 (StgWord64, StgWord64);
+LW_ stg_not64 (StgWord64);
-LW_ stg_shiftL64 (StgNat64, StgInt);
-LW_ stg_shiftRL64 (StgNat64, StgInt);
+LW_ stg_shiftL64 (StgWord64, StgInt);
+LW_ stg_shiftRL64 (StgWord64, StgInt);
LI_ stg_iShiftL64 (StgInt64, StgInt);
LI_ stg_iShiftRL64 (StgInt64, StgInt);
LI_ stg_iShiftRA64 (StgInt64, StgInt);
LW_ stg_int64ToWord64 (StgInt64);
LW_ stg_wordToWord64 (StgWord);
-W_ stg_word64ToWord (StgNat64);
-LI_ stg_word64ToInt64 (StgNat64);
+W_ stg_word64ToWord (StgWord64);
+LI_ stg_word64ToInt64 (StgWord64);
#endif
/* -----------------------------------------------------------------------------
#ifdef DEBUG
#define BYTE_ARR_CTS(a) \
- ({ ASSERT((GET_INFO(a) == &ARR_WORDS_info) \
- || (GET_INFO(a) == &MUT_ARR_WORDS_info)); \
+ ({ ASSERT(GET_INFO(a) == &ARR_WORDS_info); \
REAL_BYTE_ARR_CTS(a); })
#define PTRS_ARR_CTS(a) \
({ ASSERT((GET_INFO(a) == &ARR_PTRS_info) \
}
#define unsafeFreezzeByteArrayzh(r,a) r=(a)
+#define unsafeThawByteArrayzh(r,a) r=(a)
+
+EF_(unsafeThawArrayzh_fast);
#define sizzeofByteArrayzh(r,a) \
r = (((StgArrWords *)(a))->words * sizeof(W_))
/* We only support IEEE floating point format */
#include "ieee-flpt.h"
-#if FLOATS_AS_DOUBLES /* i.e. 64-bit machines */
-#define encodeFloatzh(r, aa,sa,da, expon) encodeDoublezh(r, aa,sa,da, expon)
-#else
-#define encodeFloatzh(r, aa,sa,da, expon) \
-{ MP_INT arg; \
- /* Does not allocate memory */ \
- \
- arg._mp_alloc = aa; \
- arg._mp_size = sa; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- r = RET_PRIM_STGCALL2(StgFloat, __encodeFloat,&arg,(expon));\
-}
-#endif /* FLOATS_AS_DOUBLES */
-
-#define encodeDoublezh(r, aa,sa,da, expon) \
-{ MP_INT arg; \
- /* Does not allocate memory */ \
- \
- arg._mp_alloc = aa; \
- arg._mp_size = sa; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- r = RET_PRIM_STGCALL2(StgDouble, __encodeDouble,&arg,(expon));\
-}
-
/* The decode operations are out-of-line because they need to allocate
* a byte array.
*/
-
#ifdef FLOATS_AS_DOUBLES
#define decodeFloatzh_fast decodeDoublezh_fast
#else
/* grimy low-level support functions defined in StgPrimFloat.c */
-extern StgDouble __encodeDouble (MP_INT *s, I_ e);
-extern StgFloat __encodeFloat (MP_INT *s, I_ e);
+extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e);
+extern StgDouble __int_encodeDouble (I_ j, I_ e);
+#ifndef FLOATS_AS_DOUBLES
+extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e);
+extern StgFloat __int_encodeFloat (I_ j, I_ e);
+#endif
extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt);
extern StgInt isDoubleNaN(StgDouble d);
-------------------------------------------------------------------------- */
EF_(forkzh_fast);
+EF_(yieldzh_fast);
EF_(killThreadzh_fast);
EF_(seqzh_fast);
+#define myThreadIdzh(t) (t = CurrentTSO)
+
/* Hmm, I'll think about these later. */
/* -----------------------------------------------------------------------------
Pointer equality
#ifndef PAR
EF_(mkWeakzh_fast);
-EF_(finaliseWeakzh_fast);
+EF_(finalizzeWeakzh_fast);
-#define deRefWeakzh(code,val,w) \
+#define deRefWeakzh(code,val,w) \
if (((StgWeak *)w)->header.info == &WEAK_info) { \
code = 1; \
- val = ((StgWeak *)w)->value; \
+ val = (P_)((StgWeak *)w)->value; \
} else { \
code = 0; \
- val = (StgClosure *)w; \
+ val = (P_)w; \
}
#define sameWeakzh(w1,w2) ((w1)==(w2))
#endif
/* -----------------------------------------------------------------------------
+ Constructor tags
+ -------------------------------------------------------------------------- */
+
+#define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
+/* tagToEnum# is handled directly by the code generator. */
+
+/* -----------------------------------------------------------------------------
Signal processing. Not really primops, but called directly from
Haskell.
-------------------------------------------------------------------------- */
projects / ghc-hetmet.git / blobdiff