[project @ 2001-07-23 17:23:19 by simonmar]

[ghc-hetmet.git] / ghc / rts / StgPrimFloat.c

diff --git a/ghc/rts/StgPrimFloat.c b/ghc/rts/StgPrimFloat.c
index 8c3bef6..960d5f8 100644 (file)
--- a/ghc/rts/StgPrimFloat.c
+++ b/ghc/rts/StgPrimFloat.c
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgPrimFloat.c,v 1.3 1999/02/05 16:02:59 simonm Exp $
+ * $Id: StgPrimFloat.c,v 1.6 2000/11/07 13:30:41 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Miscellaneous support for floating-point primitives
  *
@@ -15,11 +15,7 @@
  */
 
 #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 */
-#else
 #define DNBIGIT         2  /* mantissa of a double will fit in two longs */
-#endif
 #define FNBIGIT         1  /* for float, one long */
 
 #if IEEE_FLOATING_POINT
@@ -44,53 +40,86 @@
 #define __abs(a)               (( (a) >= 0 ) ? (a) : (-(a)))
 
 StgDouble
-__encodeDouble (MP_INT *s, I_ e) /* result = s * 2^e */
+__encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
 {
     StgDouble r;
+    W_ *arr = (W_ *)ba;
     I_ i;
 
     /* Convert MP_INT to a double; knows a lot about internal rep! */
-    i = __abs(s->_mp_size)-1;
-    if (i < 0) {
-      r = 0.0;
-    } else {
-      for (r = s->_mp_d[i], i--; i >= 0; i--)
-       r = r * GMP_BASE + s->_mp_d[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 */
        r = ldexp(r, e);
 
     /* sign is encoded in the size */
-    if (s->_mp_size < 0)
+    if (size < 0)
        r = -r;
 
     return r;
 }
 
-#if ! FLOATS_AS_DOUBLES
+/* Special version for small Integers */
+StgDouble
+__int_encodeDouble (I_ j, I_ e)
+{
+  StgDouble r;
+  
+  r = (StgDouble)__abs(j);
+  
+  /* Now raise to the exponent */
+  if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
+    r = ldexp(r, e);
+  
+  /* sign is encoded in the size */
+  if (j < 0)
+    r = -r;
+  
+  return r;
+}
+
 StgFloat
-__encodeFloat (MP_INT *s, I_ e) /* result = s * 2^e */
+__encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
 {
     StgFloat r;
+    W_ *arr = (W_ *)ba;
     I_ i;
 
     /* Convert MP_INT to a float; knows a lot about internal rep! */
-    for(r = 0.0, i = __abs(s->_mp_size)-1; i >= 0; i--)
-       r = (r * GMP_BASE) + s->_mp_d[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 */
        r = ldexp(r, e);
 
     /* sign is encoded in the size */
-    if (s->_mp_size < 0)
+    if (size < 0)
        r = -r;
 
     return r;
 }
-#endif /* FLOATS_AS_DOUBLES */
+
+/* Special version for small Integers */
+StgFloat
+__int_encodeFloat (I_ j, I_ e)
+{
+  StgFloat r;
+  
+  r = (StgFloat)__abs(j);
+  
+  /* Now raise to the exponent */
+  if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
+    r = ldexp(r, e);
+  
+  /* sign is encoded in the size */
+  if (j < 0)
+    r = -r;
+  
+  return r;
+}
 
 /* This only supports IEEE floating point */
 
@@ -149,7 +178,6 @@ __decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl)
     }
 }
 
-#if ! FLOATS_AS_DOUBLES
 void
 __decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
 {
@@ -193,7 +221,6 @@ __decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
            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>
@@ -286,8 +313,7 @@ union stg_ieee754_dbl
 #ifdef IEEE_FLOATING_POINT
 
 StgInt
-isDoubleNaN(d)
-StgDouble d;
+isDoubleNaN(StgDouble d)
 {
   union stg_ieee754_dbl u;
   
@@ -301,8 +327,7 @@ StgDouble d;
 }
 
 StgInt
-isDoubleInfinite(d)
-StgDouble d;
+isDoubleInfinite(StgDouble d)
 {
     union stg_ieee754_dbl u;
 
@@ -317,8 +342,7 @@ StgDouble d;
 }
 
 StgInt
-isDoubleDenormalized(d) 
-StgDouble d;
+isDoubleDenormalized(StgDouble d) 
 {
     union stg_ieee754_dbl u;
 
@@ -340,8 +364,7 @@ StgDouble d;
 }
 
 StgInt
-isDoubleNegativeZero(d) 
-StgDouble d;
+isDoubleNegativeZero(StgDouble d) 
 {
     union stg_ieee754_dbl u;
 
@@ -368,12 +391,8 @@ StgDouble d;
 
 
 StgInt
-isFloatNaN(f) 
-StgFloat f;
+isFloatNaN(StgFloat f)
 {
-# ifdef FLOATS_AS_DOUBLES
-    return (isDoubleNaN(f));
-# else
     union stg_ieee754_flt u;
     u.f = f;
 
@@ -382,17 +401,11 @@ StgFloat 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;
   
@@ -401,16 +414,11 @@ StgFloat 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;
 
@@ -424,16 +432,11 @@ StgFloat 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;
 
@@ -442,7 +445,6 @@ StgFloat f;
        u.ieee.negative      &&
        u.ieee.exponent == 0 &&
        u.ieee.mantissa == 0);
-# endif /* !FLOATS_AS_DOUBLES */
 }
 
 #else /* ! IEEE_FLOATING_POINT */