Esempio n. 1
0
void test_fp_utilities( void )
{
#if __STDC_VERSION__ >= 199901L
    printf( "Testing C99 miscellaneous functions...\n" );

    VERIFY( CompDbl( copysign( -2.0, 1.0), 2.0 ) );
    VERIFY( CompDbl( copysign( -2.0, -1.0), -2.0 ) );
    VERIFY( CompDbl( copysign( 2.0, -1.0), -2.0 ) );
    VERIFY( CompDbl( copysign( 2.0, 1.0), 2.0 ) );
    
    VERIFY( CompDbl( fmax( 2.0, 1.0), 2.0 ) );
    VERIFY( CompDbl( fmax( -2.0, -1.0), -1.0 ) );
    VERIFY( CompDbl( fmin( 2.0, 1.0), 1.0 ) );
    VERIFY( CompDbl( fmin( -2.0, -1.0), -2.0 ) );
    
    VERIFY( CompDbl( fma( 2.0, 3.0, 4.0), 10.0 ) );
    VERIFY( CompDbl( fma( 2.0, 3.0, -4.0), 2.0 ) );
    VERIFY( CompDbl( fma( -2.0, 3.0, 4.0), -2.0 ) );
    VERIFY( CompDbl( fma( -2.0, -3.0, 4.0), 10.0 ) );
    
    VERIFY( CompDbl( fdim( 3.0, 2.0), 1.0 ) );
    VERIFY( CompDbl( fdim( 2.0, 3.0), 0.0 ) );
    
    VERIFY( CompDbl( nextafter( 1.0, 2.0), 1.0+1.0E-16 ) );
    VERIFY( CompDbl( nextafter( 1.0, 0.0), 1.0-1.0E-16 ) );
    
    VERIFY( CompDbl( scalbn( 1.0, 3.0), 8.0 ) );
    VERIFY( CompDbl( scalbn( 4.0, 3.0), 32.0 ) );
#endif
}
Esempio n. 2
0
void test_scalbn()
{
    static_assert((std::is_same<decltype(scalbn((double)0, (int)0)), double>::value), "");
    static_assert((std::is_same<decltype(scalbnf(0, (int)0)), float>::value), "");
    static_assert((std::is_same<decltype(scalbnl(0, (int)0)), long double>::value), "");
    assert(scalbn(1, 1) == 2);
}
Esempio n. 3
0
fcomplex
cexpf(fcomplex z) {
	fcomplex	ans;
	float		x, y, c, s;
	double		t;
	int		n, ix, iy, hx, hy;

	x = F_RE(z);
	y = F_IM(z);
	hx = THE_WORD(x);
	hy = THE_WORD(y);
	ix = hx & 0x7fffffff;
	iy = hy & 0x7fffffff;
	if (iy == 0) {		/* y = 0 */
		F_RE(ans) = expf(x);
		F_IM(ans) = y;
	} else if (ix == 0x7f800000) {	/* x is +-inf */
		if (hx < 0) {
			if (iy >= 0x7f800000) {
				F_RE(ans) = zero;
				F_IM(ans) = zero;
			} else {
				sincosf(y, &s, &c);
				F_RE(ans) = zero * c;
				F_IM(ans) = zero * s;
			}
		} else {
			if (iy >= 0x7f800000) {
				F_RE(ans) = x;
				F_IM(ans) = y - y;
			} else {
				sincosf(y, &s, &c);
				F_RE(ans) = x * c;
				F_IM(ans) = x * s;
			}
		}
	} else {
		sincosf(y, &s, &c);
		if (ix >= 0x42B171AA) {	/* |x| > 88.722... ~ log(2**128) */
#if defined(__i386) && !defined(__amd64)
			int	rp = __swapRP(fp_extended);
#endif
			t = __k_cexp(x, &n);
			F_RE(ans) = (float)scalbn(t * (double)c, n);
			F_IM(ans) = (float)scalbn(t * (double)s, n);
#if defined(__i386) && !defined(__amd64)
			if (rp != fp_extended)
				(void) __swapRP(rp);
#endif
		} else {
			t = expf(x);
			F_RE(ans) = t * c;
			F_IM(ans) = t * s;
		}
	}
	return (ans);
}
Esempio n. 4
0
dcomplex
csinh(dcomplex z) {
	double t, x, y, S, C;
	int hx, ix, lx, hy, iy, ly, n;
	dcomplex ans;

	x = D_RE(z);
	y = D_IM(z);
	hx = HI_WORD(x);
	lx = LO_WORD(x);
	ix = hx & 0x7fffffff;
	hy = HI_WORD(y);
	ly = LO_WORD(y);
	iy = hy & 0x7fffffff;
	x = fabs(x);
	y = fabs(y);

	(void) sincos(y, &S, &C);
	if (ix >= 0x403c0000) {	/* |x| > 28 = prec/2 (14,28,34,60) */
		if (ix >= 0x40862E42) {	/* |x| > 709.78... ~ log(2**1024) */
			if (ix >= 0x7ff00000) {	/* |x| is inf or NaN */
				if ((iy | ly) == 0) {
					D_RE(ans) = x;
					D_IM(ans) = y;
				} else if (iy >= 0x7ff00000) {
					D_RE(ans) = x;
					D_IM(ans) = x - y;
				} else {
					D_RE(ans) = C * x;
					D_IM(ans) = S * x;
				}
			} else {
				/* return exp(x)=t*2**n */
				t = __k_cexp(x, &n);
				D_RE(ans) = scalbn(C * t, n - 1);
				D_IM(ans) = scalbn(S * t, n - 1);
			}
		} else {
			t = exp(x) * 0.5;
			D_RE(ans) = C * t;
			D_IM(ans) = S * t;
		}
	} else {
		if ((ix | lx) == 0) {	/* x = 0, return (0,S) */
			D_RE(ans) = 0.0;
			D_IM(ans) = S;
		} else {
			D_RE(ans) = C * sinh(x);
			D_IM(ans) = S * cosh(x);
		}
	}
	if (hx < 0)
		D_RE(ans) = -D_RE(ans);
	if (hy < 0)
		D_IM(ans) = -D_IM(ans);
	return (ans);
}
Esempio n. 5
0
double
log1p(double x)
{
	static const double zero=0.0, negone= -1.0, one=1.0,
		      half=1.0/2.0, small=1.0E-20;   /* 1+small == 1 */
	double z,s,t,c;
	int k;

	if (isnan(x))
		return (x);

	if(finite(x)) {
	   if( x > negone ) {

	   /* argument reduction */
	      if(copysign(x,one)<small) return(x);
	      k=logb(one+x); z=scalbn(x,-k); t=scalbn(one,-k);
	      if(z+t >= sqrt2 )
		  { k += 1 ; z *= half; t *= half; }
	      t += negone; x = z + t;
	      c = (t-x)+z ;		/* correction term for x */

 	   /* compute log(1+x)  */
              s = x/(2+x); t = x*x*half;
	      c += (k*ln2lo-c*x);
	      z = c+s*(t+__log__L(s*s));
	      x += (z - t) ;

	      return(k*ln2hi+x);
	   }
	/* end of if (x > negone) */

	    else {
#if defined(__vax__)
		if ( x == negone )
		    return (infnan(-ERANGE));	/* -INF */
		else
		    return (infnan(EDOM));	/* NaN */
#else	/* defined(__vax__) */
		/* x = -1, return -INF with signal */
		if ( x == negone ) return( negone/zero );

		/* negative argument for log, return NaN with signal */
	        else return ( zero / zero );
#endif	/* defined(__vax__) */
	    }
	}
    /* end of if (finite(x)) */

    /* log(-INF) is NaN */
	else if(x<0)
	     return(zero/zero);

    /* log(+INF) is INF */
	else return(x);
}
Esempio n. 6
0
inline T normalize_value(const T& val, const mpl::true_&)
{
   BOOST_STATIC_ASSERT(std::numeric_limits<T>::is_specialized);
   BOOST_STATIC_ASSERT(std::numeric_limits<T>::radix != 2);

   boost::intmax_t shift = std::numeric_limits<T>::digits - ilogb(val) - 1;
   T result = scalbn(val, shift);
   result = round(result);
   return scalbn(result, -shift);
}
Esempio n. 7
0
double attribute_hidden __ieee754_scalb(double x, double fn)
{
	if (isnan(x)||isnan(fn)) return x*fn;
	if (!isfinite(fn)) {
	    if(fn>0.0) return x*fn;
	    else       return x/(-fn);
	}
	if (rint(fn)!=fn) return (fn-fn)/(fn-fn);
	if ( fn > 65000.0) return scalbn(x, 65000);
	if (-fn > 65000.0) return scalbn(x,-65000);
	return scalbn(x,(int)fn);
}
Esempio n. 8
0
double
scalb(double x, double fn)
{
	if (isnan(x)||isnan(fn)) return x*fn;
	if (!finite(fn)) {
	    if(fn>0.0) return x*fn;
	    else       return x/(-fn);
	}
	if (rint(fn)!=fn) return (fn-fn)/(fn-fn);
	if ( fn > 65000.0) return scalbn(x, 65000);
	if (-fn > 65000.0) return scalbn(x,-65000);
	return scalbn(x,(int)fn);
}
Esempio n. 9
0
/*
 * Convert a floating point number in native format to TMS32032
 * floating point single precision (32 bit) format.  Note that the
 * TMS floating point value is returned as an unsigned integer.
 */
static unsigned int
float2tms32(float x)
{
    unsigned int zero = 0x80000000; /* Zero value is special case */
    int nfracbits = 23;    /* Not including hidden bit / sign bit */
    int signbit = 1 << nfracbits;
    int fracmask = ~((~0)<<nfracbits);
    int iexp;
    int sign;
    int ifrac;
    unsigned int rtn;

    if (x == 0){
        rtn = zero;
    }else{
        iexp = ilogb(x);  /* Binary exponent if 1 <= |fraction| < 2 */
        ifrac = (int)scalbn(x, nfracbits-iexp); /* Frac part as integer */
        if (x<0 && (ifrac & signbit)){
            /* Force top bit of negative fraction to be 0 */
            ifrac <<= 1;
            iexp--;
        }
        sign = x<0 ? signbit : 0;
        rtn = (iexp << (nfracbits+1)) | sign | (ifrac & fracmask);
    }
    return rtn;
}
Esempio n. 10
0
double
cosh(double x) {
	double t, w;

	w = fabs(x);
	if (!finite(w))
		return (w * w);
	if (w < 0.3465) {
		t = expm1(w);
		w = 1.0 + t;
		if (w != 1.0)
			w = 1.0 + (t * t) / (w + w);
		return (w);
	} else if (w < 22.0) {
		t = exp(w);
		return (0.5 * (t + 1.0 / t));
	} else if (w <= lnovft) {
		return (0.5 * exp(w));
	} else {
		w = (w - 1024 * ln2hi) - 1024 * ln2lo;
		if (w >= ln2)
			return (_SVID_libm_err(x, x, 5));
		else
			return (scalbn(exp(w), 1023));
	}
}
Esempio n. 11
0
T ulp_imp(const T& val, const mpl::false_&, const Policy& pol)
{
   BOOST_STATIC_ASSERT(std::numeric_limits<T>::is_specialized);
   BOOST_STATIC_ASSERT(std::numeric_limits<T>::radix != 2);
   BOOST_MATH_STD_USING
   int expon;
   static const char* function = "ulp<%1%>(%1%)";

   int fpclass = (boost::math::fpclassify)(val);

   if(fpclass == (int)FP_NAN)
   {
      return policies::raise_domain_error<T>(
         function,
         "Argument must be finite, but got %1%", val, pol);
   }
   else if((fpclass == (int)FP_INFINITE) || (fabs(val) >= tools::max_value<T>()))
   {
      return (val < 0 ? -1 : 1) * policies::raise_overflow_error<T>(function, 0, pol);
   }
   else if(fpclass == FP_ZERO)
      return detail::get_smallest_value<T>();
   //
   // This code is almost the same as that for float_next, except for negative integers,
   // where we preserve the relation ulp(x) == ulp(-x) as does Java:
   //
   expon = 1 + ilogb(fabs(val));
   T diff = scalbn(T(1), expon - std::numeric_limits<T>::digits);
   if(diff == 0)
      diff = detail::get_smallest_value<T>();
   return diff;
}
Esempio n. 12
0
vmod_hash_backend(const struct vrt_ctx *ctx, struct vmod_directors_hash *rr,
    const char *arg, ...)
{
	struct SHA256Context sha_ctx;
	va_list ap;
	const char *p;
	unsigned char sha256[SHA256_LEN];
	VCL_BACKEND be;
	double r;

	CHECK_OBJ_NOTNULL(ctx, VRT_CTX_MAGIC);

	CHECK_OBJ_NOTNULL(rr, VMOD_DIRECTORS_HASH_MAGIC);
	SHA256_Init(&sha_ctx);
	va_start(ap, arg);
	p = arg;
	while (p != vrt_magic_string_end) {
		SHA256_Update(&sha_ctx, arg, strlen(arg));
		p = va_arg(ap, const char *);
	}
	va_end(ap);
	SHA256_Final(sha256, &sha_ctx);

	r = vbe32dec(sha256);
	r = scalbn(r, -32);
	assert(r >= 0 && r <= 1.0);
	be = vdir_pick_be(rr->vd, r, rr->nloops);
	return (be);
}
Esempio n. 13
0
	double ldexp(double value, int exp)
{
	if(!finite(value)||value==0.0) return value;
	value = scalbn(value,exp);
	if(!finite(value)||value==0.0) errno = ERANGE;
	return value;
}
Esempio n. 14
0
double ldexp(double value, int exp)
{
    if(!finite(value)||value==0.0) return value;
    value = scalbn(value,exp);
    if(!finite(value)||value==0.0) libm_errno = 34;
    return value;
}
Esempio n. 15
0
int main(void)
{
	#pragma STDC FENV_ACCESS ON
	double y;
	float d;
	int e, i, err = 0;
	struct di_d *p;

	for (i = 0; i < sizeof t/sizeof *t; i++) {
		p = t + i;

		if (p->r < 0)
			continue;
		fesetround(p->r);
		feclearexcept(FE_ALL_EXCEPT);
		y = scalbn(p->x, p->i);
		e = fetestexcept(INEXACT|INVALID|DIVBYZERO|UNDERFLOW|OVERFLOW);

		if (!checkexceptall(e, p->e, p->r)) {
			printf("%s:%d: bad fp exception: %s scalbn(%a, %lld)=%a, want %s",
				p->file, p->line, rstr(p->r), p->x, p->i, p->y, estr(p->e));
			printf(" got %s\n", estr(e));
			err++;
		}
		d = ulperr(y, p->y, p->dy);
		if (!checkcr(y, p->y, p->r)) {
			printf("%s:%d: %s scalbn(%a, %lld) want %a got %a, ulperr %.3f = %a + %a\n",
				p->file, p->line, rstr(p->r), p->x, p->i, p->y, y, d, d-p->dy, p->dy);
			err++;
		}
	}
	return !!err;
}
Esempio n. 16
0
double scalbln(double x, long n) {
    if (n > INT_MAX)
        n = INT_MAX;
    else if (n < INT_MIN)
        n = INT_MIN;
    return scalbn(x, n);
}
Esempio n. 17
0
double
exp2(double x) {
	int	ix, hx, k;
	double	t;

	ix = ((int *)&x)[HIWORD];
	hx = ix & ~0x80000000;

	if (hx >= 0x4090e000) {	/* |x| >= 1080 or x is nan */
		if (hx >= 0x7ff00000) {	/* x is inf or nan */
			if (ix == 0xfff00000 && ((int *)&x)[LOWORD] == 0)
				return (zero);
			return (x * x);
		}
		t = (ix < 0)? tiny : huge;
		return (t * t);
	}

	if (hx < 0x3fe00000) {	/* |x| < 0.5 */
		if (hx < 0x3c000000)
			return (one + x);
		return (exp(ln2 * x));
	}

	k = (int)x;
	if (x != (double)k)
		k = (int)((ix < 0)? x - half : x + half);
	return (scalbn(exp(ln2 * (x - (double)k)), k));
}
Esempio n. 18
0
/*
 * Compute the hypotenuse of a right triangle, avoiding intermediate
 * overflow or underflow.
 *
 * (This example ignores the case of one argument having
 * great magnitude and the other small, causing both overflow
 * and underflow!)
 */
double hypotenuse(double sidea, double sideb)
{
#pragma STDC FENV_ACCESS ON
    double sum, scale, ascaled, bscaled, invscale;
    fenv_t fpenv;
    int fpeflags;

    if ( signbit(sidea))  sidea = fabs(sidea);
    if ( signbit(sideb))  sideb = fabs(sideb);

    feholdexcept(&fpenv);        // Save previous environment,
                                 // clear exceptions,
                                 // switch to nonstop processing.
    invscale = 1.0;
    sum = sidea * sidea + sideb * sideb;    // First try whether a^2 + b^2
                                            // causes any exceptions.

    fpeflags = fetestexcept(FE_UNDERFLOW | FE_OVERFLOW);    // Did it?
    if (fpeflags & FE_OVERFLOW && sidea > 1.0 && sideb > 1.0)
    {
        /* a^2 + b^2 caused an overflow. Scale the triangle down. */
        feclearexcept(FE_OVERFLOW);
        scale = scalbn( 1.0, (DBL_MIN_EXP / 2));

        invscale = 1.0 / scale;
        ascaled = scale * sidea;
        bscaled = scale * sideb;
        sum = ascaled * ascaled + bscaled * bscaled;
    }
    else if (fpeflags & FE_UNDERFLOW && sidea < 1.0 && sideb < 1.0)
    {
        /* a^2 + b^2 caused an underflow. Scale the triangle up. */
        feclearexcept(FE_UNDERFLOW);
        scale = scalbn( 1.0, (DBL_MAX_EXP / 2));

        invscale = 1.0 / scale;
        ascaled = scale * sidea;
        bscaled = scale * sideb;
        sum = ascaled * ascaled + bscaled * bscaled;
    }

    feupdateenv(&fpenv);     // restore the caller's environment, and
                             // raise any new exceptions

    /* c = (1/scale) * sqrt((a * scale)^2 + (b * scale)^2): */
    return invscale * sqrt(sum);
}
Esempio n. 19
0
long double scalbnl(long double x, int exp)
{
#if defined(__arm__) || defined(_ARM_)
    return scalbn(x, exp);
#else
#error Not supported on your platform yet
#endif
}
Esempio n. 20
0
double
ldexp(double value, int exp0)
{
	if(!finite(value)||value==0.0) return value;
	value = scalbn(value,exp0);
	/*if(!finite(value)||value==0.0) errno = POK_ERRNO_ERANGE;*/
	return value;
}
Esempio n. 21
0
void
Math_scalbn(void *fp)
{
	F_Math_scalbn *f;

	f = fp;

	*f->ret = scalbn(f->x, f->n);
}
Esempio n. 22
0
double
__ieee754_scalb(double x, double fn)
#endif
{
#ifdef _SCALB_INT
	return scalbn(x,fn);
#else
	if (isnan(x)||isnan(fn)) return x*fn;
	if (!finite(fn)) {
	    if(fn>0.0) return x*fn;
	    else       return x/(-fn);
	}
	if (rint(fn)!=fn) return (fn-fn)/(fn-fn);
	if ( fn > 65000.0) return scalbn(x, 65000);
	if (-fn > 65000.0) return scalbn(x,-65000);
	return scalbn(x,(int)fn);
#endif
}
Esempio n. 23
0
double
SDL_scalbn(double x, int n)
{
#if defined(HAVE_SCALBN)
    return scalbn(x, n);
#else
    return SDL_uclibc_scalbn(x, n);
#endif /* HAVE_SCALBN */
}
Esempio n. 24
0
double exp(double x)
{
	double_t hi, lo, c, xx, y;
	int k, sign;
	uint32_t hx;

	GET_HIGH_WORD(hx, x);
	sign = hx>>31;
	hx &= 0x7fffffff;  /* high word of |x| */

	/* special cases */
	if (hx >= 0x4086232b) {  /* if |x| >= 708.39... */
		if (isnan(x))
			return x;
		if (x > 709.782712893383973096) {
			/* overflow if x!=inf */
			x *= 0x1p1023;
			return x;
		}
		if (x < -708.39641853226410622) {
			/* underflow if x!=-inf */
			FORCE_EVAL((float)(-0x1p-149/x));
			if (x < -745.13321910194110842)
				return 0;
		}
	}

	/* argument reduction */
	if (hx > 0x3fd62e42) {  /* if |x| > 0.5 ln2 */
		if (hx >= 0x3ff0a2b2)  /* if |x| >= 1.5 ln2 */
			k = (int)(invln2*x + half[sign]);
		else
			k = 1 - sign - sign;
		hi = x - k*ln2hi;  /* k*ln2hi is exact here */
		lo = k*ln2lo;
		x = hi - lo;
	} else if (hx > 0x3e300000)  {  /* if |x| > 2**-28 */
		k = 0;
		hi = x;
		lo = 0;
	} else {
		/* inexact if x!=0 */
		FORCE_EVAL(0x1p1023 + x);
		return 1 + x;
	}

	/* x is now in primary range */
	xx = x*x;
	c = x - xx*(__EXP_P1+xx*(__EXP_P2+xx*(__EXP_P3+xx*(__EXP_P4+xx*__EXP_P5))));
	y = 1 + (x*c/(2-c) - lo + hi);
	if (k == 0)
		return y;
	return scalbn(y, k);
}
Esempio n. 25
0
/*++
Function:
    scalbn

See MSDN.
--*/
PALIMPORT double __cdecl PAL_scalbn(double x, int n)
{
    double ret;
    PERF_ENTRY(scalbn);
    ENTRY("scalbn (x=%f, n=%d)\n", x, n);

    ret = scalbn(x, n);

    LOGEXIT("scalbn returns double %f\n", ret);
    PERF_EXIT(scalbn);
    return ret;
}
Esempio n. 26
0
/*
Copied from FDLIBM:

FDLIBM (Freely Distributable LIBM) is a C math library
for machines that support IEEE 754 floating-point arithmetic.
In this release, only double precision is supported.

FDLIBM is intended to provide a reasonably portable (see
assumptions below), reference quality (below one ulp for
major functions like sin,cos,exp,log) math library
(libm.a).  For a copy of FDLIBM, please see
	http://www.netlib.org/fdlibm/
or
	http://www.validlab.com/software/
*/
int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec,
		const int *ipio2) {
	int jz, jx, jv, jp, jk, carry, n, iq[20], i, j, k, m, q0, ih;
	double z, fw, f[20], fq[20], q[20];

	/* initialize jk*/
	jk = init_jk[prec];
	jp = jk;

	/* determine jx,jv,q0, note that 3>q0 */
	jx = nx - 1;
	jv = (e0 - 3) / 24;
	if (jv < 0)
		jv = 0;
	q0 = e0 - 24 * (jv + 1);

	/* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
	j = jv - jx;
	m = jx + jk;
	for (i = 0; i <= m; i++, j++)
		f[i] = (j < 0) ? zero : (double) ipio2[j];

	/* compute q[0],q[1],...q[jk] */
	for (i = 0; i <= jk; i++) {
		for (j = 0, fw = 0.0; j <= jx; j++)
			fw += x[j] * f[jx + i - j];
		q[i] = fw;
	}

	jz = jk;
	recompute:
	/* distill q[] into iq[] reversingly */
	for (i = 0, j = jz, z = q[jz]; j > 0; i++, j--) {
		fw = (double) ((int) (twon24 * z));
		iq[i] = (int) (z - two24 * fw);
		z = q[j - 1] + fw;
	}

	/* compute n */
	z = scalbn(z, q0); /* actual value of z */
	z -= 8.0 * floor(z * 0.125); /* trim off integer >= 8 */
	n = (int) z;
	z -= (double) n;
	ih = 0;
	if (q0 > 0) { /* need iq[jz-1] to determine n */
		i = (iq[jz - 1] >> (24 - q0));
		n += i;
		iq[jz - 1] -= i << (24 - q0);
		ih = iq[jz - 1] >> (23 - q0);
	} else if (q0 == 0)
Esempio n. 27
0
double
scalbln (double x, long n)
{
	int in;

	in = (int)n;
	if (in != n) {
		if (n > 0)
			in = INT_MAX;
		else
			in = INT_MIN;
	}
	return (scalbn(x, in));
}
int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec,
		const s32_t *ipio2)
{
	s32_t jz, jx, jv, jp, jk, carry, n, iq[20], i, j, k, m, q0, ih;
	double z, fw, f[20], fq[20], q[20];

	jk = init_jk[prec];
	jp = jk;

	jx = nx - 1;
	jv = (e0 - 3) / 24;
	if (jv < 0)
		jv = 0;
	q0 = e0 - 24 * (jv + 1);

	j = jv - jx;
	m = jx + jk;
	for (i = 0; i <= m; i++, j++)
		f[i] = (j < 0) ? zero : (double) ipio2[j];

	for (i = 0; i <= jk; i++)
	{
		for (j = 0, fw = 0.0; j <= jx; j++)
			fw += x[j] * f[jx + i - j];
		q[i] = fw;
	}

	jz = jk;
	recompute:

	for (i = 0, j = jz, z = q[jz]; j > 0; i++, j--)
	{
		fw = (double) ((s32_t)(twon24 * z));
		iq[i] = (s32_t)(z - two24 * fw);
		z = q[j - 1] + fw;
	}

	z = scalbn(z, q0);
	z -= 8.0 * floor(z * 0.125);
	n = (s32_t) z;
	z -= (double) n;
	ih = 0;
	if (q0 > 0)
	{
		i = (iq[jz - 1] >> (24 - q0));
		n += i;
		iq[jz - 1] -= i << (24 - q0);
		ih = iq[jz - 1] >> (23 - q0);
	}
Esempio n. 29
0
GFC_REAL_8
spacing_r8 (GFC_REAL_8 s, int p, int emin, GFC_REAL_8 tiny)
{
  int e;
  if (s == 0.)
    return tiny;
  frexp (s, &e);
  e = e - p;
  e = e > emin ? e : emin;
#if defined (HAVE_LDEXP)
  return ldexp (1., e);
#else
  return scalbn (1., e);
#endif
}
Esempio n. 30
0
GFC_REAL_8
rrspacing_r8 (GFC_REAL_8 s, int p)
{
  int e;
  GFC_REAL_8 x;
  x = fabs (s);
  if (x == 0.)
    return 0.;
  frexp (s, &e);
#if defined (HAVE_LDEXP)
  return ldexp (x, p - e);
#else
  return scalbn (x, p - e);
#endif

}