/* if x is zero, return -HUGE */
if (x == 0.0e0)
return(-HUGE_INT8_F90);
i = __ieee_real4i(x);
return ((_f_int8) i);
}
#else /* _CRAYMPP */
_f_int8
_IEEE_EXPONENT_I8_H(_f_real4 x)
{
int i;
REGISTER_4 s1, s2;
/* if x is a NaN, return HUGE */
if (isnan32(x))
return(HUGE_INT8_F90);
s1.f = x;
/* clear sign bit. */
s1.ui &= ~IEEE_32_SIGN_BIT;
/* if x is + or -infinity, return HUGE */
if (s1.ui == IEEE_32_INFINITY)
return(HUGE_INT8_F90);
/* if x is zero, return -HUGE */
if (x == (float) 0.0e0)
return(-HUGE_INT8_F90);
/* shift exponent bits to right. */
s1.i >>= IEEE_32_MANT_BITS;
if (s1.ui == 0) {
/* x is a subnormal number (implicit leading bit is zero
* and the exponent is zero). calculate the exponent
* based on normalized x.
*
* get mantissa
*/
s2.f = x;
s2.ui = IEEE_32_MANTISSA & s2.ui;
/* get leading zeros in mantissa part. */
i = _leadz4(s2.ui) - IEEE_32_EXPO_BITS;
/* calculate exponent. */
s1.i -= (IEEE_32_EXPO_BIAS + i);
} else {
/* subtract exponent bias and implicit bit. */
s1.i -= (IEEE_32_EXPO_BIAS);
}
return((_f_int8) s1.i);
}
inline static /* for the inline version of this function. */
#endif
#ifdef _F_REAL4
_f_real4
_FRACTION_4(_f_real4 x)
{
int lz;
REGISTER_4 s1, sign_bit, mantissa, exponent;
if (x == 0.0)
return 0.0;
/* if x is either infinity or a NaN, return a Nan */
if (x == IEEE_32_INFINITY)
return _HALF_NaN;
if (isnan32(x))
return x;
s1.f = x;
/* get sign bit */
sign_bit.ui = IEEE_32_SIGN_BIT & s1.ui;
/* get mantissa */
mantissa.ui = IEEE_32_MANTISSA & s1.ui;
/* get exponent */
exponent.ui = IEEE_32_EXPONENT & s1.ui;
if (exponent.ui == 0x0) {
/* number is subnormal. normalize mantissa. */
/* 1. Get leading zeros of mantissa. */
lz = _leadz4(mantissa.ui) - IEEE_32_EXPO_BITS;
/* 2. Normalize by shifting out all leading zeros and
* first 1 bit.
*/
mantissa.ui = (mantissa.ui << lz) & IEEE_32_MANTISSA;
}
/* position the exponent bias less the implicit bit */
exponent.ui = (IEEE_32_EXPO_BIAS - 1) << IEEE_32_MANT_BITS;
/* extract fraction. */
s1.ui = exponent.ui | mantissa.ui | sign_bit.ui;
return s1.f;
}
_f_real4
_IEEE_BINARY_SCALE_H(_f_real4 orig_number, _f_int4 orig_scale_factor)
{
int lz, lzm, shift;
REGISTER_4 number, scale_factor, expon, exponent,
orig_mantissa, mantissa, sign_bit;
/* if x is a NaN, return a Nan */
if (isnan32(orig_number))
return orig_number;
number.f = orig_number;
/* extract sign bit. */
sign_bit.ui = IEEE_32_SIGN_BIT & number.ui;
/* extract exponent. */
exponent.ui = IEEE_32_EXPONENT & number.ui;
/* extract mantissa. */
orig_mantissa.ui = IEEE_32_MANTISSA & number.ui;
/* if x is + or -infinity, return same infinity */
number.ui &= ~IEEE_32_SIGN_BIT;
if (number.ui == IEEE_32_INFINITY)
return orig_number;
/* if x is zero, return zero. */
if (orig_number == 0)
return orig_number;
scale_factor.i = orig_scale_factor;
/* check for unnormalized number */
if (exponent.ui == 0) {
/* Denormmal. Get leading zeros in original mantissa */
lz = _leadz4(orig_mantissa.ui);
if (scale_factor.i > 0) {
/* Scale number by a positive power of 2. The
* result may need to be normalized. Get
* leading zeros in mantissa = lzm.
*/
lzm = lz - IEEE_32_EXPO_BITS - 1;
/* Any leading zeros in mantissa? */
if (lzm > 0) {
/* check if number of leading zeros in
* mantissa allows scaling by shifting.
*/
if (scale_factor.i <= lzm) {
/* Enough lead zeros to shift.
* Exponent is unaffected.
*/
shift = scale_factor.i;
expon.i = 0;
} else {
/* Scale by shifting what we can
* and adjust exponent for rest.
* The result is a normalized
* number.
*/
shift = lzm + 1;
expon.i = scale_factor.i - lzm;
}
/* No leading zeros in mantissa. */
} else {
/* Shift by 1 to normalize mantissa. Do
* rest of scaling through exponent.
*/
shift = 1;
expon.i = scale_factor.i;
}
/* position the exponent. */
exponent.ui = expon.ui << IEEE_32_MANT_BITS;
/* scale the mantissa. */
mantissa.ui = orig_mantissa.ui << shift;
/* Scale_factor LE 0. */
} else {
/* scale mantissa. */
mantissa.ui = orig_mantissa.ui >> (-scale_factor.i);
if ((-scale_factor.ui != 0) &&
(orig_mantissa.ui & (0x1 <<
(-scale_factor.i - 1)))) {
mantissa.ui++;
}
}
/* mask out any bits that may have shifted to the left of
* the mantissa area.
*/
mantissa.ui &= IEEE_32_MANTISSA;
/* OR the new mantissa, the new exponent, and the original
* sign bit together to create the result.
*/
number.ui = mantissa.ui | exponent.ui | sign_bit.ui;
} else {
/* _IEEE_EXPONENT_I2_H - IEEE EXPONENT returns the exponent part of the
* 32-bit argument in 16-bit integer.
*/
_f_int2
_IEEE_EXPONENT_I2_H(_f_real4 x)
{
union _ieee_float {
_f_real4 dword;
_f_int4 lword;
struct {
#if __BYTE_ORDER == __LITTLE_ENDIAN
unsigned int mantissa : IEEE_32_MANT_BITS;
unsigned int exponent : IEEE_32_EXPO_BITS;
unsigned int sign : 1;
#else
unsigned int sign : 1;
unsigned int exponent : IEEE_32_EXPO_BITS;
unsigned int mantissa : IEEE_32_MANT_BITS;
#endif
} parts;
};
_f_int2 iresult = 0;
switch(fp_class_f(x)) {
case FP_SNAN:
case FP_QNAN:
case FP_POS_INF:
case FP_NEG_INF:
{
/* return positive huge for NaN or infinity. */
return(HUGE_INT2_F90);
}
case FP_POS_NORM:
case FP_NEG_NORM:
{
union _ieee_float x_val;
x_val.dword = x;
return((_f_int2)(x_val.parts.exponent -
IEEE_32_EXPO_BIAS));
}
case FP_POS_DENORM:
case FP_NEG_DENORM:
{
union _ieee_float x_val;
x_val.dword = x;
/* _leadz returns number of zeros before first 1
* in mantissa. Add 8 to exclude exponent bits,
* but count sign bit since implicit bit needs to
* be counted.
*/
return((_f_int2)(-IEEE_32_EXPO_BIAS -
(_leadz4(x_val.parts.mantissa) +
IEEE_32_EXPO_BITS)));
}
case FP_POS_ZERO:
case FP_NEG_ZERO:
{
/* return negative huge for zero. */
return(-HUGE_INT2_F90);
}
}
return(iresult);
}
inline static /* for the inline version of this function. */
#endif
_f_real4
_SCALE_4(_f_real4 orig_number, _f_int orig_scale_factor)
{
int lz, lzm, shift;
REGISTER_4 number, scale_factor, expon, exponent,
orig_mantissa, mantissa, sign_bit;
/* eliminate the easy cases first. */
if (orig_scale_factor == 0)
return orig_number;
if (orig_number == 0)
return 0.0;
number.f = orig_number;
scale_factor.i = orig_scale_factor;
/* extract exponent. */
exponent.ui = IEEE_32_EXPONENT & number.ui;
/* extract mantissa. */
orig_mantissa.ui = IEEE_32_MANTISSA & number.ui;
/* extract sign bit. */
sign_bit.ui = IEEE_32_SIGN_BIT & number.ui;
if (exponent.ui == 0) {
/* number is Denormal. */
lz = _leadz4(orig_mantissa.ui); /* get leading zeros in
* original mantissa. */
if (scale_factor.i > 0) {
/* Scale number by a positive power of 2. We may
* create a number that will need to be normalized.
* Get leading zeros in mantissa = lzm.
*/
lzm = lz - IEEE_32_EXPO_BITS - 1;
/* if number of leading zeros in mantissa GT zero. */
if (lzm > 0) {
/* leading zeros in mantissa. */
if (scale_factor.i <= lzm) {
/* Enough leading zeros in mantissa
* to allow scaling by shifting.
* Exponent is unaffected.
*/
shift = scale_factor.i;
expon.i = 0;
} else {
/* Scale by shifting what we can and
* by adjusting exponent for the rest.
* This creates a normalized number.
*/
shift = lzm + 1;
expon.i = scale_factor.i - lzm;
}
/* no leading zeros in mantissa. */
} else {
/* Shift by 1 to normalize mantissa. The
* rest of the scaling will be done
* through the exponent.
*/
shift = 1;
expon.i = scale_factor.i;
}
/* position the exponent. */
exponent.ui = expon.ui << IEEE_32_MANT_BITS;
/* scale the mantissa. */
mantissa.ui = orig_mantissa.ui << shift;
/* Scale_factor.i LE 0. */
} else {
/* scale mantissa. */
mantissa.ui = orig_mantissa.ui >> (-scale_factor.i);
/* This is a bit of magic that does rounding. Get the
* last bit that will be shifted off to the right, if
* it's a 1 round the mantissa up by adding 1.
*/
if ((-scale_factor.ui != 0) &&
(orig_mantissa.ui & (0x1 <<
(-scale_factor.i - 1)))) {
mantissa.ui++;
}
}
/* mask out any bits that may have shifted to the left of
* the mantissa area.
*/
mantissa.ui &= IEEE_32_MANTISSA;
/* OR the new mantissa, the new exponent, and the original
* sign bit together to create the result.
*/
number.ui = mantissa.ui | exponent.ui | sign_bit.ui;
} else {
