### [project @ 2001-09-24 00:22:59 by ken]

```Fix a bug with arithmetic primops on platforms where StgInt is not int,
such as the 64-bit Alpha.  The bug is that, for example,

1# `iShiftL#` 32#

returns zero rather than 2^32.  The reason is that we should cast the
macro arguments to I_ in the definition of iShiftL#, but did not.

MERGE TO STABLE```
parent a5840900
 /* ----------------------------------------------------------------------------- * \$Id: PrimOps.h,v 1.82 2001/08/18 11:55:48 qrczak Exp \$ * \$Id: PrimOps.h,v 1.83 2001/09/24 00:22:59 ken Exp \$ * * (c) The GHC Team, 1998-2000 * ... ... @@ -27,49 +27,49 @@ Comparison PrimOps. -------------------------------------------------------------------------- */ #define gtCharzh(r,a,b) r=(a)> (b) #define geCharzh(r,a,b) r=(a)>=(b) #define eqCharzh(r,a,b) r=(a)==(b) #define neCharzh(r,a,b) r=(a)!=(b) #define ltCharzh(r,a,b) r=(a)< (b) #define leCharzh(r,a,b) r=(a)<=(b) #define gtCharzh(r,a,b) r=((C_)(a))> ((C_)(b)) #define geCharzh(r,a,b) r=((C_)(a))>=((C_)(b)) #define eqCharzh(r,a,b) r=((C_)(a))==((C_)(b)) #define neCharzh(r,a,b) r=((C_)(a))!=((C_)(b)) #define ltCharzh(r,a,b) r=((C_)(a))< ((C_)(b)) #define leCharzh(r,a,b) r=((C_)(a))<=((C_)(b)) /* Int comparisons: >#, >=# etc */ #define zgzh(r,a,b) r=(a)> (b) #define zgzezh(r,a,b) r=(a)>=(b) #define zezezh(r,a,b) r=(a)==(b) #define zszezh(r,a,b) r=(a)!=(b) #define zlzh(r,a,b) r=(a)< (b) #define zlzezh(r,a,b) r=(a)<=(b) #define gtWordzh(r,a,b) r=(a)> (b) #define geWordzh(r,a,b) r=(a)>=(b) #define eqWordzh(r,a,b) r=(a)==(b) #define neWordzh(r,a,b) r=(a)!=(b) #define ltWordzh(r,a,b) r=(a)< (b) #define leWordzh(r,a,b) r=(a)<=(b) #define gtAddrzh(r,a,b) r=(a)> (b) #define geAddrzh(r,a,b) r=(a)>=(b) #define eqAddrzh(r,a,b) r=(a)==(b) #define neAddrzh(r,a,b) r=(a)!=(b) #define ltAddrzh(r,a,b) r=(a)< (b) #define leAddrzh(r,a,b) r=(a)<=(b) #define gtFloatzh(r,a,b) r=(a)> (b) #define geFloatzh(r,a,b) r=(a)>=(b) #define eqFloatzh(r,a,b) r=(a)==(b) #define neFloatzh(r,a,b) r=(a)!=(b) #define ltFloatzh(r,a,b) r=(a)< (b) #define leFloatzh(r,a,b) r=(a)<=(b) #define zgzh(r,a,b) r=((I_)(a))> ((I_)(b)) #define zgzezh(r,a,b) r=((I_)(a))>=((I_)(b)) #define zezezh(r,a,b) r=((I_)(a))==((I_)(b)) #define zszezh(r,a,b) r=((I_)(a))!=((I_)(b)) #define zlzh(r,a,b) r=((I_)(a))< ((I_)(b)) #define zlzezh(r,a,b) r=((I_)(a))<=((I_)(b)) #define gtWordzh(r,a,b) r=((W_)(a))> ((W_)(b)) #define geWordzh(r,a,b) r=((W_)(a))>=((W_)(b)) #define eqWordzh(r,a,b) r=((W_)(a))==((W_)(b)) #define neWordzh(r,a,b) r=((W_)(a))!=((W_)(b)) #define ltWordzh(r,a,b) r=((W_)(a))< ((W_)(b)) #define leWordzh(r,a,b) r=((W_)(a))<=((W_)(b)) #define gtAddrzh(r,a,b) r=((A_)(a))> ((A_)(b)) #define geAddrzh(r,a,b) r=((A_)(a))>=((A_)(b)) #define eqAddrzh(r,a,b) r=((A_)(a))==((A_)(b)) #define neAddrzh(r,a,b) r=((A_)(a))!=((A_)(b)) #define ltAddrzh(r,a,b) r=((A_)(a))< ((A_)(b)) #define leAddrzh(r,a,b) r=((A_)(a))<=((A_)(b)) #define gtFloatzh(r,a,b) r=((StgFloat)(a))> ((StgFloat)(b)) #define geFloatzh(r,a,b) r=((StgFloat)(a))>=((StgFloat)(b)) #define eqFloatzh(r,a,b) r=((StgFloat)(a))==((StgFloat)(b)) #define neFloatzh(r,a,b) r=((StgFloat)(a))!=((StgFloat)(b)) #define ltFloatzh(r,a,b) r=((StgFloat)(a))< ((StgFloat)(b)) #define leFloatzh(r,a,b) r=((StgFloat)(a))<=((StgFloat)(b)) /* Double comparisons: >##, >=## etc */ #define zgzhzh(r,a,b) r=(a)> (b) #define zgzezhzh(r,a,b) r=(a)>=(b) #define zezezhzh(r,a,b) r=(a)==(b) #define zszezhzh(r,a,b) r=(a)!=(b) #define zlzhzh(r,a,b) r=(a)< (b) #define zlzezhzh(r,a,b) r=(a)<=(b) #define zgzhzh(r,a,b) r=((StgDouble)(a))> ((StgDouble)(b)) #define zgzezhzh(r,a,b) r=((StgDouble)(a))>=((StgDouble)(b)) #define zezezhzh(r,a,b) r=((StgDouble)(a))==((StgDouble)(b)) #define zszezhzh(r,a,b) r=((StgDouble)(a))!=((StgDouble)(b)) #define zlzhzh(r,a,b) r=((StgDouble)(a))< ((StgDouble)(b)) #define zlzezhzh(r,a,b) r=((StgDouble)(a))<=((StgDouble)(b)) /* ----------------------------------------------------------------------------- Char# PrimOps. ... ... @@ -82,12 +82,12 @@ Int# PrimOps. -------------------------------------------------------------------------- */ #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 remIntzh(r,a,b) r=(a)%(b) #define negateIntzh(r,a) r=-(a) #define zpzh(r,a,b) r=((I_)(a))+((I_)(b)) #define zmzh(r,a,b) r=((I_)(a))-((I_)(b)) #define ztzh(r,a,b) r=((I_)(a))*((I_)(b)) #define quotIntzh(r,a,b) r=((I_)(a))/((I_)(b)) #define remIntzh(r,a,b) r=((I_)(a))%((I_)(b)) #define negateIntzh(r,a) r=-((I_)(a)) /* ----------------------------------------------------------------------------- * Int operations with carry. ... ... @@ -104,17 +104,17 @@ * could be improved by making r and c the correct values for * plugging into a new J#. */ #define addIntCzh(r,c,a,b) \ { r = (I_)a + (I_)b; \ c = ((StgWord)(~((I_)a^(I_)b) & ((I_)a^r))) \ >> (BITS_IN (I_) - 1); \ #define addIntCzh(r,c,a,b) \ { r = ((I_)(a)) + ((I_)(b)); \ c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ >> (BITS_IN (I_) - 1); \ } #define subIntCzh(r,c,a,b) \ { r = a - b; \ c = ((StgWord)((a^b) & (a^r))) \ >> (BITS_IN (I_) - 1); \ #define subIntCzh(r,c,a,b) \ { r = ((I_)(a)) - ((I_)(b)); \ c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ >> (BITS_IN (I_) - 1); \ } /* Multiply with overflow checking. ... ... @@ -177,9 +177,9 @@ typedef union { #else #define HALF_INT (1LL << (BITS_IN (I_) / 2)) #define HALF_INT (((I_)1) << (BITS_IN (I_) / 2)) #define stg_abs(a) ((a) < 0 ? -(a) : (a)) #define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a))) #define mulIntCzh(r,c,a,b) \ { \ ... ... @@ -187,7 +187,7 @@ typedef union { stg_abs(b) >= HALF_INT) { \ c = 1; \ } else { \ r = a * b; \ r = ((I_)(a)) * ((I_)(b)); \ c = 0; \ } \ } ... ... @@ -197,16 +197,16 @@ typedef union { Word# PrimOps. -------------------------------------------------------------------------- */ #define plusWordzh(r,a,b) r=(a)+(b) #define minusWordzh(r,a,b) r=(a)-(b) #define timesWordzh(r,a,b) r=(a)*(b) #define quotWordzh(r,a,b) r=(a)/(b) #define remWordzh(r,a,b) r=(a)%(b) #define plusWordzh(r,a,b) r=((W_)(a))+((W_)(b)) #define minusWordzh(r,a,b) r=((W_)(a))-((W_)(b)) #define timesWordzh(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=((W_)(a))&((W_)(b)) #define orzh(r,a,b) r=((W_)(a))|((W_)(b)) #define xorzh(r,a,b) r=((W_)(a))^((W_)(b)) #define notzh(r,a) r=~((W_)(a)) /* The extra tests below properly define the behaviour when shifting * by offsets larger than the width of the value being shifted. Doing ... ... @@ -214,29 +214,29 @@ typedef union { * on whether the operation is constant folded or not with gcc on x86!) */ #define shiftLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b) #define shiftRLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)>>(b) #define iShiftLzh(r,a,b) r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b) #define shiftLzh(r,a,b) r=(((I_)(b)) >= BITS_IN(W_)) ? 0 : ((W_)(a))<<((I_)(b)) #define shiftRLzh(r,a,b) r=(((I_)(b)) >= BITS_IN(W_)) ? 0 : ((W_)(a))>>((I_)(b)) #define iShiftLzh(r,a,b) r=(((I_)(b)) >= BITS_IN(W_)) ? 0 : ((W_)(a))<<((I_)(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=((b) >= BITS_IN(I_)) ? (((a) < 0) ? -1 : 0) : (a)>>(b) #define iShiftRLzh(r,a,b) r=((b) >= BITS_IN(I_)) ? 0 : (I_)((W_)(a)>>(b)) #define iShiftRAzh(r,a,b) r=(((I_)(b)) >= BITS_IN(I_)) ? ((((I_)(a)) < 0) ? -1 : 0) : ((I_)(a))>>((I_)(b)) #define iShiftRLzh(r,a,b) r=(((I_)(b)) >= BITS_IN(I_)) ? 0 : (I_)((W_)((I_)(a))>>((I_)(b))) #define int2Wordzh(r,a) r=(W_)(a) #define word2Intzh(r,a) r=(I_)(a) #define int2Wordzh(r,a) r=(W_)((I_)(a)) #define word2Intzh(r,a) r=(I_)((W_)(a)) /* ----------------------------------------------------------------------------- Explicitly sized Int# and Word# PrimOps. -------------------------------------------------------------------------- */ #define narrow8Intzh(r,a) r=(StgInt8)(a) #define narrow16Intzh(r,a) r=(StgInt16)(a) #define narrow32Intzh(r,a) r=(StgInt32)(a) #define narrow8Wordzh(r,a) r=(StgWord8)(a) #define narrow16Wordzh(r,a) r=(StgWord16)(a) #define narrow32Wordzh(r,a) r=(StgWord32)(a) #define narrow8Intzh(r,a) r=(StgInt8)((I_)(a)) #define narrow16Intzh(r,a) r=(StgInt16)((I_)(a)) #define narrow32Intzh(r,a) r=(StgInt32)((I_)(a)) #define narrow8Wordzh(r,a) r=(StgWord8)((W_)(a)) #define narrow16Wordzh(r,a) r=(StgWord16)((W_)(a)) #define narrow32Wordzh(r,a) r=(StgWord32)((W_)(a)) /* ----------------------------------------------------------------------------- Addr# PrimOps. ... ... @@ -320,59 +320,59 @@ typedef union { 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=((StgFloat)(a))+((StgFloat)(b)) #define minusFloatzh(r,a,b) r=((StgFloat)(a))-((StgFloat)(b)) #define timesFloatzh(r,a,b) r=((StgFloat)(a))*((StgFloat)(b)) #define divideFloatzh(r,a,b) r=((StgFloat)(a))/((StgFloat)(b)) #define negateFloatzh(r,a) r=-((StgFloat)(a)) #define int2Floatzh(r,a) r=(StgFloat)(a) #define float2Intzh(r,a) r=(I_)(a) #define int2Floatzh(r,a) r=(StgFloat)((I_)(a)) #define float2Intzh(r,a) r=(I_)((StgFloat)(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,((StgFloat)(a))) #define logFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,((StgFloat)(a))) #define sqrtFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,((StgFloat)(a))) #define sinFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,((StgFloat)(a))) #define cosFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,((StgFloat)(a))) #define tanFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,((StgFloat)(a))) #define asinFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,((StgFloat)(a))) #define acosFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,((StgFloat)(a))) #define atanFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,((StgFloat)(a))) #define sinhFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,((StgFloat)(a))) #define coshFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,((StgFloat)(a))) #define tanhFloatzh(r,a) r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,((StgFloat)(a))) #define powerFloatzh(r,a,b) r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,((StgFloat)(a)),((StgFloat)(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 zszhzh(r,a,b) r=(a)/(b) #define negateDoublezh(r,a) r=-(a) #define zpzhzh(r,a,b) r=((StgDouble)(a))+((StgDouble)(b)) #define zmzhzh(r,a,b) r=((StgDouble)(a))-((StgDouble)(b)) #define ztzhzh(r,a,b) r=((StgDouble)(a))*((StgDouble)(b)) #define zszhzh(r,a,b) r=((StgDouble)(a))/((StgDouble)(b)) #define negateDoublezh(r,a) r=-((StgDouble)(a)) #define int2Doublezh(r,a) r=(StgDouble)(a) #define double2Intzh(r,a) r=(I_)(a) #define int2Doublezh(r,a) r=(StgDouble)((I_)(a)) #define double2Intzh(r,a) r=(I_)((StgDouble)(a)) #define float2Doublezh(r,a) r=(StgDouble)(a) #define double2Floatzh(r,a) r=(StgFloat)(a) #define float2Doublezh(r,a) r=(StgDouble)((StgFloat)(a)) #define double2Floatzh(r,a) r=(StgFloat)((StgDouble)(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,((StgDouble)(a))) #define logDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,((StgDouble)(a))) #define sqrtDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,((StgDouble)(a))) #define sinDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,((StgDouble)(a))) #define cosDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,((StgDouble)(a))) #define tanDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,((StgDouble)(a))) #define asinDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,((StgDouble)(a))) #define acosDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,((StgDouble)(a))) #define atanDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,((StgDouble)(a))) #define sinhDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,((StgDouble)(a))) #define coshDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,((StgDouble)(a))) #define tanhDoublezh(r,a) r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,((StgDouble)(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,((StgDouble)(a)),((StgDouble)(b))) /* ----------------------------------------------------------------------------- Integer PrimOps. ... ...
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment