/* -----------------------------------------------------------------------------
- * $Id: StgPrimFloat.c,v 1.4 1999/02/18 12:26:12 simonm Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Miscellaneous support for floating-point primitives
*
* ---------------------------------------------------------------------------*/
+#include "PosixSource.h"
#include "Rts.h"
+#include <math.h>
+
/*
* Encoding and decoding Doubles. Code based on the HBC code
* (lib/fltcode.c).
*/
+#ifdef _SHORT_LIMB
+#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_INT
+#else
+#ifdef _LONG_LONG_LIMB
+#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_LONG_LONG
+#else
+#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_LONG
+#endif
+#endif
+
+#if SIZEOF_LIMB_T == 4
#define GMP_BASE 4294967296.0
-#if FLOATS_AS_DOUBLES /* defined in StgTypes.h */
-#define DNBIGIT 1 /* mantissa of a double will fit in one long */
+#elif SIZEOF_LIMB_T == 8
+#define GMP_BASE 18446744073709551616.0
#else
-#define DNBIGIT 2 /* mantissa of a double will fit in two longs */
+#error Cannot cope with SIZEOF_LIMB_T -- please add definition of GMP_BASE
#endif
-#define FNBIGIT 1 /* for float, one long */
+
+#define DNBIGIT ((SIZEOF_DOUBLE+SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T)
+#define FNBIGIT ((SIZEOF_FLOAT +SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T)
#if IEEE_FLOATING_POINT
#define MY_DMINEXP ((DBL_MIN_EXP) - (DBL_MANT_DIG) - 1)
__encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
{
StgDouble r;
- W_ *arr = (W_ *)ba;
+ const mp_limb_t *const arr = (const mp_limb_t *)ba;
I_ i;
/* Convert MP_INT to a double; knows a lot about internal rep! */
- i = __abs(size)-1;
- if (i < 0) {
- r = 0.0;
- } else {
- for (r = arr[i], i--; i >= 0; i--)
- r = r * GMP_BASE + arr[i];
- }
+ for(r = 0.0, i = __abs(size)-1; i >= 0; i--)
+ r = (r * GMP_BASE) + arr[i];
/* Now raise to the exponent */
if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
return r;
}
-#if ! FLOATS_AS_DOUBLES
StgFloat
__encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
{
StgFloat r;
- W_ *arr = (W_ *)ba;
+ const mp_limb_t *arr = (const mp_limb_t *)ba;
I_ i;
/* Convert MP_INT to a float; knows a lot about internal rep! */
- for(r = 0.0, i = __abs(size); i >= 0; i--)
+ for(r = 0.0, i = __abs(size)-1; i >= 0; i--)
r = (r * GMP_BASE) + arr[i];
/* Now raise to the exponent */
return r;
}
-#endif /* FLOATS_AS_DOUBLES */
-
/* This only supports IEEE floating point */
void
__decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl)
{
/* Do some bit fiddling on IEEE */
- nat low, high; /* assuming 32 bit ints */
+ unsigned int low, high; /* assuming 32 bit ints */
int sign, iexp;
- union { double d; int i[2]; } u; /* assuming 32 bit ints, 64 bit double */
+ union { double d; unsigned int i[2]; } u; /* assuming 32 bit ints, 64 bit double */
+
+ ASSERT(sizeof(unsigned int ) == 4 );
+ ASSERT(sizeof(dbl ) == SIZEOF_DOUBLE);
+ ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T);
+ ASSERT(DNBIGIT*SIZEOF_LIMB_T >= SIZEOF_DOUBLE);
u.d = dbl; /* grab chunks of the double */
low = u.i[L];
}
*exp = (I_) iexp;
#if DNBIGIT == 2
- man->_mp_d[0] = low;
- man->_mp_d[1] = high;
+ man->_mp_d[0] = (mp_limb_t)low;
+ man->_mp_d[1] = (mp_limb_t)high;
#else
#if DNBIGIT == 1
- man->_mp_d[0] = ((unsigned long)high) << 32 | (unsigned long)low;
+ man->_mp_d[0] = ((mp_limb_t)high) << 32 | (mp_limb_t)low;
#else
- error : error : error : Cannae cope with DNBIGIT
+#error Cannot cope with DNBIGIT
#endif
#endif
if (sign < 0)
}
}
-#if ! FLOATS_AS_DOUBLES
void
__decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
{
int high, sign; /* assuming 32 bit ints */
union { float f; int i; } u; /* assuming 32 bit float and int */
+ ASSERT(sizeof(int ) == 4 );
+ ASSERT(sizeof(flt ) == SIZEOF_FLOAT );
+ ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T);
+ ASSERT(FNBIGIT*SIZEOF_LIMB_T >= SIZEOF_FLOAT );
+
u.f = flt; /* grab the float */
high = u.i;
}
}
#if FNBIGIT == 1
- man->_mp_d[0] = high;
+ man->_mp_d[0] = (mp_limb_t)high;
#else
- error : error : error : Cannae cope with FNBIGIT
+#error Cannot cope with FNBIGIT
#endif
if (sign < 0)
man->_mp_size = -man->_mp_size;
}
}
-#endif /* FLOATS_AS_DOUBLES */
/* Convenient union types for checking the layout of IEEE 754 types -
based on defs in GNU libc <ieee754.h>
#ifdef IEEE_FLOATING_POINT
StgInt
-isDoubleNaN(d)
-StgDouble d;
+isDoubleNaN(StgDouble d)
{
union stg_ieee754_dbl u;
}
StgInt
-isDoubleInfinite(d)
-StgDouble d;
+isDoubleInfinite(StgDouble d)
{
union stg_ieee754_dbl u;
}
StgInt
-isDoubleDenormalized(d)
-StgDouble d;
+isDoubleDenormalized(StgDouble d)
{
union stg_ieee754_dbl u;
}
StgInt
-isDoubleNegativeZero(d)
-StgDouble d;
+isDoubleNegativeZero(StgDouble d)
{
union stg_ieee754_dbl u;
StgInt
-isFloatNaN(f)
-StgFloat f;
+isFloatNaN(StgFloat f)
{
-# ifdef FLOATS_AS_DOUBLES
- return (isDoubleNaN(f));
-# else
union stg_ieee754_flt u;
u.f = f;
return (
u.ieee.exponent == 255 /* 2^8 - 1 */ &&
u.ieee.mantissa != 0);
-
-# endif /* !FLOATS_AS_DOUBLES */
}
StgInt
-isFloatInfinite(f)
-StgFloat f;
+isFloatInfinite(StgFloat f)
{
-# ifdef FLOATS_AS_DOUBLES
- return (isDoubleInfinite(f));
-# else
union stg_ieee754_flt u;
u.f = f;
return (
u.ieee.exponent == 255 /* 2^8 - 1 */ &&
u.ieee.mantissa == 0);
-# endif /* !FLOATS_AS_DOUBLES */
}
StgInt
-isFloatDenormalized(f)
-StgFloat f;
+isFloatDenormalized(StgFloat f)
{
-# ifdef FLOATS_AS_DOUBLES
- return (isDoubleDenormalized(f));
-# else
union stg_ieee754_flt u;
u.f = f;
return (
u.ieee.exponent == 0 &&
u.ieee.mantissa != 0);
-#endif /* !FLOATS_AS_DOUBLES */
}
StgInt
-isFloatNegativeZero(f)
-StgFloat f;
+isFloatNegativeZero(StgFloat f)
{
-#ifdef FLOATS_AS_DOUBLES
- return (isDoubleNegativeZero(f));
-# else
union stg_ieee754_flt u;
u.f = f;
u.ieee.negative &&
u.ieee.exponent == 0 &&
u.ieee.mantissa == 0);
-# endif /* !FLOATS_AS_DOUBLES */
}
#else /* ! IEEE_FLOATING_POINT */
projects / ghc-hetmet.git / blobdiff