X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=ba03df8a290b4b7ca479c443ee81a997172ea9f6;hb=9b910bc846cfb1f1d04de2ae2915cdd4e0aef5a7;hp=932500bbe1777ead027f6f1d9fa356340454cc43;hpb=18976e614fd90a8d81ced2c3e9cd8e38d72a1f40;p=ghc-hetmet.git diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 932500b..ba03df8 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.11 1999/01/27 14:51:15 simonpj Exp $ + * $Id: PrimOps.h,v 1.23 1999/03/05 10:21:29 sof Exp $ + * + * (c) The GHC Team, 1998-1999 * * Macros for primitive operations in STG-ish C code. * @@ -57,7 +59,7 @@ #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[]; +extern DLL_IMPORT_RTS const StgClosure *PrelBase_Bool_closure_tbl[]; /* ----------------------------------------------------------------------------- Char# PrimOps. @@ -80,14 +82,63 @@ I_ stg_div (I_ a, I_ b); #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 * - * 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. + * Return : r = a + b, c = 0 if no overflow, 1 on overflow. + * + * 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 @@ -102,27 +153,38 @@ typedef union { 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 subWithCarryzh(r,c,a,b) \ -{ long_long_u z; \ - z.l = a + b; \ - r = z.i[R]; \ - c = z.i[C]; \ -} +#define HALF_INT (1 << (BITS_PER_BYTE * sizeof(I_) / 2)) -#define mulWithCarryzh(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 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. @@ -246,50 +308,48 @@ typedef union { * 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: -------- */ @@ -307,11 +367,8 @@ EF_(int2Integerzh_fast); 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); /* ----------------------------------------------------------------------------- @@ -320,37 +377,41 @@ 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 */ @@ -359,12 +420,12 @@ EF_(word64ToIntegerzh_fast); /* 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); @@ -373,8 +434,8 @@ I_ stg_neInt64 (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); @@ -383,13 +444,13 @@ LI_ stg_plusInt64 (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); @@ -399,8 +460,8 @@ I_ stg_int64ToInt (StgInt64); 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 /* ----------------------------------------------------------------------------- @@ -415,8 +476,7 @@ LI_ stg_word64ToInt64 (StgNat64); #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) \ @@ -427,8 +487,8 @@ LI_ stg_word64ToInt64 (StgNat64); #define PTRS_ARR_CTS(a) REAL_PTRS_ARR_CTS(a) #endif -extern I_ genSymzh(void); -extern I_ resetGenSymzh(void); +extern I_ genSymZh(void); +extern I_ resetGenSymZh(void); /*--- everything except new*Array is done inline: */ @@ -515,6 +575,9 @@ extern I_ resetGenSymzh(void); } #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_)) @@ -537,36 +600,9 @@ EF_(newArrayzh_fast); /* 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 @@ -577,8 +613,12 @@ EF_(decodeDoublezh_fast); /* 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); @@ -685,7 +725,17 @@ EF_(seqzh_fast); #ifndef PAR EF_(mkWeakzh_fast); -EF_(deRefWeakzh_fast); +EF_(finalizzeWeakzh_fast); + +#define deRefWeakzh(code,val,w) \ + if (((StgWeak *)w)->header.info == &WEAK_info) { \ + code = 1; \ + val = (P_)((StgWeak *)w)->value; \ + } else { \ + code = 0; \ + val = (P_)w; \ + } + #define sameWeakzh(w1,w2) ((w1)==(w2)) #endif