Commit e58d0e9b authored by simonm's avatar simonm
Browse files

[project @ 1999-02-18 12:26:11 by simonm]

Add two new operations to StgPrimFloat.c:

	__int_encodeFloat
	__int_encodeDouble

for encoding floats/doubles from small integers.  This avoids having
to convert small integers to large ones before an encodeFloat
operation, and fixes the two cases of slowdown in nofib after the
small integer changes.

Also:
	- remove encodeFloat and decodeFloat as primops
	- use foreign import for encode{Float,Double} and
	  the various isNaN etc. ccalls in PrelNumExtra.
parent 1f9caae5
......@@ -349,8 +349,8 @@ floatOps =
, DoubleAsinOp , DoubleAcosOp , DoubleAtanOp
, DoubleSinhOp , DoubleCoshOp , DoubleTanhOp
, DoublePowerOp
, FloatEncodeOp , FloatDecodeOp
, DoubleEncodeOp , DoubleDecodeOp
, FloatDecodeOp
, DoubleDecodeOp
]
gmpOps :: [PrimOp]
......
......@@ -127,8 +127,8 @@ data PrimOp
| IntegerToWord64Op | Word64ToIntegerOp
-- ?? gcd, etc?
| FloatEncodeOp | FloatDecodeOp
| DoubleEncodeOp | DoubleDecodeOp
| FloatDecodeOp
| DoubleDecodeOp
-- primitive ops for primitive arrays
......@@ -416,9 +416,7 @@ tagOf_PrimOp IntegerToInt64Op = ILIT(120)
tagOf_PrimOp Int64ToIntegerOp = ILIT(121)
tagOf_PrimOp IntegerToWord64Op = ILIT(122)
tagOf_PrimOp Word64ToIntegerOp = ILIT(123)
tagOf_PrimOp FloatEncodeOp = ILIT(124)
tagOf_PrimOp FloatDecodeOp = ILIT(125)
tagOf_PrimOp DoubleEncodeOp = ILIT(126)
tagOf_PrimOp DoubleDecodeOp = ILIT(127)
tagOf_PrimOp NewArrayOp = ILIT(128)
......@@ -690,9 +688,7 @@ allThePrimOps
Int64ToIntegerOp,
IntegerToWord64Op,
Word64ToIntegerOp,
FloatEncodeOp,
FloatDecodeOp,
DoubleEncodeOp,
DoubleDecodeOp,
NewArrayOp,
NewByteArrayOp CharRep,
......@@ -1057,8 +1053,7 @@ primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
%* *
%************************************************************************
@encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
similar).
@decodeFloat#@ is given w/ Integer-stuff (it's similar).
\begin{code}
primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
......@@ -1091,8 +1086,7 @@ primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
%* *
%************************************************************************
@encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
similar).
@decodeDouble#@ is given w/ Integer-stuff (it's similar).
\begin{code}
primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
......@@ -1176,16 +1170,10 @@ primOpInfo IntegerToWord64Op
= mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
\end{code}
Encoding and decoding of floating-point numbers is sorta
Integer-related.
Decoding of floating-point numbers is sorta Integer-related. Encoding
is done with plain ccalls now (see PrelNumExtra.lhs).
\begin{code}
primOpInfo FloatEncodeOp
= mkGenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
primOpInfo DoubleEncodeOp
= mkGenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
primOpInfo FloatDecodeOp
= mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
(unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
......@@ -1971,7 +1959,6 @@ primOpNeedsWrapper FloatSinhOp = True
primOpNeedsWrapper FloatCoshOp = True
primOpNeedsWrapper FloatTanhOp = True
primOpNeedsWrapper FloatPowerOp = True
primOpNeedsWrapper FloatEncodeOp = True
primOpNeedsWrapper DoubleExpOp = True
primOpNeedsWrapper DoubleLogOp = True
......@@ -1986,7 +1973,6 @@ primOpNeedsWrapper DoubleSinhOp = True
primOpNeedsWrapper DoubleCoshOp = True
primOpNeedsWrapper DoubleTanhOp = True
primOpNeedsWrapper DoublePowerOp = True
primOpNeedsWrapper DoubleEncodeOp = True
primOpNeedsWrapper MakeStableNameOp = True
primOpNeedsWrapper DeRefStablePtrOp = True
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.19 1999/02/17 15:57:30 simonm Exp $
* $Id: PrimOps.h,v 1.20 1999/02/18 12:26:11 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -596,36 +596,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, sa,da, expon) encodeDoublezh(r, sa,da, expon)
#else
#define encodeFloatzh(r, sa,da, expon) \
{ MP_INT arg; \
/* Does not allocate memory */ \
\
arg._mp_size = sa; \
arg._mp_alloc = ((StgArrWords *)da)->words; \
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, sa,da, expon) \
{ MP_INT arg; \
/* Does not allocate memory */ \
\
arg._mp_size = sa; \
arg._mp_alloc = ((StgArrWords *)da)->words; \
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
......@@ -636,8 +609,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);
......
......@@ -144,7 +144,6 @@ __export PrelGHC
tanhFloatzh
powerFloatzh
decodeFloatzh
encodeFloatzh
Doublezh
zgzhzh
......@@ -176,7 +175,6 @@ __export PrelGHC
tanhDoublezh
ztztzhzh
decodeDoublezh
encodeDoublezh
cmpIntegerzh
cmpIntegerIntzh
......
......@@ -137,6 +137,16 @@ instance RealFrac Float where
floor x = case properFraction x of
(n,r) -> if r < 0.0 then n - 1 else n
foreign import ccall "__encodeFloat" unsafe
encodeFloat# :: Int# -> ByteArray# -> Int -> Float
foreign import ccall "__int_encodeFloat" unsafe
int_encodeFloat# :: Int# -> Int -> Float
foreign import ccall "isFloatNaN" unsafe isFloatNaN :: Float -> Int
foreign import ccall "isFloatInfinite" unsafe isFloatInfinite :: Float -> Int
foreign import ccall "isFloatDenormalized" unsafe isFloatDenormalized :: Float -> Int
foreign import ccall "isFloatNegativeZero" unsafe isFloatNegativeZero :: Float -> Int
instance RealFloat Float where
floatRadix _ = FLT_RADIX -- from float.h
floatDigits _ = FLT_MANT_DIG -- ditto
......@@ -146,9 +156,8 @@ instance RealFloat Float where
= case decodeFloat# f# of
(# exp#, s#, d# #) -> (J# s# d#, I# exp#)
encodeFloat i@(S# _) j = encodeFloat (toBig i) j
encodeFloat (J# s# d#) (I# e#)
= case encodeFloat# s# d# e# of { flt# -> F# flt# }
encodeFloat (S# i) j = int_encodeFloat# i j
encodeFloat (J# s# d#) e = encodeFloat# s# d# e
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
......@@ -158,15 +167,11 @@ instance RealFloat Float where
scaleFloat k x = case decodeFloat x of
(m,n) -> encodeFloat m (n+k)
isNaN x =
(0::Int) /= unsafePerformIO (_ccall_ isFloatNaN x) {- a _pure_function! -}
isInfinite x =
(0::Int) /= unsafePerformIO (_ccall_ isFloatInfinite x) {- ditto! -}
isDenormalized x =
(0::Int) /= unsafePerformIO (_ccall_ isFloatDenormalized x) -- ..
isNegativeZero x =
(0::Int) /= unsafePerformIO (_ccall_ isFloatNegativeZero x) -- ...
isIEEE _ = True
isNaN x = 0 /= isFloatNaN x
isInfinite x = 0 /= isFloatInfinite x
isDenormalized x = 0 /= isFloatDenormalized x
isNegativeZero x = 0 /= isFloatNegativeZero x
isIEEE _ = True
\end{code}
%*********************************************************
......@@ -289,6 +294,16 @@ instance RealFrac Double where
floor x = case properFraction x of
(n,r) -> if r < 0.0 then n - 1 else n
foreign import ccall "__encodeDouble" unsafe
encodeDouble# :: Int# -> ByteArray# -> Int -> Double
foreign import ccall "__int_encodeDouble" unsafe
int_encodeDouble# :: Int# -> Int -> Double
foreign import ccall "isDoubleNaN" unsafe isDoubleNaN :: Double -> Int
foreign import ccall "isDoubleInfinite" unsafe isDoubleInfinite :: Double -> Int
foreign import ccall "isDoubleDenormalized" unsafe isDoubleDenormalized :: Double -> Int
foreign import ccall "isDoubleNegativeZero" unsafe isDoubleNegativeZero :: Double -> Int
instance RealFloat Double where
floatRadix _ = FLT_RADIX -- from float.h
floatDigits _ = DBL_MANT_DIG -- ditto
......@@ -298,9 +313,8 @@ instance RealFloat Double where
= case decodeDouble# x# of
(# exp#, s#, d# #) -> (J# s# d#, I# exp#)
encodeFloat i@(S# _) j = encodeFloat (toBig i) j
encodeFloat (J# s# d#) (I# e#)
= case encodeDouble# s# d# e# of { dbl# -> D# dbl# }
encodeFloat (S# i) j = int_encodeDouble# i j
encodeFloat (J# s# d#) e = encodeDouble# s# d# e
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
......@@ -310,15 +324,12 @@ instance RealFloat Double where
scaleFloat k x = case decodeFloat x of
(m,n) -> encodeFloat m (n+k)
isNaN x =
(0::Int) /= unsafePerformIO (_ccall_ isDoubleNaN x) {- a _pure_function! -}
isInfinite x =
(0::Int) /= unsafePerformIO (_ccall_ isDoubleInfinite x) {- ditto -}
isDenormalized x =
(0::Int) /= unsafePerformIO (_ccall_ isDoubleDenormalized x) -- ..
isNegativeZero x =
(0::Int) /= unsafePerformIO (_ccall_ isDoubleNegativeZero x) -- ...
isIEEE _ = True
isNaN x = 0 /= isDoubleNaN x
isInfinite x = 0 /= isDoubleInfinite x
isDenormalized x = 0 /= isDoubleDenormalized x
isNegativeZero x = 0 /= isDoubleNegativeZero x
isIEEE _ = True
instance Show Double where
showsPrec x = showSigned showFloat x
......@@ -592,9 +603,6 @@ instead of
Lennart's code follows, and it works...
\begin{pseudocode}
{-# SPECIALISE fromRat ::
Rational -> Double,
Rational -> Float #-}
fromRat :: (RealFloat a) => Rational -> a
fromRat x = x'
where x' = f e
......@@ -624,6 +632,9 @@ fromRat x = x'
Now, here's Lennart's code.
\begin{code}
{-# SPECIALISE fromRat ::
Rational -> Double,
Rational -> Float #-}
fromRat :: (RealFloat a) => Rational -> a
fromRat x
| x == 0 = encodeFloat 0 0 -- Handle exceptional cases
......
/* -----------------------------------------------------------------------------
* $Id: StgPrimFloat.c,v 1.3 1999/02/05 16:02:59 simonm Exp $
* $Id: StgPrimFloat.c,v 1.4 1999/02/18 12:26:12 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -44,18 +44,19 @@
#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;
i = __abs(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 = arr[i], i--; i >= 0; i--)
r = r * GMP_BASE + arr[i];
}
/* Now raise to the exponent */
......@@ -63,33 +64,73 @@ __encodeDouble (MP_INT *s, I_ e) /* result = s * 2^e */
r = ldexp(r, e);
/* sign is encoded in the size */
if (s->_mp_size < 0)
if (size < 0)
r = -r;
return r;
}
/* 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;
}
#if ! FLOATS_AS_DOUBLES
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); 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;
}
/* 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;
}
#endif /* FLOATS_AS_DOUBLES */
/* This only supports IEEE floating point */
......
Markdown is supported
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