X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=60305975d6fa13d8a1c623c214b24d221b4e0247;hb=456eca7317895df8193d83b986352b6238e3824d;hp=16643035e3f478b30529980931862b6d404d7588;hpb=af4450c8d5658c26000938d8798d19bac1f5f5e0;p=ghc-hetmet.git diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 1664303..6030597 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.7 1999/01/19 09:49:55 simonm Exp $ + * $Id: PrimOps.h,v 1.24 1999/03/16 13:20:09 simonm Exp $ + * + * (c) The GHC Team, 1998-1999 * * Macros for primitive operations in STG-ish C code. * @@ -12,59 +14,59 @@ Comparison PrimOps. -------------------------------------------------------------------------- */ -#define gtCharZh(r,a,b) r=(I_)((a)> (b)) -#define geCharZh(r,a,b) r=(I_)((a)>=(b)) -#define eqCharZh(r,a,b) r=(I_)((a)==(b)) -#define neCharZh(r,a,b) r=(I_)((a)!=(b)) -#define ltCharZh(r,a,b) r=(I_)((a)< (b)) -#define leCharZh(r,a,b) r=(I_)((a)<=(b)) +#define gtCharzh(r,a,b) r=(I_)((a)> (b)) +#define geCharzh(r,a,b) r=(I_)((a)>=(b)) +#define eqCharzh(r,a,b) r=(I_)((a)==(b)) +#define neCharzh(r,a,b) r=(I_)((a)!=(b)) +#define ltCharzh(r,a,b) r=(I_)((a)< (b)) +#define leCharzh(r,a,b) r=(I_)((a)<=(b)) /* Int comparisons: >#, >=# etc */ -#define ZgZh(r,a,b) r=(I_)((a) >(b)) -#define ZgZeZh(r,a,b) r=(I_)((a)>=(b)) -#define ZeZeZh(r,a,b) r=(I_)((a)==(b)) -#define ZdZeZh(r,a,b) r=(I_)((a)!=(b)) -#define ZlZh(r,a,b) r=(I_)((a) <(b)) -#define ZlZeZh(r,a,b) r=(I_)((a)<=(b)) - -#define gtWordZh(r,a,b) r=(I_)((a) >(b)) -#define geWordZh(r,a,b) r=(I_)((a)>=(b)) -#define eqWordZh(r,a,b) r=(I_)((a)==(b)) -#define neWordZh(r,a,b) r=(I_)((a)!=(b)) -#define ltWordZh(r,a,b) r=(I_)((a) <(b)) -#define leWordZh(r,a,b) r=(I_)((a)<=(b)) - -#define gtAddrZh(r,a,b) r=(I_)((a) >(b)) -#define geAddrZh(r,a,b) r=(I_)((a)>=(b)) -#define eqAddrZh(r,a,b) r=(I_)((a)==(b)) -#define neAddrZh(r,a,b) r=(I_)((a)!=(b)) -#define ltAddrZh(r,a,b) r=(I_)((a) <(b)) -#define leAddrZh(r,a,b) r=(I_)((a)<=(b)) - -#define gtFloatZh(r,a,b) r=(I_)((a)> (b)) -#define geFloatZh(r,a,b) r=(I_)((a)>=(b)) -#define eqFloatZh(r,a,b) r=(I_)((a)==(b)) -#define neFloatZh(r,a,b) r=(I_)((a)!=(b)) -#define ltFloatZh(r,a,b) r=(I_)((a)< (b)) -#define leFloatZh(r,a,b) r=(I_)((a)<=(b)) +#define zgzh(r,a,b) r=(I_)((I_)(a) >(I_)(b)) +#define zgzezh(r,a,b) r=(I_)((I_)(a)>=(I_)(b)) +#define zezezh(r,a,b) r=(I_)((I_)(a)==(I_)(b)) +#define zszezh(r,a,b) r=(I_)((I_)(a)!=(I_)(b)) +#define zlzh(r,a,b) r=(I_)((I_)(a) <(I_)(b)) +#define zlzezh(r,a,b) r=(I_)((I_)(a)<=(I_)(b)) + +#define gtWordzh(r,a,b) r=(I_)((W_)(a) >(W_)(b)) +#define geWordzh(r,a,b) r=(I_)((W_)(a)>=(W_)(b)) +#define eqWordzh(r,a,b) r=(I_)((W_)(a)==(W_)(b)) +#define neWordzh(r,a,b) r=(I_)((W_)(a)!=(W_)(b)) +#define ltWordzh(r,a,b) r=(I_)((W_)(a) <(W_)(b)) +#define leWordzh(r,a,b) r=(I_)((W_)(a)<=(W_)(b)) + +#define gtAddrzh(r,a,b) r=(I_)((a) >(b)) +#define geAddrzh(r,a,b) r=(I_)((a)>=(b)) +#define eqAddrzh(r,a,b) r=(I_)((a)==(b)) +#define neAddrzh(r,a,b) r=(I_)((a)!=(b)) +#define ltAddrzh(r,a,b) r=(I_)((a) <(b)) +#define leAddrzh(r,a,b) r=(I_)((a)<=(b)) + +#define gtFloatzh(r,a,b) r=(I_)((a)> (b)) +#define geFloatzh(r,a,b) r=(I_)((a)>=(b)) +#define eqFloatzh(r,a,b) r=(I_)((a)==(b)) +#define neFloatzh(r,a,b) r=(I_)((a)!=(b)) +#define ltFloatzh(r,a,b) r=(I_)((a)< (b)) +#define leFloatzh(r,a,b) r=(I_)((a)<=(b)) /* Double comparisons: >##, >=#@ etc */ -#define ZgZhZh(r,a,b) r=(I_)((a) >(b)) -#define ZgZeZhZh(r,a,b) r=(I_)((a)>=(b)) -#define ZeZeZhZh(r,a,b) r=(I_)((a)==(b)) -#define ZdZeZhZh(r,a,b) r=(I_)((a)!=(b)) -#define ZlZhZh(r,a,b) r=(I_)((a) <(b)) -#define ZlZeZhZh(r,a,b) r=(I_)((a)<=(b)) +#define zgzhzh(r,a,b) r=(I_)((a) >(b)) +#define zgzezhzh(r,a,b) r=(I_)((a)>=(b)) +#define zezezhzh(r,a,b) r=(I_)((a)==(b)) +#define zszezhzh(r,a,b) r=(I_)((a)!=(b)) +#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[]; +extern DLL_IMPORT_RTS const StgClosure *PrelBase_Bool_closure_tbl[]; /* ----------------------------------------------------------------------------- Char# PrimOps. -------------------------------------------------------------------------- */ -#define ordZh(r,a) r=(I_)((W_) (a)) -#define chrZh(r,a) r=(StgChar)((W_)(a)) +#define ordzh(r,a) r=(I_)((W_) (a)) +#define chrzh(r,a) r=(StgChar)((W_)(a)) /* ----------------------------------------------------------------------------- Int# PrimOps. @@ -72,23 +74,72 @@ extern const StgClosure *PrelBase_Bool_closure_tbl[]; I_ stg_div (I_ a, I_ b); -#define ZpZh(r,a,b) r=(a)+(b) -#define ZmZh(r,a,b) r=(a)-(b) -#define ZtZh(r,a,b) r=(a)*(b) -#define quotIntZh(r,a,b) r=(a)/(b) -#define ZdZh(r,a,b) r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b)) -#define remIntZh(r,a,b) r=(a)%(b) -#define negateIntZh(r,a) r=-(a) +#define zpzh(r,a,b) r=(a)+(b) +#define zmzh(r,a,b) r=(a)-(b) +#define ztzh(r,a,b) r=(a)*(b) +#define quotIntzh(r,a,b) r=(a)/(b) +#define zszh(r,a,b) r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b)) +#define remIntzh(r,a,b) r=(a)%(b) +#define negateIntzh(r,a) r=-(a) + +/* ----------------------------------------------------------------------------- + * 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. + * + * 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); \ +} + -/* The following operations are the standard add,subtract and multiply - * except that they return a carry if the operation overflows. +#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. * - * 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. + * 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 #define R 1 @@ -102,142 +153,152 @@ 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 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. -------------------------------------------------------------------------- */ -#define quotWordZh(r,a,b) r=((W_)a)/((W_)b) -#define remWordZh(r,a,b) r=((W_)a)%((W_)b) +#define quotWordzh(r,a,b) r=((W_)a)/((W_)b) +#define remWordzh(r,a,b) r=((W_)a)%((W_)b) -#define andZh(r,a,b) r=(a)&(b) -#define orZh(r,a,b) r=(a)|(b) -#define xorZh(r,a,b) r=(a)^(b) -#define notZh(r,a) r=~(a) +#define andzh(r,a,b) r=(a)&(b) +#define orzh(r,a,b) r=(a)|(b) +#define xorzh(r,a,b) r=(a)^(b) +#define notzh(r,a) r=~(a) -#define shiftLZh(r,a,b) r=(a)<<(b) -#define shiftRLZh(r,a,b) r=(a)>>(b) -#define iShiftLZh(r,a,b) r=(a)<<(b) +#define shiftLzh(r,a,b) r=(a)<<(b) +#define shiftRLzh(r,a,b) r=(a)>>(b) +#define iShiftLzh(r,a,b) r=(a)<<(b) /* Right shifting of signed quantities is not portable in C, so the behaviour you'll get from using these primops depends on the whatever your C compiler is doing. ToDo: fix/document. -- sof 8/98 */ -#define iShiftRAZh(r,a,b) r=(a)>>(b) -#define iShiftRLZh(r,a,b) r=(a)>>(b) +#define iShiftRAzh(r,a,b) r=(a)>>(b) +#define iShiftRLzh(r,a,b) r=(a)>>(b) -#define int2WordZh(r,a) r=(W_)(a) -#define word2IntZh(r,a) r=(I_)(a) +#define int2Wordzh(r,a) r=(W_)(a) +#define word2Intzh(r,a) r=(I_)(a) /* ----------------------------------------------------------------------------- Addr PrimOps. -------------------------------------------------------------------------- */ -#define int2AddrZh(r,a) r=(A_)(a) -#define addr2IntZh(r,a) r=(I_)(a) +#define int2Addrzh(r,a) r=(A_)(a) +#define addr2Intzh(r,a) r=(I_)(a) -#define indexCharOffAddrZh(r,a,i) r= ((C_ *)(a))[i] -#define indexIntOffAddrZh(r,a,i) r= ((I_ *)(a))[i] -#define indexAddrOffAddrZh(r,a,i) r= ((PP_)(a))[i] -#define indexFloatOffAddrZh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) -#define indexDoubleOffAddrZh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) -#define indexStablePtrOffAddrZh(r,a,i) r= ((StgStablePtr *)(a))[i] +#define indexCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] +#define indexIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] +#define indexAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] +#define indexFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) +#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) +#define indexStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i] #ifdef SUPPORT_LONG_LONGS -#define indexInt64OffAddrZh(r,a,i) r= ((LI_ *)(a))[i] -#define indexWord64OffAddrZh(r,a,i) r= ((LW_ *)(a))[i] +#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] +#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] #endif -#define writeCharOffAddrZh(a,i,v) ((C_ *)(a))[i] = (v) -#define writeIntOffAddrZh(a,i,v) ((I_ *)(a))[i] = (v) -#define writeWordOffAddrZh(a,i,v) ((W_ *)(a))[i] = (v) -#define writeAddrOffAddrZh(a,i,v) ((PP_)(a))[i] = (v) -#define writeForeignObjOffAddrZh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v) -#define writeFloatOffAddrZh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v) -#define writeDoubleOffAddrZh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v) -#define writeStablePtrOffAddrZh(a,i,v) ((StgStablePtr *)(a))[i] = (v) +#define writeCharOffAddrzh(a,i,v) ((C_ *)(a))[i] = (v) +#define writeIntOffAddrzh(a,i,v) ((I_ *)(a))[i] = (v) +#define writeWordOffAddrzh(a,i,v) ((W_ *)(a))[i] = (v) +#define writeAddrOffAddrzh(a,i,v) ((PP_)(a))[i] = (v) +#define writeForeignObjOffAddrzh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v) +#define writeFloatOffAddrzh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v) +#define writeDoubleOffAddrzh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v) +#define writeStablePtrOffAddrzh(a,i,v) ((StgStablePtr *)(a))[i] = (v) #ifdef SUPPORT_LONG_LONGS -#define writeInt64OffAddrZh(a,i,v) ((LI_ *)(a))[i] = (v) -#define writeWord64OffAddrZh(a,i,v) ((LW_ *)(a))[i] = (v) +#define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v) +#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v) #endif /* ----------------------------------------------------------------------------- Float PrimOps. -------------------------------------------------------------------------- */ -#define plusFloatZh(r,a,b) r=(a)+(b) -#define minusFloatZh(r,a,b) r=(a)-(b) -#define timesFloatZh(r,a,b) r=(a)*(b) -#define divideFloatZh(r,a,b) r=(a)/(b) -#define negateFloatZh(r,a) r=-(a) +#define plusFloatzh(r,a,b) r=(a)+(b) +#define minusFloatzh(r,a,b) r=(a)-(b) +#define timesFloatzh(r,a,b) r=(a)*(b) +#define divideFloatzh(r,a,b) r=(a)/(b) +#define negateFloatzh(r,a) r=-(a) -#define int2FloatZh(r,a) r=(StgFloat)(a) -#define float2IntZh(r,a) r=(I_)(a) +#define int2Floatzh(r,a) r=(StgFloat)(a) +#define float2Intzh(r,a) r=(I_)(a) -#define expFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,exp,a) -#define logFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,a) -#define sqrtFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,a) -#define sinFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,a) -#define cosFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,a) -#define tanFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,a) -#define asinFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,a) -#define acosFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,a) -#define atanFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,a) -#define sinhFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,a) -#define coshFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,a) -#define tanhFloatZh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,a) -#define powerFloatZh(r,a,b) r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,a,b) +#define expFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,exp,a) +#define logFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,a) +#define sqrtFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,a) +#define sinFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,a) +#define cosFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,a) +#define tanFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,a) +#define asinFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,a) +#define acosFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,a) +#define atanFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,a) +#define sinhFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,a) +#define coshFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,a) +#define tanhFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,a) +#define powerFloatzh(r,a,b) r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,a,b) /* ----------------------------------------------------------------------------- Double PrimOps. -------------------------------------------------------------------------- */ -#define ZpZhZh(r,a,b) r=(a)+(b) -#define ZmZhZh(r,a,b) r=(a)-(b) -#define ZtZhZh(r,a,b) r=(a)*(b) -#define ZdZhZh(r,a,b) r=(a)/(b) -#define negateDoubleZh(r,a) r=-(a) +#define zpzhzh(r,a,b) r=(a)+(b) +#define zmzhzh(r,a,b) r=(a)-(b) +#define ztzhzh(r,a,b) r=(a)*(b) +#define zszhzh(r,a,b) r=(a)/(b) +#define negateDoublezh(r,a) r=-(a) -#define int2DoubleZh(r,a) r=(StgDouble)(a) -#define double2IntZh(r,a) r=(I_)(a) +#define int2Doublezh(r,a) r=(StgDouble)(a) +#define double2Intzh(r,a) r=(I_)(a) -#define float2DoubleZh(r,a) r=(StgDouble)(a) -#define double2FloatZh(r,a) r=(StgFloat)(a) +#define float2Doublezh(r,a) r=(StgDouble)(a) +#define double2Floatzh(r,a) r=(StgFloat)(a) -#define expDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,exp,a) -#define logDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,a) -#define sqrtDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,a) -#define sinDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,a) -#define cosDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,a) -#define tanDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,a) -#define asinDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,a) -#define acosDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,a) -#define atanDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,a) -#define sinhDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,a) -#define coshDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,a) -#define tanhDoubleZh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,a) +#define expDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,exp,a) +#define logDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,a) +#define sqrtDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,a) +#define sinDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,a) +#define cosDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,a) +#define tanDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,a) +#define asinDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,a) +#define acosDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,a) +#define atanDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,a) +#define sinhDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,a) +#define coshDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,a) +#define tanhDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,a) /* Power: **## */ -#define ZtZtZhZh(r,a,b) r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b) +#define ztztzhzh(r,a,b) r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b) /* ----------------------------------------------------------------------------- Integer PrimOps. @@ -247,73 +308,68 @@ 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: -------- */ /* Integer arithmetic */ -EF_(plusIntegerZh_fast); -EF_(minusIntegerZh_fast); -EF_(timesIntegerZh_fast); -EF_(gcdIntegerZh_fast); -EF_(quotRemIntegerZh_fast); -EF_(divModIntegerZh_fast); +EF_(plusIntegerzh_fast); +EF_(minusIntegerzh_fast); +EF_(timesIntegerzh_fast); +EF_(gcdIntegerzh_fast); +EF_(quotRemIntegerzh_fast); +EF_(divModIntegerzh_fast); /* Conversions */ -EF_(int2IntegerZh_fast); -EF_(word2IntegerZh_fast); -EF_(addr2IntegerZh_fast); - -/* Floating-point encodings/decodings */ -EF_(encodeFloatZh_fast); -EF_(decodeFloatZh_fast); +EF_(int2Integerzh_fast); +EF_(word2Integerzh_fast); +EF_(addr2Integerzh_fast); -EF_(encodeDoubleZh_fast); -EF_(decodeDoubleZh_fast); +/* Floating-point decodings */ +EF_(decodeFloatzh_fast); +EF_(decodeDoublezh_fast); /* ----------------------------------------------------------------------------- Word64 PrimOps. @@ -321,48 +377,55 @@ 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; \ - } \ - (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 */ -EF_(int64ToIntegerZh_fast); -EF_(word64ToIntegerZh_fast); +EF_(int64ToIntegerzh_fast); +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); @@ -371,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); @@ -381,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); @@ -397,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 /* ----------------------------------------------------------------------------- @@ -413,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) \ @@ -430,75 +492,75 @@ extern I_ resetGenSymZh(void); /*--- everything except new*Array is done inline: */ -#define sameMutableArrayZh(r,a,b) r=(I_)((a)==(b)) -#define sameMutableByteArrayZh(r,a,b) r=(I_)((a)==(b)) +#define sameMutableArrayzh(r,a,b) r=(I_)((a)==(b)) +#define sameMutableByteArrayzh(r,a,b) r=(I_)((a)==(b)) -#define readArrayZh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] +#define readArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] -#define readCharArrayZh(r,a,i) indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readIntArrayZh(r,a,i) indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readWordArrayZh(r,a,i) indexWordOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readAddrArrayZh(r,a,i) indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readFloatArrayZh(r,a,i) indexFloatOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readDoubleArrayZh(r,a,i) indexDoubleOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readStablePtrArrayZh(r,a,i) indexStablePtrOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i) #ifdef SUPPORT_LONG_LONGS -#define readInt64ArrayZh(r,a,i) indexInt64OffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readWord64ArrayZh(r,a,i) indexWord64OffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) #endif /* result ("r") arg ignored in write macros! */ -#define writeArrayZh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v) +#define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v) -#define writeCharArrayZh(a,i,v) ((C_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeIntArrayZh(a,i,v) ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeWordArrayZh(a,i,v) ((W_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeAddrArrayZh(a,i,v) ((PP_)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeFloatArrayZh(a,i,v) \ +#define writeCharArrayzh(a,i,v) ((C_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeIntArrayzh(a,i,v) ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeWordArrayzh(a,i,v) ((W_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeAddrArrayzh(a,i,v) ((PP_)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeFloatArrayzh(a,i,v) \ ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v) -#define writeDoubleArrayZh(a,i,v) \ +#define writeDoubleArrayzh(a,i,v) \ ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v) -#define writeStablePtrArrayZh(a,i,v) ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeStablePtrArrayzh(a,i,v) ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v) #ifdef SUPPORT_LONG_LONGS -#define writeInt64ArrayZh(a,i,v) ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeWord64ArrayZh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeInt64Arrayzh(a,i,v) ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeWord64Arrayzh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v) #endif -#define indexArrayZh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] +#define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] -#define indexCharArrayZh(r,a,i) indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexIntArrayZh(r,a,i) indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexWordArrayZh(r,a,i) indexWordOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexAddrArrayZh(r,a,i) indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexFloatArrayZh(r,a,i) indexFloatOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexDoubleArrayZh(r,a,i) indexDoubleOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexStablePtrArrayZh(r,a,i) indexStablePtrOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i) #ifdef SUPPORT_LONG_LONGS -#define indexInt64ArrayZh(r,a,i) indexInt64OffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexWord64ArrayZh(r,a,i) indexWord64OffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i) +#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) #endif -#define indexCharOffForeignObjZh(r,fo,i) indexCharOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexIntOffForeignObjZh(r,fo,i) indexIntOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexWordOffForeignObjZh(r,fo,i) indexWordOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexAddrOffForeignObjZh(r,fo,i) indexAddrOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexFloatOffForeignObjZh(r,fo,i) indexFloatOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexDoubleOffForeignObjZh(r,fo,i) indexDoubleOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexStablePtrOffForeignObjZh(r,fo,i) indexStablePtrOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWordOffForeignObjzh(r,fo,i) indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexAddrOffForeignObjzh(r,fo,i) indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexFloatOffForeignObjzh(r,fo,i) indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexStablePtrOffForeignObjzh(r,fo,i) indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) #ifdef SUPPORT_LONG_LONGS -#define indexInt64OffForeignObjZh(r,fo,i) indexInt64OffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexWord64OffForeignObjZh(r,fo,i) indexWord64OffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) #endif -#define indexCharOffAddrZh(r,a,i) r= ((C_ *)(a))[i] -#define indexIntOffAddrZh(r,a,i) r= ((I_ *)(a))[i] -#define indexWordOffAddrZh(r,a,i) r= ((W_ *)(a))[i] -#define indexAddrOffAddrZh(r,a,i) r= ((PP_)(a))[i] -#define indexFloatOffAddrZh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) -#define indexDoubleOffAddrZh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) +#define indexCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] +#define indexIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] +#define indexWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i] +#define indexAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] +#define indexFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) +#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) #ifdef SUPPORT_LONG_LONGS -#define indexInt64OffAddrZh(r,a,i) r= ((LI_ *)(a))[i] -#define indexWord64OffAddrZh(r,a,i) r= ((LW_ *)(a))[i] +#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] +#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] #endif /* Freezing arrays-of-ptrs requires changing an info table, for the @@ -506,77 +568,57 @@ extern I_ resetGenSymZh(void); objects, even if they are in old space. When they become immutable, they can be removed from this scavenge list. */ -#define unsafeFreezeArrayZh(r,a) \ +#define unsafeFreezzeArrayzh(r,a) \ { \ SET_INFO((StgClosure *)a,&MUT_ARR_PTRS_FROZEN_info); \ r = a; \ } -#define unsafeFreezeByteArrayZh(r,a) r=(a) +#define unsafeFreezzeByteArrayzh(r,a) r=(a) +#define unsafeThawByteArrayzh(r,a) r=(a) + +EF_(unsafeThawArrayzh_fast); -#define sizeofByteArrayZh(r,a) \ +#define sizzeofByteArrayzh(r,a) \ r = (((StgArrWords *)(a))->words * sizeof(W_)) -#define sizeofMutableByteArrayZh(r,a) \ +#define sizzeofMutableByteArrayzh(r,a) \ r = (((StgArrWords *)(a))->words * sizeof(W_)) /* and the out-of-line ones... */ -EF_(newCharArrayZh_fast); -EF_(newIntArrayZh_fast); -EF_(newWordArrayZh_fast); -EF_(newAddrArrayZh_fast); -EF_(newFloatArrayZh_fast); -EF_(newDoubleArrayZh_fast); -EF_(newStablePtrArrayZh_fast); -EF_(newArrayZh_fast); +EF_(newCharArrayzh_fast); +EF_(newIntArrayzh_fast); +EF_(newWordArrayzh_fast); +EF_(newAddrArrayzh_fast); +EF_(newFloatArrayzh_fast); +EF_(newDoubleArrayzh_fast); +EF_(newStablePtrArrayzh_fast); +EF_(newArrayzh_fast); /* encoding and decoding of floats/doubles. */ /* 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 +#define decodeFloatzh_fast decodeDoublezh_fast #else -EF_(decodeFloatZh_fast); +EF_(decodeFloatzh_fast); #endif -EF_(decodeDoubleZh_fast); +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); @@ -594,25 +636,25 @@ extern StgInt isFloatNegativeZero(StgFloat f); newMutVar is out of line. -------------------------------------------------------------------------- */ -EF_(newMutVarZh_fast); +EF_(newMutVarzh_fast); -#define readMutVarZh(r,a) r=(P_)(((StgMutVar *)(a))->var) -#define writeMutVarZh(a,v) (P_)(((StgMutVar *)(a))->var)=(v) -#define sameMutVarZh(r,a,b) r=(I_)((a)==(b)) +#define readMutVarzh(r,a) r=(P_)(((StgMutVar *)(a))->var) +#define writeMutVarzh(a,v) (P_)(((StgMutVar *)(a))->var)=(v) +#define sameMutVarzh(r,a,b) r=(I_)((a)==(b)) /* ----------------------------------------------------------------------------- MVar PrimOps. All out of line, because they either allocate or may block. -------------------------------------------------------------------------- */ - -#define sameMVarZh(r,a,b) r=(I_)((a)==(b)) +#define sameMVarzh(r,a,b) r=(I_)((a)==(b)) /* Assume external decl of EMPTY_MVAR_info is in scope by now */ -#define isEmptyMVarZh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info ) -EF_(newMVarZh_fast); -EF_(takeMVarZh_fast); -EF_(putMVarZh_fast); +#define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info ) +EF_(newMVarzh_fast); +EF_(takeMVarzh_fast); +EF_(putMVarzh_fast); + /* ----------------------------------------------------------------------------- Delay/Wait PrimOps @@ -624,68 +666,47 @@ EF_(putMVarZh_fast); Primitive I/O, error-handling PrimOps -------------------------------------------------------------------------- */ -EF_(catchZh_fast); -EF_(raiseZh_fast); +EF_(catchzh_fast); +EF_(raisezh_fast); extern void stg_exit(I_ n) __attribute__ ((noreturn)); /* ----------------------------------------------------------------------------- - Stable Pointer PrimOps. + Stable Name / Stable Pointer PrimOps -------------------------------------------------------------------------- */ #ifndef PAR -extern StgPtr *stable_ptr_table; -extern StgPtr *stable_ptr_free; -#define deRefStablePtrZh(r,sp) (r=stable_ptr_table[(sp)]) -#define eqStablePtrZh(r,sp1,sp2) (r=(sp1==sp2)) - -#define freeStablePointer(stable_ptr) \ - { \ - stable_ptr_table[stable_ptr] = (P_)stable_ptr_free; \ - stable_ptr_free = &stable_ptr_table[stable_ptr]; \ - } - -EF_(makeStablePtrZh_fast); - -#else /* PAR */ -#define deRefStablePtrZh(ri,sp) \ -do { \ - fflush(stdout); \ - fprintf(stderr, "deRefStablePtr#: no stable pointer support.\n");\ - stg_exit(EXIT_FAILURE); \ -} while(0) - -#define eqStablePtrZh(ri,sp1,sp2) \ -do { \ - fflush(stdout); \ - fprintf(stderr, "eqStablePtr#: no stable pointer support.\n"); \ - stg_exit(EXIT_FAILURE); \ -} while(0) - -#define makeStablePtrZh(stablePtr,liveness,unstablePtr) \ -do { \ - fflush(stdout); \ - fprintf(stderr, "makeStablePtr#: no stable pointer support.\n");\ - EXIT(EXIT_FAILURE); \ -} while(0) - -#define freeStablePtrZh(stablePtr,liveness,unstablePtr) \ -do { \ - fflush(stdout); \ - fprintf(stderr, "makeStablePtr#: no stable pointer support.\n");\ - EXIT(EXIT_FAILURE); \ -} while(0) -#endif +EF_(makeStableNamezh_fast); + +#define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn) + +#define eqStableNamezh(r,sn1,sn2) \ + (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn)) + +#define makeStablePtrzh(r,a) \ + r = RET_STGCALL1(StgStablePtr,getStablePtr,a) + +#define deRefStablePtrzh(r,sp) do { \ + ASSERT(stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].weight > 0); \ + r = stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].addr; \ +} while (0); +#define eqStablePtrzh(r,sp1,sp2) \ + (r = ((sp1 & ~STABLEPTR_WEIGHT_MASK) == (sp2 & ~STABLEPTR_WEIGHT_MASK))) + +#endif /* ----------------------------------------------------------------------------- Parallel PrimOps. -------------------------------------------------------------------------- */ -EF_(forkZh_fast); -EF_(killThreadZh_fast); -EF_(seqZh_fast); +EF_(forkzh_fast); +EF_(yieldzh_fast); +EF_(killThreadzh_fast); +EF_(seqzh_fast); + +#define myThreadIdzh(t) (t = CurrentTSO) /* Hmm, I'll think about these later. */ /* ----------------------------------------------------------------------------- @@ -698,7 +719,7 @@ EF_(seqZh_fast); ToDo: follow indirections. */ -#define reallyUnsafePtrEqualityZh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b)) +#define reallyUnsafePtrEqualityzh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b)) /* ----------------------------------------------------------------------------- Weak Pointer PrimOps. @@ -706,9 +727,19 @@ EF_(seqZh_fast); #ifndef PAR -EF_(mkWeakZh_fast); -EF_(deRefWeakZh_fast); -#define sameWeakZh(w1,w2) ((w1)==(w2)) +EF_(mkWeakzh_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 @@ -720,9 +751,9 @@ EF_(deRefWeakZh_fast); #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) -EF_(makeForeignObjZh_fast); +EF_(makeForeignObjzh_fast); -#define writeForeignObjZh(res,datum) \ +#define writeForeignObjzh(res,datum) \ (ForeignObj_CLOSURE_DATA(res) = (P_)(datum)) #define eqForeignObj(f1,f2) ((f1)==(f2))