CVS: msp430-libc4/src/libm e_acos.c,NONE,1.1 e_acosf.c,NONE,1.1 e_acosh.c,NONE,1.1 e_acoshf.c,NONE,1.1 e_asin.c,NONE,1.1 e_asinf.c,NONE,1.1 e_atan2.c,NONE,1.1 e_atan2f.c,NONE,1.1 e_atanh.c,NONE,1.1 e_atanhf.c,NONE,1.1 e_cosh.c,NONE,1.1 e_coshf.c,NONE,1.1 e_exp.c,NONE,1.1 e_expf.c,NONE,1.1 e_fmod.c,NONE,1.1 e_fmodf.c,NONE,1.1 e_gamma.c,NONE,1.1 e_gamma_r.c,NONE,1.1 e_gammaf.c,NONE,1.1 e_gammaf_r.c,NONE,1.1 e_hypot.c,NONE,1.1 e_hypotf.c,NONE,1.1 e_j0.c,NONE,1.1 e_j0f.c,NONE,1.1 e_j1.c,NONE,1.1 e_j1f.c,NONE,1.1 e_jn.c,NONE,1.1 e_jnf.c,NONE,1.1 e_lgamma.c,NONE,1.1 e_lgamma_r.c,NONE,1.1 e_lgammaf.c,NONE,1.1 e_lgammaf_r.c,NONE,1.1 e_log.c,NONE,1.1 e_log10.c,NONE,1.1 e_log10f.c,NONE,1.1 e_logf.c,NONE,1.1 e_pow.c,NONE,1.1 e_powf.c,NONE,1.1 e_rem_pio2.c,NONE,1.1 e_rem_pio2f.c,NONE,1.1 e_remainder.c,NONE,1.1 e_remainderf.c,NONE,1.1 e_scalb.c,NONE,1.1 e_scalbf.c,NONE,1.1 e _sinh.c,NONE,1.
Dmitry Diky <[email protected]>
| Newsgroups | gmane.comp.hardware.texas-instruments.msp430.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/mspgcc/msp430-libc4/src/libm In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19837/src/libm Added Files: e_acos.c e_acosf.c e_acosh.c e_acoshf.c e_asin.c e_asinf.c e_atan2.c e_atan2f.c e_atanh.c e_atanhf.c e_cosh.c e_coshf.c e_exp.c e_expf.c e_fmod.c e_fmodf.c e_gamma.c e_gamma_r.c e_gammaf.c e_gammaf_r.c e_hypot.c e_hypotf.c e_j0.c e_j0f.c e_j1.c e_j1f.c e_jn.c e_jnf.c e_lgamma.c e_lgamma_r.c e_lgammaf.c e_lgammaf_r.c e_log.c e_log10.c e_log10f.c e_logf.c e_pow.c e_powf.c e_rem_pio2.c e_rem_pio2f.c e_remainder.c e_remainderf.c e_scalb.c e_scalbf.c e_sinh.c e_sinhf.c e_sqrt.c e_sqrt.o e_sqrtf.c k_cos.c k_cosf.c k_cosf.o k_rem_pio2.c k_rem_pio2f.c k_sin.c k_sinf.c k_standard.c k_tan.c k_tanf.c s_asinh.c s_asinhf.c s_atan.c s_atanf.c s_cbrt.c s_cbrtf.c s_ceil.c s_ceilf.c s_copysign.c s_copysignf.c s_cos.c s_cosf.c s_erf.c s_erff.c s_expm1.c s_expm1f.c s_fabs.c s_fabsf.c s_fabsl.c s_finite.c s_finitef.c s_floor.c s_floorf.c s_frexp.c s_frexpf.c s_ilogb.c s_ilogbf.c s_isnan.c s_isnanf.c s_ldexp.c s_ldexpf.c s_ldexpf.o s_lib_version.c s_log1p.c s_log1pf.c s_logb.c s_logbf.c s_matherr.c s_modf.c s_modff.c s_nextafter.c s_nextafterf.c s_rint.c s_rintf.c s_scalbn.c s_scalbnf.c s_signgam.c s_significand.c s_significandf.c s_sin.c s_sinf.c s_tan.c s_tanf.c s_tanh.c s_tanhf.c w_acos.c w_acosf.c w_acosh.c w_acoshf.c w_asin.c w_asinf.c w_atan2.c w_atan2f.c w_atanh.c w_atanhf.c w_atanhf.o w_cabs.c w_cabsf.c w_cosh.c w_coshf.c w_drem.c w_dremf.c w_exp.c w_expf.c w_fmod.c w_fmodf.c w_gamma.c w_gamma_r.c w_gammaf.c w_gammaf_r.c w_hypot.c w_hypotf.c w_j0.c w_j0f.c w_j1.c w_j1f.c w_jn.c w_jnf.c w_lgamma.c w_lgamma_r.c w_lgammaf.c w_lgammaf_r.c w_log.c w_log10.c w_log10f.c w_logf.c w_pow.c w_powf.c w_remainder.c w_remainderf.c w_scalb.c w_scalbf.c w_sinh.c w_sinhf.c w_sqrt.c w_sqrtf.c w_y0.c w_y0f.c w_y1.c w_y1f.c w_yn.c w_ynf.c Log Message: 2005-08-31 Dmitry Diky <[email protected]> * include/math.h: Replaced with the new one from BSD * include/math_private.h: New file * src/libm/*: Completely replaced with BSD's one. --- NEW FILE: e_acos.c --- /* @(#)e_acos.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_acos.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_acos(x) * Method : * acos(x) = pi/2 - asin(x) * acos(-x) = pi/2 + asin(x) * For |x|<=0.5 * acos(x) = pi/2 - (x + x*x^2*R(x^2)) (see asin.c) * For x>0.5 * acos(x) = pi/2 - (pi/2 - 2asin(sqrt((1-x)/2))) * = 2asin(sqrt((1-x)/2)) * = 2s + 2s*z*R(z) ...z=(1-x)/2, s=sqrt(z) * = 2f + (2c + 2s*z*R(z)) * where f=hi part of s, and c = (z-f*f)/(s+f) is the correction term * for f so that f+c ~ sqrt(z). * For x<-0.5 * acos(x) = pi - 2asin(sqrt((1-|x|)/2)) * = pi - 0.5*(s+s*z*R(z)), where z=(1-|x|)/2,s=sqrt(z) * * Special cases: * if x is NaN, return x itself; * if |x|>1, return NaN with invalid signal. * * Function needed: __ieee754_sqrt */ #include "math.h" #include "math_private.h" static const double one= 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */ pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */ pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */ pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */ pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */ pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */ pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */ pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */ pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */ qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */ qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */ qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */ qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */ double __ieee754_acos(double x) { double z,p,q,r,w,s,c,df; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x3ff00000) { /* |x| >= 1 */ u_int32_t lx; GET_LOW_WORD(lx,x); if(((ix-0x3ff00000)|lx)==0) { /* |x|==1 */ if(hx>0) return 0.0; /* acos(1) = 0 */ else return pi+2.0*pio2_lo; /* acos(-1)= pi */ } return (x-x)/(x-x); /* acos(|x|>1) is NaN */ } if(ix<0x3fe00000) { /* |x| < 0.5 */ if(ix<=0x3c600000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/ z = x*x; p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); r = p/q; return pio2_hi - (x - (pio2_lo-x*r)); } else if (hx<0) { /* x < -0.5 */ z = (one+x)*0.5; p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); s = __ieee754_sqrt(z); r = p/q; w = r*s-pio2_lo; return pi - 2.0*(s+w); } else { /* x > 0.5 */ z = (one-x)*0.5; s = __ieee754_sqrt(z); df = s; SET_LOW_WORD(df,0); c = (z-df*df)/(s+df); p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); r = p/q; w = r*s+c; return 2.0*(df+w); } } --- NEW FILE: e_acosf.c --- /* e_acosf.c -- float version of e_acos.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_acosf.c,v 1.7 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3F800000 */ pi = 3.1415925026e+00, /* 0x40490fda */ pio2_hi = 1.5707962513e+00, /* 0x3fc90fda */ pio2_lo = 7.5497894159e-08, /* 0x33a22168 */ pS0 = 1.6666667163e-01, /* 0x3e2aaaab */ pS1 = -3.2556581497e-01, /* 0xbea6b090 */ pS2 = 2.0121252537e-01, /* 0x3e4e0aa8 */ pS3 = -4.0055535734e-02, /* 0xbd241146 */ pS4 = 7.9153501429e-04, /* 0x3a4f7f04 */ pS5 = 3.4793309169e-05, /* 0x3811ef08 */ qS1 = -2.4033949375e+00, /* 0xc019d139 */ qS2 = 2.0209457874e+00, /* 0x4001572d */ qS3 = -6.8828397989e-01, /* 0xbf303361 */ qS4 = 7.7038154006e-02; /* 0x3d9dc62e */ float __ieee754_acosf(float x) { float z,p,q,r,w,s,c,df; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix==0x3f800000) { /* |x|==1 */ if(hx>0) return 0.0; /* acos(1) = 0 */ else return pi+(float)2.0*pio2_lo; /* acos(-1)= pi */ } else if(ix>0x3f800000) { /* |x| >= 1 */ return (x-x)/(x-x); /* acos(|x|>1) is NaN */ } if(ix<0x3f000000) { /* |x| < 0.5 */ if(ix<=0x23000000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/ z = x*x; p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); r = p/q; return pio2_hi - (x - (pio2_lo-x*r)); } else if (hx<0) { /* x < -0.5 */ z = (one+x)*(float)0.5; p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); s = __ieee754_sqrtf(z); r = p/q; w = r*s-pio2_lo; return pi - (float)2.0*(s+w); } else { /* x > 0.5 */ int32_t idf; z = (one-x)*(float)0.5; s = __ieee754_sqrtf(z); df = s; GET_FLOAT_WORD(idf,df); SET_FLOAT_WORD(df,idf&0xfffff000); c = (z-df*df)/(s+df); p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5))))); q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4))); r = p/q; w = r*s+c; return (float)2.0*(df+w); } } --- NEW FILE: e_acosh.c --- /* @(#)e_acosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_acosh.c,v 1.7 2002/05/28 17:03:12 alfred Exp $"; #endif /* __ieee754_acosh(x) * Method : * Based on * acosh(x) = log [ x + sqrt(x*x-1) ] * we have * acosh(x) := log(x)+ln2, if x is large; else * acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else * acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1. * * Special cases: * acosh(x) is NaN with signal if x<1. * acosh(NaN) is NaN without signal. */ #include "math.h" #include "math_private.h" static const double one = 1.0, ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */ double __ieee754_acosh(double x) { double t; int32_t hx; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); if(hx<0x3ff00000) { /* x < 1 */ return (x-x)/(x-x); } else if(hx >=0x41b00000) { /* x > 2**28 */ if(hx >=0x7ff00000) { /* x is inf of NaN */ return x+x; } else return __ieee754_log(x)+ln2; /* acosh(huge)=log(2x) */ } else if(((hx-0x3ff00000)|lx)==0) { return 0.0; /* acosh(1) = 0 */ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */ t=x*x; return __ieee754_log(2.0*x-one/(x+__ieee754_sqrt(t-one))); } else { /* 1<x<2 */ t = x-one; return log1p(t+__ieee754_sqrt(2.0*t+t*t)); } } --- NEW FILE: e_acoshf.c --- /* e_acoshf.c -- float version of e_acosh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_acoshf.c,v 1.7 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, ln2 = 6.9314718246e-01; /* 0x3f317218 */ float __ieee754_acoshf(float x) { float t; int32_t hx; GET_FLOAT_WORD(hx,x); if(hx<0x3f800000) { /* x < 1 */ return (x-x)/(x-x); } else if(hx >=0x4d800000) { /* x > 2**28 */ if(hx >=0x7f800000) { /* x is inf of NaN */ return x+x; } else return __ieee754_logf(x)+ln2; /* acosh(huge)=log(2x) */ } else if (hx==0x3f800000) { return 0.0; /* acosh(1) = 0 */ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */ t=x*x; return __ieee754_logf((float)2.0*x-one/(x+__ieee754_sqrtf(t-one))); } else { /* 1<x<2 */ t = x-one; return log1pf(t+__ieee754_sqrtf((float)2.0*t+t*t)); } } --- NEW FILE: e_asin.c --- /* @(#)e_asin.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_asin.c,v 1.10 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_asin(x) * Method : * Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ... * we approximate asin(x) on [0,0.5] by * asin(x) = x + x*x^2*R(x^2) * where * R(x^2) is a rational approximation of (asin(x)-x)/x^3 * and its remez error is bounded by * |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75) * * For x in [0.5,1] * asin(x) = pi/2-2*asin(sqrt((1-x)/2)) * Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2; * then for x>0.98 * asin(x) = pi/2 - 2*(s+s*z*R(z)) * = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo) * For x<=0.98, let pio4_hi = pio2_hi/2, then * f = hi part of s; * c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z) * and * asin(x) = pi/2 - 2*(s+s*z*R(z)) * = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo) * = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c)) * * Special cases: * if x is NaN, return x itself; * if |x|>1, return NaN with invalid signal. * */ #include "math.h" #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ huge = 1.000e+300, pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */ pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */ pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */ /* coefficient for R(x^2) */ pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */ pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */ pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */ pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */ pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */ pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */ qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */ qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */ qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */ qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */ double __ieee754_asin(double x) { double t=0.0,w,p,q,c,r,s; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>= 0x3ff00000) { /* |x|>= 1 */ u_int32_t lx; GET_LOW_WORD(lx,x); if(((ix-0x3ff00000)|lx)==0) /* asin(1)=+-pi/2 with inexact */ return x*pio2_hi+x*pio2_lo; return (x-x)/(x-x); /* asin(|x|>1) is NaN */ } else if (ix<0x3fe00000) { /* |x|<0.5 */ if(ix<0x3e400000) { /* if |x| < 2**-27 */ if(huge+x>one) return x;/* return x with inexact if x!=0*/ } else t = x*x; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5))))); q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4))); w = p/q; return x+x*w; } /* 1> |x|>= 0.5 */ w = one-fabs(x); t = w*0.5; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5))))); q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4))); s = __ieee754_sqrt(t); if(ix>=0x3FEF3333) { /* if |x| > 0.975 */ w = p/q; t = pio2_hi-(2.0*(s+s*w)-pio2_lo); } else { w = s; SET_LOW_WORD(w,0); c = (t-w*w)/(s+w); r = p/q; p = 2.0*s*r-(pio2_lo-2.0*c); q = pio4_hi-2.0*w; t = pio4_hi-(p-q); } if(hx>0) return t; else return -t; } --- NEW FILE: e_asinf.c --- /* e_asinf.c -- float version of e_asin.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_asinf.c,v 1.8 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3F800000 */ huge = 1.000e+30, pio2_hi = 1.5707962513e+00, /* 0x3fc90fda */ pio2_lo = 7.5497894159e-08, /* 0x33a22168 */ pio4_hi = 7.8539818525e-01, /* 0x3f490fdb */ /* coefficient for R(x^2) */ pS0 = 1.6666667163e-01, /* 0x3e2aaaab */ pS1 = -3.2556581497e-01, /* 0xbea6b090 */ pS2 = 2.0121252537e-01, /* 0x3e4e0aa8 */ pS3 = -4.0055535734e-02, /* 0xbd241146 */ pS4 = 7.9153501429e-04, /* 0x3a4f7f04 */ pS5 = 3.4793309169e-05, /* 0x3811ef08 */ qS1 = -2.4033949375e+00, /* 0xc019d139 */ qS2 = 2.0209457874e+00, /* 0x4001572d */ qS3 = -6.8828397989e-01, /* 0xbf303361 */ qS4 = 7.7038154006e-02; /* 0x3d9dc62e */ float __ieee754_asinf(float x) { float t=0.0,w,p,q,c,r,s; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix==0x3f800000) { /* asin(1)=+-pi/2 with inexact */ return x*pio2_hi+x*pio2_lo; } else if(ix> 0x3f800000) { /* |x|>= 1 */ return (x-x)/(x-x); /* asin(|x|>1) is NaN */ } else if (ix<0x3f000000) { /* |x|<0.5 */ if(ix<0x32000000) { /* if |x| < 2**-27 */ if(huge+x>one) return x;/* return x with inexact if x!=0*/ } else t = x*x; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5))))); q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4))); w = p/q; return x+x*w; } /* 1> |x|>= 0.5 */ w = one-fabsf(x); t = w*(float)0.5; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5))))); q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4))); s = __ieee754_sqrtf(t); if(ix>=0x3F79999A) { /* if |x| > 0.975 */ w = p/q; t = pio2_hi-((float)2.0*(s+s*w)-pio2_lo); } else { int32_t iw; w = s; GET_FLOAT_WORD(iw,w); SET_FLOAT_WORD(w,iw&0xfffff000); c = (t-w*w)/(s+w); r = p/q; p = (float)2.0*s*r-(pio2_lo-(float)2.0*c); q = pio4_hi-(float)2.0*w; t = pio4_hi-(p-q); } if(hx>0) return t; else return -t; } --- NEW FILE: e_atan2.c --- /* @(#)e_atan2.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_atan2.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_atan2(y,x) * Method : * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x). * 2. Reduce x to positive by (if x and y are unexceptional): * ARG (x+iy) = arctan(y/x) ... if x > 0, * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0, * * Special cases: * * ATAN2((anything), NaN ) is NaN; * ATAN2(NAN , (anything) ) is NaN; * ATAN2(+-0, +(anything but NaN)) is +-0 ; * ATAN2(+-0, -(anything but NaN)) is +-pi ; * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2; * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ; * ATAN2(+-(anything but INF and NaN), -INF) is +-pi; * ATAN2(+-INF,+INF ) is +-pi/4 ; * ATAN2(+-INF,-INF ) is +-3pi/4; * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2; * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const double tiny = 1.0e-300, zero = 0.0, pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */ pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */ pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */ pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */ double __ieee754_atan2(double y, double x) { double z; int32_t k,m,hx,hy,ix,iy; u_int32_t lx,ly; EXTRACT_WORDS(hx,lx,x); ix = hx&0x7fffffff; EXTRACT_WORDS(hy,ly,y); iy = hy&0x7fffffff; if(((ix|((lx|-lx)>>31))>0x7ff00000)|| ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */ return x+y; if(((hx-0x3ff00000)|lx)==0) return atan(y); /* x=1.0 */ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ if((iy|ly)==0) { switch(m) { case 0: case 1: return y; /* atan(+-0,+anything)=+-0 */ case 2: return pi+tiny;/* atan(+0,-anything) = pi */ case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ } } /* when x = 0 */ if((ix|lx)==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* when x is INF */ if(ix==0x7ff00000) { if(iy==0x7ff00000) { switch(m) { case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */ case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */ case 2: return 3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/ case 3: return -3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/ } } else { switch(m) { case 0: return zero ; /* atan(+...,+INF) */ case 1: return -zero ; /* atan(-...,+INF) */ case 2: return pi+tiny ; /* atan(+...,-INF) */ case 3: return -pi-tiny ; /* atan(-...,-INF) */ } } } /* when y is INF */ if(iy==0x7ff00000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* compute y/x */ k = (iy-ix)>>20; if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */ else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */ else z=atan(fabs(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: { u_int32_t zh; GET_HIGH_WORD(zh,z); SET_HIGH_WORD(z,zh ^ 0x80000000); } return z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ return (z-pi_lo)-pi;/* atan(-,-) */ } } --- NEW FILE: e_atan2f.c --- /* e_atan2f.c -- float version of e_atan2.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_atan2f.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float tiny = 1.0e-30, zero = 0.0, pi_o_4 = 7.8539818525e-01, /* 0x3f490fdb */ pi_o_2 = 1.5707963705e+00, /* 0x3fc90fdb */ pi = 3.1415925026e+00, /* 0x40490fda */ pi_lo = 1.5099578832e-07; /* 0x34222168 */ float __ieee754_atan2f(float y, float x) { float z; int32_t k,m,hx,hy,ix,iy; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; GET_FLOAT_WORD(hy,y); iy = hy&0x7fffffff; if((ix>0x7f800000)|| (iy>0x7f800000)) /* x or y is NaN */ return x+y; if(hx==0x3f800000) return atanf(y); /* x=1.0 */ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */ /* when y = 0 */ if(iy==0) { switch(m) { case 0: case 1: return y; /* atan(+-0,+anything)=+-0 */ case 2: return pi+tiny;/* atan(+0,-anything) = pi */ case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */ } } /* when x = 0 */ if(ix==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* when x is INF */ if(ix==0x7f800000) { if(iy==0x7f800000) { switch(m) { case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */ case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */ case 2: return (float)3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/ case 3: return (float)-3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/ } } else { switch(m) { case 0: return zero ; /* atan(+...,+INF) */ case 1: return -zero ; /* atan(-...,+INF) */ case 2: return pi+tiny ; /* atan(+...,-INF) */ case 3: return -pi-tiny ; /* atan(-...,-INF) */ } } } /* when y is INF */ if(iy==0x7f800000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny; /* compute y/x */ k = (iy-ix)>>23; if(k > 60) z=pi_o_2+(float)0.5*pi_lo; /* |y/x| > 2**60 */ else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */ else z=atanf(fabsf(y/x)); /* safe to do y/x */ switch (m) { case 0: return z ; /* atan(+,+) */ case 1: { u_int32_t zh; GET_FLOAT_WORD(zh,z); SET_FLOAT_WORD(z,zh ^ 0x80000000); } return z ; /* atan(-,+) */ case 2: return pi-(z-pi_lo);/* atan(+,-) */ default: /* case 3 */ return (z-pi_lo)-pi;/* atan(-,-) */ } } --- NEW FILE: e_atanh.c --- /* @(#)e_atanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_atanh.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif /* __ieee754_atanh(x) * Method : * 1.Reduced x to positive by atanh(-x) = -atanh(x) * 2.For x>=0.5 * 1 2x x * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) * 2 1 - x 1 - x * * For x<0.5 * atanh(x) = 0.5*log1p(2x+2x*x/(1-x)) * * Special cases: * atanh(x) is NaN if |x| > 1 with signal; * atanh(NaN) is that NaN with no signal; * atanh(+-1) is +-INF with signal. * */ #include "math.h" #include "math_private.h" static const double one = 1.0, huge = 1e300; static const double zero = 0.0; double __ieee754_atanh(double x) { double t; int32_t hx,ix; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); ix = hx&0x7fffffff; if ((ix|((lx|(-lx))>>31))>0x3ff00000) /* |x|>1 */ return (x-x)/(x-x); if(ix==0x3ff00000) return x/zero; if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */ SET_HIGH_WORD(x,ix); if(ix<0x3fe00000) { /* x < 0.5 */ t = x+x; t = 0.5*log1p(t+t*x/(one-x)); } else t = 0.5*log1p((x+x)/(one-x)); if(hx>=0) return t; else return -t; } --- NEW FILE: e_atanhf.c --- /* e_atanhf.c -- float version of e_atanh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_atanhf.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, huge = 1e30; static const float zero = 0.0; float __ieee754_atanhf(float x) { float t; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if (ix>0x3f800000) /* |x|>1 */ return (x-x)/(x-x); if(ix==0x3f800000) return x/zero; if(ix<0x31800000&&(huge+x)>zero) return x; /* x<2**-28 */ SET_FLOAT_WORD(x,ix); if(ix<0x3f000000) { /* x < 0.5 */ t = x+x; t = (float)0.5*log1pf(t+t*x/(one-x)); } else t = (float)0.5*log1pf((x+x)/(one-x)); if(hx>=0) return t; else return -t; } --- NEW FILE: e_cosh.c --- /* @(#)e_cosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_cosh.c,v 1.7 2002/05/28 17:03:12 alfred Exp $"; #endif /* __ieee754_cosh(x) * Method : * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2 * 1. Replace x by |x| (cosh(x) = cosh(-x)). * 2. * [ exp(x) - 1 ]^2 * 0 <= x <= ln2/2 : cosh(x) := 1 + ------------------- * 2*exp(x) * * exp(x) + 1/exp(x) * ln2/2 <= x <= 22 : cosh(x) := ------------------- * 2 * 22 <= x <= lnovft : cosh(x) := exp(x)/2 * lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2) * ln2ovft < x : cosh(x) := huge*huge (overflow) * * Special cases: * cosh(x) is |x| if x is +INF, -INF, or NaN. * only cosh(0)=1 is exact for finite x. */ #include "math.h" #include "math_private.h" static const double one = 1.0, half=0.5, huge = 1.0e300; double __ieee754_cosh(double x) { double t,w; int32_t ix; u_int32_t lx; /* High word of |x|. */ GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; /* x is INF or NaN */ if(ix>=0x7ff00000) return x*x; /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */ if(ix<0x3fd62e43) { t = expm1(fabs(x)); w = one+t; if (ix<0x3c800000) return w; /* cosh(tiny) = 1 */ return one+(t*t)/(w+w); } /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ if (ix < 0x40360000) { t = __ieee754_exp(fabs(x)); return half*t+half/t; } /* |x| in [22, log(maxdouble)] return half*exp(|x|) */ if (ix < 0x40862E42) return half*__ieee754_exp(fabs(x)); /* |x| in [log(maxdouble), overflowthresold] */ GET_LOW_WORD(lx,x); if (ix<0x408633CE || ((ix==0x408633ce)&&(lx<=(u_int32_t)0x8fb9f87d))) { w = __ieee754_exp(half*fabs(x)); t = half*w; return t*w; } /* |x| > overflowthresold, cosh(x) overflow */ return huge*huge; } --- NEW FILE: e_coshf.c --- /* e_coshf.c -- float version of e_cosh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_coshf.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, half=0.5, huge = 1.0e30; float __ieee754_coshf(float x) { float t,w; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; /* x is INF or NaN */ if(ix>=0x7f800000) return x*x; /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */ if(ix<0x3eb17218) { t = expm1f(fabsf(x)); w = one+t; if (ix<0x24000000) return w; /* cosh(tiny) = 1 */ return one+(t*t)/(w+w); } /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ if (ix < 0x41b00000) { t = __ieee754_expf(fabsf(x)); return half*t+half/t; } /* |x| in [22, log(maxdouble)] return half*exp(|x|) */ if (ix < 0x42b17180) return half*__ieee754_expf(fabsf(x)); /* |x| in [log(maxdouble), overflowthresold] */ if (ix<=0x42b2d4fc) { w = __ieee754_expf(half*fabsf(x)); t = half*w; return t*w; } /* |x| > overflowthresold, cosh(x) overflow */ return huge*huge; } --- NEW FILE: e_exp.c --- /* @(#)e_exp.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_exp.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_exp(x) * Returns the exponential of x. * * Method * 1. Argument reduction: * Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658. * Given x, find r and integer k such that * * x = k*ln2 + r, |r| <= 0.5*ln2. * * Here r will be represented as r = hi-lo for better * accuracy. * * 2. Approximation of exp(r) by a special rational function on * the interval [0,0.34658]: * Write * R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ... * We use a special Reme algorithm on [0,0.34658] to generate * a polynomial of degree 5 to approximate R. The maximum error * of this polynomial approximation is bounded by 2**-59. In * other words, * R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5 * (where z=r*r, and the values of P1 to P5 are listed below) * and * | 5 | -59 * | 2.0+P1*z+...+P5*z - R(z) | <= 2 * | | * The computation of exp(r) thus becomes * 2*r * exp(r) = 1 + ------- * R - r * r*R1(r) * = 1 + r + ----------- (for better accuracy) * 2 - R1(r) * where * 2 4 10 * R1(r) = r - (P1*r + P2*r + ... + P5*r ). * * 3. Scale back to obtain exp(x): * From step 1, we have * exp(x) = 2^k * exp(r) * * Special cases: * exp(INF) is INF, exp(NaN) is NaN; * exp(-INF) is 0, and * for finite argument, only exp(0)=1 is exact. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Misc. info. * For IEEE double * if x > 7.09782712893383973096e+02 then exp(x) overflow * if x < -7.45133219101941108420e+02 then exp(x) underflow * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const double one = 1.0, halF[2] = {0.5,-0.5,}, huge = 1.0e+300, twom1000= 9.33263618503218878990e-302, /* 2**-1000=0x01700000,0*/ o_threshold= 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */ u_threshold= -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */ ln2HI[2] ={ 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */ -6.93147180369123816490e-01,},/* 0xbfe62e42, 0xfee00000 */ ln2LO[2] ={ 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */ -1.90821492927058770002e-10,},/* 0xbdea39ef, 0x35793c76 */ invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */ P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */ P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */ P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */ P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ double __ieee754_exp(double x) /* default IEEE double exp */ { double y,hi=0.0,lo=0.0,c,t; int32_t k=0,xsb; u_int32_t hx; GET_HIGH_WORD(hx,x); xsb = (hx>>31)&1; /* sign bit of x */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out non-finite argument */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { u_int32_t lx; GET_LOW_WORD(lx,x); if(((hx&0xfffff)|lx)!=0) return x+x; /* NaN */ else return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */ } if(x > o_threshold) return huge*huge; /* overflow */ if(x < u_threshold) return twom1000*twom1000; /* underflow */ } /* argument reduction */ if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */ if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */ hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb; } else { k = invln2*x+halF[xsb]; t = k; hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */ lo = t*ln2LO[0]; } x = hi - lo; } else if(hx < 0x3e300000) { /* when |x|<2**-28 */ if(huge+x>one) return one+x;/* trigger inexact */ } else k = 0; /* x is now in primary range */ t = x*x; c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); if(k==0) return one-((x*c)/(c-2.0)-x); else y = one-((lo-(x*c)/(2.0-c))-hi); if(k >= -1021) { u_int32_t hy; GET_HIGH_WORD(hy,y); SET_HIGH_WORD(y,hy+(k<<20)); /* add k to y's exponent */ return y; } else { u_int32_t hy; GET_HIGH_WORD(hy,y); SET_HIGH_WORD(y,hy+((k+1000)<<20)); /* add k to y's exponent */ return y*twom1000; } } --- NEW FILE: e_expf.c --- /* e_expf.c -- float version of e_exp.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_expf.c,v 1.7 2002/05/28 17:03:12 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, halF[2] = {0.5,-0.5,}, huge = 1.0e+30, twom100 = 7.8886090522e-31, /* 2**-100=0x0d800000 */ o_threshold= 8.8721679688e+01, /* 0x42b17180 */ u_threshold= -1.0397208405e+02, /* 0xc2cff1b5 */ ln2HI[2] ={ 6.9313812256e-01, /* 0x3f317180 */ -6.9313812256e-01,}, /* 0xbf317180 */ ln2LO[2] ={ 9.0580006145e-06, /* 0x3717f7d1 */ -9.0580006145e-06,}, /* 0xb717f7d1 */ invln2 = 1.4426950216e+00, /* 0x3fb8aa3b */ P1 = 1.6666667163e-01, /* 0x3e2aaaab */ P2 = -2.7777778450e-03, /* 0xbb360b61 */ P3 = 6.6137559770e-05, /* 0x388ab355 */ P4 = -1.6533901999e-06, /* 0xb5ddea0e */ P5 = 4.1381369442e-08; /* 0x3331bb4c */ float __ieee754_expf(float x) /* default IEEE double exp */ { float y,hi=0.0,lo=0.0,c,t; int32_t k=0,xsb; u_int32_t hx; GET_FLOAT_WORD(hx,x); xsb = (hx>>31)&1; /* sign bit of x */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out non-finite argument */ if(hx >= 0x42b17218) { /* if |x|>=88.721... */ if(hx>0x7f800000) return x+x; /* NaN */ if(hx==0x7f800000) return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */ if(x > o_threshold) return huge*huge; /* overflow */ if(x < u_threshold) return twom100*twom100; /* underflow */ } /* argument reduction */ if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */ if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */ hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb; } else { k = invln2*x+halF[xsb]; t = k; hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */ lo = t*ln2LO[0]; } x = hi - lo; } else if(hx < 0x31800000) { /* when |x|<2**-28 */ if(huge+x>one) return one+x;/* trigger inexact */ } else k = 0; /* x is now in primary range */ t = x*x; c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); if(k==0) return one-((x*c)/(c-(float)2.0)-x); else y = one-((lo-(x*c)/((float)2.0-c))-hi); if(k >= -125) { u_int32_t hy; GET_FLOAT_WORD(hy,y); SET_FLOAT_WORD(y,hy+(k<<23)); /* add k to y's exponent */ return y; } else { u_int32_t hy; GET_FLOAT_WORD(hy,y); SET_FLOAT_WORD(y,hy+((k+100)<<23)); /* add k to y's exponent */ return y*twom100; } } --- NEW FILE: e_fmod.c --- /* @(#)e_fmod.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_fmod.c,v 1.8 2003/07/23 04:53:46 peter Exp $"; #endif /* * __ieee754_fmod(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract */ #include "math.h" #include "math_private.h" static const double one = 1.0, Zero[] = {0.0, -0.0,}; double __ieee754_fmod(double x, double y) { int32_t n,hx,hy,hz,ix,iy,sx,i; u_int32_t lx,ly,lz; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); sx = hx&0x80000000; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffff; /* |y| */ /* purge off exception values */ if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */ ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */ return (x*y)/(x*y); if(hx<=hy) { if((hx<hy)||(lx<ly)) return x; /* |x|<|y| return x */ if(lx==ly) return Zero[(u_int32_t)sx>>31]; /* |x|=|y| return x*0*/ } /* determine ix = ilogb(x) */ if(hx<0x00100000) { /* subnormal x */ if(hx==0) { for (ix = -1043, i=lx; i>0; i<<=1) ix -=1; } else { for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1; } } else ix = (hx>>20)-1023; /* determine iy = ilogb(y) */ if(hy<0x00100000) { /* subnormal y */ if(hy==0) { for (iy = -1043, i=ly; i>0; i<<=1) iy -=1; } else { for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1; } } else iy = (hy>>20)-1023; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -1022) hx = 0x00100000|(0x000fffff&hx); else { /* subnormal x, shift x to normal */ n = -1022-ix; if(n<=31) { hx = (hx<<n)|(lx>>(32-n)); lx <<= n; } else { hx = lx<<(n-32); lx = 0; } } if(iy >= -1022) hy = 0x00100000|(0x000fffff&hy); else { /* subnormal y, shift y to normal */ n = -1022-iy; if(n<=31) { hy = (hy<<n)|(ly>>(32-n)); ly <<= n; } else { hy = ly<<(n-32); ly = 0; } } /* fix point fmod */ n = ix - iy; while(n--) { hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; if(hz<0){hx = hx+hx+(lx>>31); lx = lx+lx;} else { if((hz|lz)==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; hx = hz+hz+(lz>>31); lx = lz+lz; } } hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; if(hz>=0) {hx=hz;lx=lz;} /* convert back to floating value and restore the sign */ if((hx|lx)==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; while(hx<0x00100000) { /* normalize x */ hx = hx+hx+(lx>>31); lx = lx+lx; iy -= 1; } if(iy>= -1022) { /* normalize output */ hx = ((hx-0x00100000)|((iy+1023)<<20)); INSERT_WORDS(x,hx|sx,lx); } else { /* subnormal output */ n = -1022 - iy; if(n<=20) { lx = (lx>>n)|((u_int32_t)hx<<(32-n)); hx >>= n; } else if (n<=31) { lx = (hx<<(32-n))|(lx>>n); hx = sx; } else { lx = hx>>(n-32); hx = sx; } INSERT_WORDS(x,hx|sx,lx); x *= one; /* create necessary signal */ } return x; /* exact output */ } --- NEW FILE: e_fmodf.c --- /* e_fmodf.c -- float version of e_fmod.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_fmodf.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif /* * __ieee754_fmodf(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract */ #include "math.h" #include "math_private.h" static const float one = 1.0, Zero[] = {0.0, -0.0,}; float __ieee754_fmodf(float x, float y) { int32_t n,hx,hy,hz,ix,iy,sx,i; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); sx = hx&0x80000000; /* sign of x */ hx ^=sx; /* |x| */ hy &= 0x7fffffff; /* |y| */ /* purge off exception values */ if(hy==0||(hx>=0x7f800000)|| /* y=0,or x not finite */ (hy>0x7f800000)) /* or y is NaN */ return (x*y)/(x*y); if(hx<hy) return x; /* |x|<|y| return x */ if(hx==hy) return Zero[(u_int32_t)sx>>31]; /* |x|=|y| return x*0*/ /* determine ix = ilogb(x) */ if(hx<0x00800000) { /* subnormal x */ for (ix = -126,i=(hx<<8); i>0; i<<=1) ix -=1; } else ix = (hx>>23)-127; /* determine iy = ilogb(y) */ if(hy<0x00800000) { /* subnormal y */ for (iy = -126,i=(hy<<8); i>=0; i<<=1) iy -=1; } else iy = (hy>>23)-127; /* set up {hx,lx}, {hy,ly} and align y to x */ if(ix >= -126) hx = 0x00800000|(0x007fffff&hx); else { /* subnormal x, shift x to normal */ n = -126-ix; hx = hx<<n; } if(iy >= -126) hy = 0x00800000|(0x007fffff&hy); else { /* subnormal y, shift y to normal */ n = -126-iy; hy = hy<<n; } /* fix point fmod */ n = ix - iy; while(n--) { hz=hx-hy; if(hz<0){hx = hx+hx;} else { if(hz==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; hx = hz+hz; } } hz=hx-hy; if(hz>=0) {hx=hz;} /* convert back to floating value and restore the sign */ if(hx==0) /* return sign(x)*0 */ return Zero[(u_int32_t)sx>>31]; while(hx<0x00800000) { /* normalize x */ hx = hx+hx; iy -= 1; } if(iy>= -126) { /* normalize output */ hx = ((hx-0x00800000)|((iy+127)<<23)); SET_FLOAT_WORD(x,hx|sx); } else { /* subnormal output */ n = -126 - iy; hx >>= n; SET_FLOAT_WORD(x,hx|sx); x *= one; /* create necessary signal */ } return x; /* exact output */ } --- NEW FILE: e_gamma.c --- /* @(#)e_gamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_gamma.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif /* __ieee754_gamma(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_gamma_r */ #include "math.h" #include "math_private.h" extern int signgam; double __ieee754_gamma(double x) { return __ieee754_gamma_r(x,&signgam); } --- NEW FILE: e_gamma_r.c --- /* @(#)er_gamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_gamma_r.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif /* __ieee754_gamma_r(x, signgamp) * Reentrant version of the logarithm of the Gamma function * with user provide pointer for the sign of Gamma(x). * * Method: See __ieee754_lgamma_r */ #include "math.h" #include "math_private.h" double __ieee754_gamma_r(double x, int *signgamp) { return __ieee754_lgamma_r(x,signgamp); } --- NEW FILE: e_gammaf.c --- /* e_gammaf.c -- float version of e_gamma.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_gammaf.c,v 1.6 2002/05/28 17:03:12 alfred Exp $"; #endif /* __ieee754_gammaf(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_gammaf_r */ #include "math.h" #include "math_private.h" extern int signgam; float __ieee754_gammaf(float x) { return __ieee754_gammaf_r(x,&signgam); } --- NEW FILE: e_gammaf_r.c --- /* e_gammaf_r.c -- float version of e_gamma_r.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_gammaf_r.c,v 1.7 2002/05/28 18:15:03 alfred Exp $"; #endif /* __ieee754_gammaf_r(x, signgamp) * Reentrant version of the logarithm of the Gamma function * with user provide pointer for the sign of Gamma(x). * * Method: See __ieee754_lgammaf_r */ #include "math.h" #include "math_private.h" float __ieee754_gammaf_r(float x, int *signgamp) { return __ieee754_lgammaf_r(x,signgamp); } --- NEW FILE: e_hypot.c --- /* @(#)e_hypot.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_hypot.c,v 1.8 2002/05/28 18:15:03 alfred Exp $"; #endif /* __ieee754_hypot(x,y) * * Method : * If (assume round-to-nearest) z=x*x+y*y * has error less than sqrt(2)/2 ulp, than * sqrt(z) has error less than 1 ulp (exercise). * * So, compute sqrt(x*x+y*y) with some care as * follows to get the error below 1 ulp: * * Assume x>y>0; * (if possible, set rounding to round-to-nearest) * 1. if x > 2y use * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y * where x1 = x with lower 32 bits cleared, x2 = x-x1; else * 2. if x <= 2y use * t1*y1+((x-y)*(x-y)+(t1*y2+t2*y)) * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, * y1= y with lower 32 bits chopped, y2 = y-y1. * * NOTE: scaling may be necessary if some argument is too * large or too tiny * * Special cases: * hypot(x,y) is INF if x or y is +INF or -INF; else * hypot(x,y) is NAN if x or y is NAN. * * Accuracy: * hypot(x,y) returns sqrt(x^2+y^2) with error less * than 1 ulps (units in the last place) */ #include "math.h" #include "math_private.h" double __ieee754_hypot(double x, double y) { double a=x,b=y,t1,t2,y1,y2,w; int32_t j,k,ha,hb; GET_HIGH_WORD(ha,x); ha &= 0x7fffffff; GET_HIGH_WORD(hb,y); hb &= 0x7fffffff; if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} SET_HIGH_WORD(a,ha); /* a <- |a| */ SET_HIGH_WORD(b,hb); /* b <- |b| */ if((ha-hb)>0x3c00000) {return a+b;} /* x/y > 2**60 */ k=0; if(ha > 0x5f300000) { /* a>2**500 */ if(ha >= 0x7ff00000) { /* Inf or NaN */ u_int32_t low; w = a+b; /* for sNaN */ GET_LOW_WORD(low,a); if(((ha&0xfffff)|low)==0) w = a; GET_LOW_WORD(low,b); if(((hb^0x7ff00000)|low)==0) w = b; return w; } /* scale a and b by 2**-600 */ ha -= 0x25800000; hb -= 0x25800000; k += 600; SET_HIGH_WORD(a,ha); SET_HIGH_WORD(b,hb); } if(hb < 0x20b00000) { /* b < 2**-500 */ if(hb <= 0x000fffff) { /* subnormal b or 0 */ u_int32_t low; GET_LOW_WORD(low,b); if((hb|low)==0) return a; t1=0; SET_HIGH_WORD(t1,0x7fd00000); /* t1=2^1022 */ b *= t1; a *= t1; k -= 1022; } else { /* scale a and b by 2^600 */ ha += 0x25800000; /* a *= 2^600 */ hb += 0x25800000; /* b *= 2^600 */ k -= 600; SET_HIGH_WORD(a,ha); SET_HIGH_WORD(b,hb); } } /* medium size a and b */ w = a-b; if (w>b) { t1 = 0; SET_HIGH_WORD(t1,ha); t2 = a-t1; w = __ieee754_sqrt(t1*t1-(b*(-b)-t2*(a+t1))); } else { a = a+a; y1 = 0; SET_HIGH_WORD(y1,hb); y2 = b - y1; t1 = 0; SET_HIGH_WORD(t1,ha+0x00100000); t2 = a - t1; w = __ieee754_sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { u_int32_t high; t1 = 1.0; GET_HIGH_WORD(high,t1); SET_HIGH_WORD(t1,high+(k<<20)); return t1*w; } else return w; } --- NEW FILE: e_hypotf.c --- /* e_hypotf.c -- float version of e_hypot.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_hypotf.c,v 1.9 2002/05/28 18:15:03 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float __ieee754_hypotf(float x, float y) { float a=x,b=y,t1,t2,y1,y2,w; int32_t j,k,ha,hb; GET_FLOAT_WORD(ha,x); ha &= 0x7fffffff; GET_FLOAT_WORD(hb,y); hb &= 0x7fffffff; if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} SET_FLOAT_WORD(a,ha); /* a <- |a| */ SET_FLOAT_WORD(b,hb); /* b <- |b| */ if((ha-hb)>0xf000000) {return a+b;} /* x/y > 2**30 */ k=0; if(ha > 0x58800000) { /* a>2**50 */ if(ha >= 0x7f800000) { /* Inf or NaN */ w = a+b; /* for sNaN */ if(ha == 0x7f800000) w = a; if(hb == 0x7f800000) w = b; return w; } /* scale a and b by 2**-68 */ ha -= 0x22000000; hb -= 0x22000000; k += 68; SET_FLOAT_WORD(a,ha); SET_FLOAT_WORD(b,hb); } if(hb < 0x26800000) { /* b < 2**-50 */ if(hb <= 0x007fffff) { /* subnormal b or 0 */ if(hb==0) return a; SET_FLOAT_WORD(t1,0x7e800000); /* t1=2^126 */ b *= t1; a *= t1; k -= 126; } else { /* scale a and b by 2^68 */ ha += 0x22000000; /* a *= 2^68 */ hb += 0x22000000; /* b *= 2^68 */ k -= 68; SET_FLOAT_WORD(a,ha); SET_FLOAT_WORD(b,hb); } } /* medium size a and b */ w = a-b; if (w>b) { SET_FLOAT_WORD(t1,ha&0xfffff000); t2 = a-t1; w = __ieee754_sqrtf(t1*t1-(b*(-b)-t2*(a+t1))); } else { a = a+a; SET_FLOAT_WORD(y1,hb&0xfffff000); y2 = b - y1; SET_FLOAT_WORD(t1,ha+0x00800000); t2 = a - t1; w = __ieee754_sqrtf(t1*y1-(w*(-w)-(t1*y2+t2*b))); } if(k!=0) { SET_FLOAT_WORD(t1,0x3f800000+(k<<23)); return t1*w; } else return w; } --- NEW FILE: e_j0.c --- /* @(#)e_j0.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_j0.c,v 1.7 2002/05/28 18:15:03 alfred Exp $"; #endif /* __ieee754_j0(x), __ieee754_y0(x) * Bessel function of the first and second kinds of order zero. * Method -- j0(x): * 1. For tiny x, we use j0(x) = 1 - x^2/4 + x^4/64 - ... * 2. Reduce x to |x| since j0(x)=j0(-x), and * for x in (0,2) * j0(x) = 1-z/4+ z^2*R0/S0, where z = x*x; * (precision: |j0-1+z/4-z^2R0/S0 |<2**-63.67 ) * for x in (2,inf) * j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0)) * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) * as follow: * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) * = 1/sqrt(2) * (cos(x) + sin(x)) * sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * (To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one.) * * 3 Special cases * j0(nan)= nan * j0(0) = 1 * j0(inf) = 0 * * Method -- y0(x): * 1. For x<2. * Since * y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...) * therefore y0(x)-2/pi*j0(x)*ln(x) is an even function. * We use the following function to approximate y0, * y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2 * where * U(z) = u00 + u01*z + ... + u06*z^6 * V(z) = 1 + v01*z + ... + v04*z^4 * with absolute approximation error bounded by 2**-72. * Note: For tiny x, U/V = u0 and j0(x)~1, hence * y0(tiny) = u0 + (2/pi)*ln(tiny), (choose tiny<2**-27) * 2. For x>=2. * y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0)) * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) * by the method mentioned above. * 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0. */ #include "math.h" #include "math_private.h" static double pzero(double), qzero(double); static const double huge = 1e300, one = 1.0, invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ /* R0/S0 on [0, 2.00] */ R02 = 1.56249999999999947958e-02, /* 0x3F8FFFFF, 0xFFFFFFFD */ R03 = -1.89979294238854721751e-04, /* 0xBF28E6A5, 0xB61AC6E9 */ R04 = 1.82954049532700665670e-06, /* 0x3EBEB1D1, 0x0C503919 */ R05 = -4.61832688532103189199e-09, /* 0xBE33D5E7, 0x73D63FCE */ S01 = 1.56191029464890010492e-02, /* 0x3F8FFCE8, 0x82C8C2A4 */ S02 = 1.16926784663337450260e-04, /* 0x3F1EA6D2, 0xDD57DBF4 */ S03 = 5.13546550207318111446e-07, /* 0x3EA13B54, 0xCE84D5A9 */ S04 = 1.16614003333790000205e-09; /* 0x3E1408BC, 0xF4745D8F */ static const double zero = 0.0; double __ieee754_j0(double x) { double z, s,c,ss,cc,r,u,v; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) return one/(x*x); x = fabs(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sin(x); c = cos(x); ss = s-c; cc = s+c; if(ix<0x7fe00000) { /* make sure x+x not overflow */ z = -cos(x+x); if ((s*c)<zero) cc = z/ss; else ss = z/cc; } /* * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) */ if(ix>0x48000000) z = (invsqrtpi*cc)/sqrt(x); else { u = pzero(x); v = qzero(x); z = invsqrtpi*(u*cc-v*ss)/sqrt(x); } return z; } if(ix<0x3f200000) { /* |x| < 2**-13 */ if(huge+x>one) { /* raise inexact if x != 0 */ if(ix<0x3e400000) return one; /* |x|<2**-27 */ else return one - 0.25*x*x; } } z = x*x; r = z*(R02+z*(R03+z*(R04+z*R05))); s = one+z*(S01+z*(S02+z*(S03+z*S04))); if(ix < 0x3FF00000) { /* |x| < 1.00 */ return one + z*(-0.25+(r/s)); } else { u = 0.5*x; return((one+u)*(one-u)+z*(r/s)); } } static const double u00 = -7.38042951086872317523e-02, /* 0xBFB2E4D6, 0x99CBD01F */ u01 = 1.76666452509181115538e-01, /* 0x3FC69D01, 0x9DE9E3FC */ u02 = -1.38185671945596898896e-02, /* 0xBF8C4CE8, 0xB16CFA97 */ u03 = 3.47453432093683650238e-04, /* 0x3F36C54D, 0x20B29B6B */ u04 = -3.81407053724364161125e-06, /* 0xBECFFEA7, 0x73D25CAD */ u05 = 1.95590137035022920206e-08, /* 0x3E550057, 0x3B4EABD4 */ u06 = -3.98205194132103398453e-11, /* 0xBDC5E43D, 0x693FB3C8 */ v01 = 1.27304834834123699328e-02, /* 0x3F8A1270, 0x91C9C71A */ v02 = 7.60068627350353253702e-05, /* 0x3F13ECBB, 0xF578C6C1 */ v03 = 2.59150851840457805467e-07, /* 0x3E91642D, 0x7FF202FD */ v04 = 4.41110311332675467403e-10; /* 0x3DFE5018, 0x3BD6D9EF */ double __ieee754_y0(double x) { double z, s,c,ss,cc,u,v; int32_t hx,ix,lx; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ if(ix>=0x7ff00000) return one/(x+x*x); if((ix|lx)==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) * where x0 = x-pi/4 * Better formula: * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) * = 1/sqrt(2) * (sin(x) + cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ s = sin(x); c = cos(x); ss = s-c; cc = s+c; /* * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) */ if(ix<0x7fe00000) { /* make sure x+x not overflow */ z = -cos(x+x); if ((s*c)<zero) cc = z/ss; else ss = z/cc; } if(ix>0x48000000) z = (invsqrtpi*ss)/sqrt(x); else { u = pzero(x); v = qzero(x); z = invsqrtpi*(u*ss+v*cc)/sqrt(x); } return z; } if(ix<=0x3e400000) { /* x < 2**-27 */ return(u00 + tpi*__ieee754_log(x)); } z = x*x; u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06))))); v = one+z*(v01+z*(v02+z*(v03+z*v04))); return(u/v + tpi*(__ieee754_j0(x)*__ieee754_log(x))); } /* The asymptotic expansions of pzero is * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. * For x >= 2, We approximate pzero by * pzero(x) = 1 + (R/S) * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10 * S = 1 + pS0*s^2 + ... + pS4*s^10 * and * | pzero(x)-1-R/S | <= 2 ** ( -60.26) */ static const double pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ -7.03124999999900357484e-02, /* 0xBFB1FFFF, 0xFFFFFD32 */ -8.08167041275349795626e+00, /* 0xC02029D0, 0xB44FA779 */ -2.57063105679704847262e+02, /* 0xC0701102, 0x7B19E863 */ -2.48521641009428822144e+03, /* 0xC0A36A6E, 0xCD4DCAFC */ -5.25304380490729545272e+03, /* 0xC0B4850B, 0x36CC643D */ }; static const double pS8[5] = { 1.16534364619668181717e+02, /* 0x405D2233, 0x07A96751 */ 3.83374475364121826715e+03, /* 0x40ADF37D, 0x50596938 */ 4.05978572648472545552e+04, /* 0x40E3D2BB, 0x6EB6B05F */ 1.16752972564375915681e+05, /* 0x40FC810F, 0x8F9FA9BD */ 4.76277284146730962675e+04, /* 0x40E74177, 0x4F2C49DC */ }; static const double pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -1.14125464691894502584e-11, /* 0xBDA918B1, 0x47E495CC */ -7.03124940873599280078e-02, /* 0xBFB1FFFF, 0xE69AFBC6 */ -4.15961064470587782438e+00, /* 0xC010A370, 0xF90C6BBF */ -6.76747652265167261021e+01, /* 0xC050EB2F, 0x5A7D1783 */ -3.31231299649172967747e+02, /* 0xC074B3B3, 0x6742CC63 */ -3.46433388365604912451e+02, /* 0xC075A6EF, 0x28A38BD7 */ }; static const double pS5[5] = { 6.07539382692300335975e+01, /* 0x404E6081, 0x0C98C5DE */ 1.05125230595704579173e+03, /* 0x40906D02, 0x5C7E2864 */ 5.97897094333855784498e+03, /* 0x40B75AF8, 0x8FBE1D60 */ 9.62544514357774460223e+03, /* 0x40C2CCB8, 0xFA76FA38 */ 2.40605815922939109441e+03, /* 0x40A2CC1D, 0xC70BE864 */ }; static const double pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ -2.54704601771951915620e-09, /* 0xBE25E103, 0x6FE1AA86 */ -7.03119616381481654654e-02, /* 0xBFB1FFF6, 0xF7C0E24B */ -2.40903221549529611423e+00, /* 0xC00345B2, 0xAEA48074 */ -2.19659774734883086467e+01, /* 0xC035F74A, 0x4CB94E14 */ -5.80791704701737572236e+01, /* 0xC04D0A22, 0x420A1A45 */ -3.14479470594888503854e+01, /* 0xC03F72AC, 0xA892D80F */ }; static const double pS3[5] = { 3.58560338055209726349e+01, /* 0x4041ED92, 0x84077DD3 */ 3.61513983050303863820e+02, /* 0x40769839, 0x464A7C0E */ 1.19360783792111533330e+03, /* 0x4092A66E, 0x6D1061D6 */ 1.12799679856907414432e+03, /* 0x40919FFC, 0xB8C39B7E */ 1.73580930813335754692e+02, /* 0x4065B296, 0xFC379081 */ }; static const double pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -8.87534333032526411254e-08, /* 0xBE77D316, 0xE927026D */ -7.03030995483624743247e-02, /* 0xBFB1FF62, 0x495E1E42 */ -1.45073846780952986357e+00, /* 0xBFF73639, 0x8A24A843 */ -7.63569613823527770791e+00, /* 0xC01E8AF3, 0xEDAFA7F3 */ -1.11931668860356747786e+01, /* 0xC02662E6, 0xC5246303 */ -3.23364579351335335033e+00, /* 0xC009DE81, 0xAF8FE70F */ }; static const double pS2[5] = { 2.22202997532088808441e+01, /* 0x40363865, 0x908B5959 */ 1.36206794218215208048e+02, /* 0x4061069E, 0x0EE8878F */ 2.70470278658083486789e+02, /* 0x4070E786, 0x42EA079B */ 1.53875394208320329881e+02, /* 0x40633C03, 0x3AB6FAFF */ 1.46576176948256193810e+01, /* 0x402D50B3, 0x44391809 */ }; static double pzero(double x) { const double *p,*q; double z,r,s; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x40200000) {p = pR8; q= pS8;} else if(ix>=0x40122E8B){p = pR5; q= pS5;} else if(ix>=0x4006DB6D){p = pR3; q= pS3;} else if(ix>=0x40000000){p = pR2; q= pS2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qzero is * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. * We approximate pzero by * qzero(x) = s*(-1.25 + (R/S)) * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10 * S = 1 + qS0*s^2 + ... + qS5*s^12 * and * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22) */ static const double qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ 7.32421874999935051953e-02, /* 0x3FB2BFFF, 0xFFFFFE2C */ 1.17682064682252693899e+01, /* 0x40278952, 0x5BB334D6 */ 5.57673380256401856059e+02, /* 0x40816D63, 0x15301825 */ 8.85919720756468632317e+03, /* 0x40C14D99, 0x3E18F46D */ 3.70146267776887834771e+04, /* 0x40E212D4, 0x0E901566 */ }; static const double qS8[6] = { 1.63776026895689824414e+02, /* 0x406478D5, 0x365B39BC */ 8.09834494656449805916e+03, /* 0x40BFA258, 0x4E6B0563 */ 1.42538291419120476348e+05, /* 0x41016652, 0x54D38C3F */ 8.03309257119514397345e+05, /* 0x412883DA, 0x83A52B43 */ 8.40501579819060512818e+05, /* 0x4129A66B, 0x28DE0B3D */ -3.43899293537866615225e+05, /* 0xC114FD6D, 0x2C9530C5 */ }; static const double qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.84085963594515531381e-11, /* 0x3DB43D8F, 0x29CC8CD9 */ 7.32421766612684765896e-02, /* 0x3FB2BFFF, 0xD172B04C */ 5.83563508962056953777e+00, /* 0x401757B0, 0xB9953DD3 */ 1.35111577286449829671e+02, /* 0x4060E392, 0x0A8788E9 */ 1.02724376596164097464e+03, /* 0x40900CF9, 0x9DC8C481 */ 1.98997785864605384631e+03, /* 0x409F17E9, 0x53C6E3A6 */ }; static const double qS5[6] = { 8.27766102236537761883e+01, /* 0x4054B1B3, 0xFB5E1543 */ 2.07781416421392987104e+03, /* 0x40A03BA0, 0xDA21C0CE */ 1.88472887785718085070e+04, /* 0x40D267D2, 0x7B591E6D */ 5.67511122894947329769e+04, /* 0x40EBB5E3, 0x97E02372 */ 3.59767538425114471465e+04, /* 0x40E19118, 0x1F7A54A0 */ -5.35434275601944773371e+03, /* 0xC0B4EA57, 0xBEDBC609 */ }; static const double qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ 4.37741014089738620906e-09, /* 0x3E32CD03, 0x6ADECB82 */ 7.32411180042911447163e-02, /* 0x3FB2BFEE, 0x0E8D0842 */ 3.34423137516170720929e+00, /* 0x400AC0FC, 0x61149CF5 */ 4.26218440745412650017e+01, /* 0x40454F98, 0x962DAEDD */ 1.70808091340565596283e+02, /* 0x406559DB, 0xE25EFD1F */ 1.66733948696651168575e+02, /* 0x4064D77C, 0x81FA21E0 */ }; static const double qS3[6] = { 4.87588729724587182091e+01, /* 0x40486122, 0xBFE343A6 */ 7.09689221056606015736e+02, /* 0x40862D83, 0x86544EB3 */ 3.70414822620111362994e+03, /* 0x40ACF04B, 0xE44DFC63 */ 6.46042516752568917582e+03, /* 0x40B93C6C, 0xD7C76A28 */ 2.51633368920368957333e+03, /* 0x40A3A8AA, 0xD94FB1C0 */ -1.49247451836156386662e+02, /* 0xC062A7EB, 0x201CF40F */ }; static const double qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.50444444886983272379e-07, /* 0x3E84313B, 0x54F76BDB */ 7.32234265963079278272e-02, /* 0x3FB2BEC5, 0x3E883E34 */ 1.99819174093815998816e+00, /* 0x3FFFF897, 0xE727779C */ 1.44956029347885735348e+01, /* 0x402CFDBF, 0xAAF96FE5 */ 3.16662317504781540833e+01, /* 0x403FAA8E, 0x29FBDC4A */ 1.62527075710929267416e+01, /* 0x403040B1, 0x71814BB4 */ }; static const double qS2[6] = { 3.03655848355219184498e+01, /* 0x403E5D96, 0xF7C07AED */ 2.69348118608049844624e+02, /* 0x4070D591, 0xE4D14B40 */ 8.44783757595320139444e+02, /* 0x408A6645, 0x22B3BF22 */ 8.82935845112488550512e+02, /* 0x408B977C, 0x9C5CC214 */ 2.12666388511798828631e+02, /* 0x406A9553, 0x0E001365 */ -5.31095493882666946917e+00, /* 0xC0153E6A, 0xF8B32931 */ }; static double qzero(double x) { const double *p,*q; double s,r,z; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x40200000) {p = qR8; q= qS8;} else if(ix>=0x40122E8B){p = qR5; q= qS5;} else if(ix>=0x4006DB6D){p = qR3; q= qS3;} else if(ix>=0x40000000){p = qR2; q= qS2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return (-.125 + r/s)/x; } --- NEW FILE: e_j0f.c --- /* e_j0f.c -- float version of e_j0.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_j0f.c,v 1.7 2002/05/28 18:15:03 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static float pzerof(float), qzerof(float); static const float huge = 1e30, one = 1.0, invsqrtpi= 5.6418961287e-01, /* 0x3f106ebb */ tpi = 6.3661974669e-01, /* 0x3f22f983 */ /* R0/S0 on [0, 2.00] */ R02 = 1.5625000000e-02, /* 0x3c800000 */ R03 = -1.8997929874e-04, /* 0xb947352e */ R04 = 1.8295404516e-06, /* 0x35f58e88 */ R05 = -4.6183270541e-09, /* 0xb19eaf3c */ S01 = 1.5619102865e-02, /* 0x3c7fe744 */ S02 = 1.1692678527e-04, /* 0x38f53697 */ S03 = 5.1354652442e-07, /* 0x3509daa6 */ S04 = 1.1661400734e-09; /* 0x30a045e8 */ static const float zero = 0.0; float __ieee754_j0f(float x) { float z, s,c,ss,cc,r,u,v; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) return one/(x*x); x = fabsf(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sinf(x); c = cosf(x); ss = s-c; cc = s+c; if(ix<0x7f000000) { /* make sure x+x not overflow */ z = -cosf(x+x); if ((s*c)<zero) cc = z/ss; else ss = z/cc; } /* * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) */ if(ix>0x80000000) z = (invsqrtpi*cc)/sqrtf(x); else { u = pzerof(x); v = qzerof(x); z = invsqrtpi*(u*cc-v*ss)/sqrtf(x); } return z; } if(ix<0x39000000) { /* |x| < 2**-13 */ if(huge+x>one) { /* raise inexact if x != 0 */ if(ix<0x32000000) return one; /* |x|<2**-27 */ else return one - (float)0.25*x*x; } } z = x*x; r = z*(R02+z*(R03+z*(R04+z*R05))); s = one+z*(S01+z*(S02+z*(S03+z*S04))); if(ix < 0x3F800000) { /* |x| < 1.00 */ return one + z*((float)-0.25+(r/s)); } else { u = (float)0.5*x; return((one+u)*(one-u)+z*(r/s)); } } static const float u00 = -7.3804296553e-02, /* 0xbd9726b5 */ u01 = 1.7666645348e-01, /* 0x3e34e80d */ u02 = -1.3818567619e-02, /* 0xbc626746 */ u03 = 3.4745343146e-04, /* 0x39b62a69 */ u04 = -3.8140706238e-06, /* 0xb67ff53c */ u05 = 1.9559013964e-08, /* 0x32a802ba */ u06 = -3.9820518410e-11, /* 0xae2f21eb */ v01 = 1.2730483897e-02, /* 0x3c509385 */ v02 = 7.6006865129e-05, /* 0x389f65e0 */ v03 = 2.5915085189e-07, /* 0x348b216c */ v04 = 4.4111031494e-10; /* 0x2ff280c2 */ float __ieee754_y0f(float x) { float z, s,c,ss,cc,u,v; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ if(ix>=0x7f800000) return one/(x+x*x); if(ix==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) * where x0 = x-pi/4 * Better formula: * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) * = 1/sqrt(2) * (sin(x) + cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ s = sinf(x); c = cosf(x); ss = s-c; cc = s+c; /* * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) */ if(ix<0x7f000000) { /* make sure x+x not overflow */ z = -cosf(x+x); if ((s*c)<zero) cc = z/ss; else ss = z/cc; } if(ix>0x80000000) z = (invsqrtpi*ss)/sqrtf(x); else { u = pzerof(x); v = qzerof(x); z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); } return z; } if(ix<=0x32000000) { /* x < 2**-27 */ return(u00 + tpi*__ieee754_logf(x)); } z = x*x; u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06))))); v = one+z*(v01+z*(v02+z*(v03+z*v04))); return(u/v + tpi*(__ieee754_j0f(x)*__ieee754_logf(x))); } /* The asymptotic expansions of pzero is * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. * For x >= 2, We approximate pzero by * pzero(x) = 1 + (R/S) * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10 * S = 1 + pS0*s^2 + ... + pS4*s^10 * and * | pzero(x)-1-R/S | <= 2 ** ( -60.26) */ static const float pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ -7.0312500000e-02, /* 0xbd900000 */ -8.0816707611e+00, /* 0xc1014e86 */ -2.5706311035e+02, /* 0xc3808814 */ -2.4852163086e+03, /* 0xc51b5376 */ -5.2530439453e+03, /* 0xc5a4285a */ }; static const float pS8[5] = { 1.1653436279e+02, /* 0x42e91198 */ 3.8337448730e+03, /* 0x456f9beb */ 4.0597855469e+04, /* 0x471e95db */ 1.1675296875e+05, /* 0x47e4087c */ 4.7627726562e+04, /* 0x473a0bba */ }; static const float pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -1.1412546255e-11, /* 0xad48c58a */ -7.0312492549e-02, /* 0xbd8fffff */ -4.1596107483e+00, /* 0xc0851b88 */ -6.7674766541e+01, /* 0xc287597b */ -3.3123129272e+02, /* 0xc3a59d9b */ -3.4643338013e+02, /* 0xc3ad3779 */ }; static const float pS5[5] = { 6.0753936768e+01, /* 0x42730408 */ 1.0512523193e+03, /* 0x44836813 */ 5.9789707031e+03, /* 0x45bad7c4 */ 9.6254453125e+03, /* 0x461665c8 */ 2.4060581055e+03, /* 0x451660ee */ }; static const float pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ -2.5470459075e-09, /* 0xb12f081b */ -7.0311963558e-02, /* 0xbd8fffb8 */ -2.4090321064e+00, /* 0xc01a2d95 */ -2.1965976715e+01, /* 0xc1afba52 */ -5.8079170227e+01, /* 0xc2685112 */ -3.1447946548e+01, /* 0xc1fb9565 */ }; static const float pS3[5] = { 3.5856033325e+01, /* 0x420f6c94 */ 3.6151397705e+02, /* 0x43b4c1ca */ 1.1936077881e+03, /* 0x44953373 */ 1.1279968262e+03, /* 0x448cffe6 */ 1.7358093262e+02, /* 0x432d94b8 */ }; static const float pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -8.8753431271e-08, /* 0xb3be98b7 */ -7.0303097367e-02, /* 0xbd8ffb12 */ -1.4507384300e+00, /* 0xbfb9b1cc */ -7.6356959343e+00, /* 0xc0f4579f */ -1.1193166733e+01, /* 0xc1331736 */ -3.2336456776e+00, /* 0xc04ef40d */ }; static const float pS2[5] = { 2.2220300674e+01, /* 0x41b1c32d */ 1.3620678711e+02, /* 0x430834f0 */ 2.7047027588e+02, /* 0x43873c32 */ 1.5387539673e+02, /* 0x4319e01a */ 1.4657617569e+01, /* 0x416a859a */ }; static float pzerof(float x) { const float *p,*q; float z,r,s; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = pR8; q= pS8;} else if(ix>=0x40f71c58){p = pR5; q= pS5;} else if(ix>=0x4036db68){p = pR3; q= pS3;} else if(ix>=0x40000000){p = pR2; q= pS2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qzero is * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. * We approximate pzero by * qzero(x) = s*(-1.25 + (R/S)) * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10 * S = 1 + qS0*s^2 + ... + qS5*s^12 * and * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22) */ static const float qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ 7.3242187500e-02, /* 0x3d960000 */ 1.1768206596e+01, /* 0x413c4a93 */ 5.5767340088e+02, /* 0x440b6b19 */ 8.8591972656e+03, /* 0x460a6cca */ 3.7014625000e+04, /* 0x471096a0 */ }; static const float qS8[6] = { 1.6377603149e+02, /* 0x4323c6aa */ 8.0983447266e+03, /* 0x45fd12c2 */ 1.4253829688e+05, /* 0x480b3293 */ 8.0330925000e+05, /* 0x49441ed4 */ 8.4050156250e+05, /* 0x494d3359 */ -3.4389928125e+05, /* 0xc8a7eb69 */ }; static const float qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.8408595828e-11, /* 0x2da1ec79 */ 7.3242180049e-02, /* 0x3d95ffff */ 5.8356351852e+00, /* 0x40babd86 */ 1.3511157227e+02, /* 0x43071c90 */ 1.0272437744e+03, /* 0x448067cd */ 1.9899779053e+03, /* 0x44f8bf4b */ }; static const float qS5[6] = { 8.2776611328e+01, /* 0x42a58da0 */ 2.0778142090e+03, /* 0x4501dd07 */ 1.8847289062e+04, /* 0x46933e94 */ 5.6751113281e+04, /* 0x475daf1d */ 3.5976753906e+04, /* 0x470c88c1 */ -5.3543427734e+03, /* 0xc5a752be */ }; static const float qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ 4.3774099900e-09, /* 0x3196681b */ 7.3241114616e-02, /* 0x3d95ff70 */ 3.3442313671e+00, /* 0x405607e3 */ 4.2621845245e+01, /* 0x422a7cc5 */ 1.7080809021e+02, /* 0x432acedf */ 1.6673394775e+02, /* 0x4326bbe4 */ }; static const float qS3[6] = { 4.8758872986e+01, /* 0x42430916 */ 7.0968920898e+02, /* 0x44316c1c */ 3.7041481934e+03, /* 0x4567825f */ 6.4604252930e+03, /* 0x45c9e367 */ 2.5163337402e+03, /* 0x451d4557 */ -1.4924745178e+02, /* 0xc3153f59 */ }; static const float qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.5044444979e-07, /* 0x342189db */ 7.3223426938e-02, /* 0x3d95f62a */ 1.9981917143e+00, /* 0x3fffc4bf */ 1.4495602608e+01, /* 0x4167edfd */ 3.1666231155e+01, /* 0x41fd5471 */ 1.6252708435e+01, /* 0x4182058c */ }; static const float qS2[6] = { 3.0365585327e+01, /* 0x41f2ecb8 */ 2.6934811401e+02, /* 0x4386ac8f */ 8.4478375244e+02, /* 0x44533229 */ 8.8293585205e+02, /* 0x445cbbe5 */ 2.1266638184e+02, /* 0x4354aa98 */ -5.3109550476e+00, /* 0xc0a9f358 */ }; static float qzerof(float x) { const float *p,*q; float s,r,z; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = qR8; q= qS8;} else if(ix>=0x40f71c58){p = qR5; q= qS5;} else if(ix>=0x4036db68){p = qR3; q= qS3;} else if(ix>=0x40000000){p = qR2; q= qS2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return (-(float).125 + r/s)/x; } --- NEW FILE: e_j1.c --- /* @(#)e_j1.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_j1.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* __ieee754_j1(x), __ieee754_y1(x) * Bessel function of the first and second kinds of order zero. * Method -- j1(x): * 1. For tiny x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ... * 2. Reduce x to |x| since j1(x)=-j1(-x), and * for x in (0,2) * j1(x) = x/2 + x*z*R0/S0, where z = x*x; * (precision: |j1/x - 1/2 - R0/S0 |<2**-61.51 ) * for x in (2,inf) * j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1)) * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) * as follow: * cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = -1/sqrt(2) * (sin(x) + cos(x)) * (To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one.) * * 3 Special cases * j1(nan)= nan * j1(0) = 0 * j1(inf) = 0 * * Method -- y1(x): * 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN * 2. For x<2. * Since * y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...) * therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function. * We use the following function to approximate y1, * y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2 * where for x in [0,2] (abs err less than 2**-65.89) * U(z) = U0[0] + U0[1]*z + ... + U0[4]*z^4 * V(z) = 1 + v0[0]*z + ... + v0[4]*z^5 * Note: For tiny x, 1/x dominate y1 and hence * y1(tiny) = -2/pi/tiny, (choose tiny<2**-54) * 3. For x>=2. * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) * by method mentioned above. */ #include "math.h" #include "math_private.h" static double pone(double), qone(double); static const double huge = 1e300, one = 1.0, invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ /* R0/S0 on [0,2] */ r00 = -6.25000000000000000000e-02, /* 0xBFB00000, 0x00000000 */ r01 = 1.40705666955189706048e-03, /* 0x3F570D9F, 0x98472C61 */ r02 = -1.59955631084035597520e-05, /* 0xBEF0C5C6, 0xBA169668 */ r03 = 4.96727999609584448412e-08, /* 0x3E6AAAFA, 0x46CA0BD9 */ s01 = 1.91537599538363460805e-02, /* 0x3F939D0B, 0x12637E53 */ s02 = 1.85946785588630915560e-04, /* 0x3F285F56, 0xB9CDF664 */ s03 = 1.17718464042623683263e-06, /* 0x3EB3BFF8, 0x333F8498 */ s04 = 5.04636257076217042715e-09, /* 0x3E35AC88, 0xC97DFF2C */ s05 = 1.23542274426137913908e-11; /* 0x3DAB2ACF, 0xCFB97ED8 */ static const double zero = 0.0; double __ieee754_j1(double x) { double z, s,c,ss,cc,r,u,v,y; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) return one/x; y = fabs(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sin(y); c = cos(y); ss = -s-c; cc = s-c; if(ix<0x7fe00000) { /* make sure y+y not overflow */ z = cos(y+y); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) */ if(ix>0x48000000) z = (invsqrtpi*cc)/sqrt(y); else { u = pone(y); v = qone(y); z = invsqrtpi*(u*cc-v*ss)/sqrt(y); } if(hx<0) return -z; else return z; } if(ix<0x3e400000) { /* |x|<2**-27 */ if(huge+x>one) return 0.5*x;/* inexact if x!=0 necessary */ } z = x*x; r = z*(r00+z*(r01+z*(r02+z*r03))); s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05)))); r *= x; return(x*0.5+r/s); } static const double U0[5] = { -1.96057090646238940668e-01, /* 0xBFC91866, 0x143CBC8A */ 5.04438716639811282616e-02, /* 0x3FA9D3C7, 0x76292CD1 */ -1.91256895875763547298e-03, /* 0xBF5F55E5, 0x4844F50F */ 2.35252600561610495928e-05, /* 0x3EF8AB03, 0x8FA6B88E */ -9.19099158039878874504e-08, /* 0xBE78AC00, 0x569105B8 */ }; static const double V0[5] = { 1.99167318236649903973e-02, /* 0x3F94650D, 0x3F4DA9F0 */ 2.02552581025135171496e-04, /* 0x3F2A8C89, 0x6C257764 */ 1.35608801097516229404e-06, /* 0x3EB6C05A, 0x894E8CA6 */ 6.22741452364621501295e-09, /* 0x3E3ABF1D, 0x5BA69A86 */ 1.66559246207992079114e-11, /* 0x3DB25039, 0xDACA772A */ }; double __ieee754_y1(double x) { double z, s,c,ss,cc,u,v; int32_t hx,ix,lx; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ if(ix>=0x7ff00000) return one/(x+x*x); if((ix|lx)==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sin(x); c = cos(x); ss = -s-c; cc = s-c; if(ix<0x7fe00000) { /* make sure x+x not overflow */ z = cos(x+x); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) * where x0 = x-3pi/4 * Better formula: * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = -1/sqrt(2) * (cos(x) + sin(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ if(ix>0x48000000) z = (invsqrtpi*ss)/sqrt(x); else { u = pone(x); v = qone(x); z = invsqrtpi*(u*ss+v*cc)/sqrt(x); } return z; } if(ix<=0x3c900000) { /* x < 2**-54 */ return(-tpi/x); } z = x*x; u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4]))); v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4])))); return(x*(u/v) + tpi*(__ieee754_j1(x)*__ieee754_log(x)-one/x)); } /* For x >= 8, the asymptotic expansions of pone is * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. * We approximate pone by * pone(x) = 1 + (R/S) * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10 * S = 1 + ps0*s^2 + ... + ps4*s^10 * and * | pone(x)-1-R/S | <= 2 ** ( -60.06) */ static const double pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ 1.17187499999988647970e-01, /* 0x3FBDFFFF, 0xFFFFFCCE */ 1.32394806593073575129e+01, /* 0x402A7A9D, 0x357F7FCE */ 4.12051854307378562225e+02, /* 0x4079C0D4, 0x652EA590 */ 3.87474538913960532227e+03, /* 0x40AE457D, 0xA3A532CC */ 7.91447954031891731574e+03, /* 0x40BEEA7A, 0xC32782DD */ }; static const double ps8[5] = { 1.14207370375678408436e+02, /* 0x405C8D45, 0x8E656CAC */ 3.65093083420853463394e+03, /* 0x40AC85DC, 0x964D274F */ 3.69562060269033463555e+04, /* 0x40E20B86, 0x97C5BB7F */ 9.76027935934950801311e+04, /* 0x40F7D42C, 0xB28F17BB */ 3.08042720627888811578e+04, /* 0x40DE1511, 0x697A0B2D */ }; static const double pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.31990519556243522749e-11, /* 0x3DAD0667, 0xDAE1CA7D */ 1.17187493190614097638e-01, /* 0x3FBDFFFF, 0xE2C10043 */ 6.80275127868432871736e+00, /* 0x401B3604, 0x6E6315E3 */ 1.08308182990189109773e+02, /* 0x405B13B9, 0x452602ED */ 5.17636139533199752805e+02, /* 0x40802D16, 0xD052D649 */ 5.28715201363337541807e+02, /* 0x408085B8, 0xBB7E0CB7 */ }; static const double ps5[5] = { 5.92805987221131331921e+01, /* 0x404DA3EA, 0xA8AF633D */ 9.91401418733614377743e+02, /* 0x408EFB36, 0x1B066701 */ 5.35326695291487976647e+03, /* 0x40B4E944, 0x5706B6FB */ 7.84469031749551231769e+03, /* 0x40BEA4B0, 0xB8A5BB15 */ 1.50404688810361062679e+03, /* 0x40978030, 0x036F5E51 */ }; static const double pr3[6] = { 3.02503916137373618024e-09, /* 0x3E29FC21, 0xA7AD9EDD */ 1.17186865567253592491e-01, /* 0x3FBDFFF5, 0x5B21D17B */ 3.93297750033315640650e+00, /* 0x400F76BC, 0xE85EAD8A */ 3.51194035591636932736e+01, /* 0x40418F48, 0x9DA6D129 */ 9.10550110750781271918e+01, /* 0x4056C385, 0x4D2C1837 */ 4.85590685197364919645e+01, /* 0x4048478F, 0x8EA83EE5 */ }; static const double ps3[5] = { 3.47913095001251519989e+01, /* 0x40416549, 0xA134069C */ 3.36762458747825746741e+02, /* 0x40750C33, 0x07F1A75F */ 1.04687139975775130551e+03, /* 0x40905B7C, 0x5037D523 */ 8.90811346398256432622e+02, /* 0x408BD67D, 0xA32E31E9 */ 1.03787932439639277504e+02, /* 0x4059F26D, 0x7C2EED53 */ }; static const double pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.07710830106873743082e-07, /* 0x3E7CE9D4, 0xF65544F4 */ 1.17176219462683348094e-01, /* 0x3FBDFF42, 0xBE760D83 */ 2.36851496667608785174e+00, /* 0x4002F2B7, 0xF98FAEC0 */ 1.22426109148261232917e+01, /* 0x40287C37, 0x7F71A964 */ 1.76939711271687727390e+01, /* 0x4031B1A8, 0x177F8EE2 */ 5.07352312588818499250e+00, /* 0x40144B49, 0xA574C1FE */ }; static const double ps2[5] = { 2.14364859363821409488e+01, /* 0x40356FBD, 0x8AD5ECDC */ 1.25290227168402751090e+02, /* 0x405F5293, 0x14F92CD5 */ 2.32276469057162813669e+02, /* 0x406D08D8, 0xD5A2DBD9 */ 1.17679373287147100768e+02, /* 0x405D6B7A, 0xDA1884A9 */ 8.36463893371618283368e+00, /* 0x4020BAB1, 0xF44E5192 */ }; static double pone(double x) { const double *p,*q; double z,r,s; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x40200000) {p = pr8; q= ps8;} else if(ix>=0x40122E8B){p = pr5; q= ps5;} else if(ix>=0x4006DB6D){p = pr3; q= ps3;} else if(ix>=0x40000000){p = pr2; q= ps2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qone is * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. * We approximate pone by * qone(x) = s*(0.375 + (R/S)) * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10 * S = 1 + qs1*s^2 + ... + qs6*s^12 * and * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13) */ static const double qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ -1.02539062499992714161e-01, /* 0xBFBA3FFF, 0xFFFFFDF3 */ -1.62717534544589987888e+01, /* 0xC0304591, 0xA26779F7 */ -7.59601722513950107896e+02, /* 0xC087BCD0, 0x53E4B576 */ -1.18498066702429587167e+04, /* 0xC0C724E7, 0x40F87415 */ -4.84385124285750353010e+04, /* 0xC0E7A6D0, 0x65D09C6A */ }; static const double qs8[6] = { 1.61395369700722909556e+02, /* 0x40642CA6, 0xDE5BCDE5 */ 7.82538599923348465381e+03, /* 0x40BE9162, 0xD0D88419 */ 1.33875336287249578163e+05, /* 0x4100579A, 0xB0B75E98 */ 7.19657723683240939863e+05, /* 0x4125F653, 0x72869C19 */ 6.66601232617776375264e+05, /* 0x412457D2, 0x7719AD5C */ -2.94490264303834643215e+05, /* 0xC111F969, 0x0EA5AA18 */ }; static const double qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -2.08979931141764104297e-11, /* 0xBDB6FA43, 0x1AA1A098 */ -1.02539050241375426231e-01, /* 0xBFBA3FFF, 0xCB597FEF */ -8.05644828123936029840e+00, /* 0xC0201CE6, 0xCA03AD4B */ -1.83669607474888380239e+02, /* 0xC066F56D, 0x6CA7B9B0 */ -1.37319376065508163265e+03, /* 0xC09574C6, 0x6931734F */ -2.61244440453215656817e+03, /* 0xC0A468E3, 0x88FDA79D */ }; static const double qs5[6] = { 8.12765501384335777857e+01, /* 0x405451B2, 0xFF5A11B2 */ 1.99179873460485964642e+03, /* 0x409F1F31, 0xE77BF839 */ 1.74684851924908907677e+04, /* 0x40D10F1F, 0x0D64CE29 */ 4.98514270910352279316e+04, /* 0x40E8576D, 0xAABAD197 */ 2.79480751638918118260e+04, /* 0x40DB4B04, 0xCF7C364B */ -4.71918354795128470869e+03, /* 0xC0B26F2E, 0xFCFFA004 */ }; static const double qr3[6] = { -5.07831226461766561369e-09, /* 0xBE35CFA9, 0xD38FC84F */ -1.02537829820837089745e-01, /* 0xBFBA3FEB, 0x51AEED54 */ -4.61011581139473403113e+00, /* 0xC01270C2, 0x3302D9FF */ -5.78472216562783643212e+01, /* 0xC04CEC71, 0xC25D16DA */ -2.28244540737631695038e+02, /* 0xC06C87D3, 0x4718D55F */ -2.19210128478909325622e+02, /* 0xC06B66B9, 0x5F5C1BF6 */ }; static const double qs3[6] = { 4.76651550323729509273e+01, /* 0x4047D523, 0xCCD367E4 */ 6.73865112676699709482e+02, /* 0x40850EEB, 0xC031EE3E */ 3.38015286679526343505e+03, /* 0x40AA684E, 0x448E7C9A */ 5.54772909720722782367e+03, /* 0x40B5ABBA, 0xA61D54A6 */ 1.90311919338810798763e+03, /* 0x409DBC7A, 0x0DD4DF4B */ -1.35201191444307340817e+02, /* 0xC060E670, 0x290A311F */ }; static const double qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -1.78381727510958865572e-07, /* 0xBE87F126, 0x44C626D2 */ -1.02517042607985553460e-01, /* 0xBFBA3E8E, 0x9148B010 */ -2.75220568278187460720e+00, /* 0xC0060484, 0x69BB4EDA */ -1.96636162643703720221e+01, /* 0xC033A9E2, 0xC168907F */ -4.23253133372830490089e+01, /* 0xC04529A3, 0xDE104AAA */ -2.13719211703704061733e+01, /* 0xC0355F36, 0x39CF6E52 */ }; static const double qs2[6] = { 2.95333629060523854548e+01, /* 0x403D888A, 0x78AE64FF */ 2.52981549982190529136e+02, /* 0x406F9F68, 0xDB821CBA */ 7.57502834868645436472e+02, /* 0x4087AC05, 0xCE49A0F7 */ 7.39393205320467245656e+02, /* 0x40871B25, 0x48D4C029 */ 1.55949003336666123687e+02, /* 0x40637E5E, 0x3C3ED8D4 */ -4.95949898822628210127e+00, /* 0xC013D686, 0xE71BE86B */ }; static double qone(double x) { const double *p,*q; double s,r,z; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x40200000) {p = qr8; q= qs8;} else if(ix>=0x40122E8B){p = qr5; q= qs5;} else if(ix>=0x4006DB6D){p = qr3; q= qs3;} else if(ix>=0x40000000){p = qr2; q= qs2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return (.375 + r/s)/x; } --- NEW FILE: e_j1f.c --- /* e_j1f.c -- float version of e_j1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_j1f.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static float ponef(float), qonef(float); static const float huge = 1e30, one = 1.0, invsqrtpi= 5.6418961287e-01, /* 0x3f106ebb */ tpi = 6.3661974669e-01, /* 0x3f22f983 */ /* R0/S0 on [0,2] */ r00 = -6.2500000000e-02, /* 0xbd800000 */ r01 = 1.4070566976e-03, /* 0x3ab86cfd */ r02 = -1.5995563444e-05, /* 0xb7862e36 */ r03 = 4.9672799207e-08, /* 0x335557d2 */ s01 = 1.9153760746e-02, /* 0x3c9ce859 */ s02 = 1.8594678841e-04, /* 0x3942fab6 */ s03 = 1.1771846857e-06, /* 0x359dffc2 */ s04 = 5.0463624390e-09, /* 0x31ad6446 */ s05 = 1.2354227016e-11; /* 0x2d59567e */ static const float zero = 0.0; float __ieee754_j1f(float x) { float z, s,c,ss,cc,r,u,v,y; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) return one/x; y = fabsf(x); if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sinf(y); c = cosf(y); ss = -s-c; cc = s-c; if(ix<0x7f000000) { /* make sure y+y not overflow */ z = cosf(y+y); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) */ if(ix>0x80000000) z = (invsqrtpi*cc)/sqrtf(y); else { u = ponef(y); v = qonef(y); z = invsqrtpi*(u*cc-v*ss)/sqrtf(y); } if(hx<0) return -z; else return z; } if(ix<0x32000000) { /* |x|<2**-27 */ if(huge+x>one) return (float)0.5*x;/* inexact if x!=0 necessary */ } z = x*x; r = z*(r00+z*(r01+z*(r02+z*r03))); s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05)))); r *= x; return(x*(float)0.5+r/s); } static const float U0[5] = { -1.9605709612e-01, /* 0xbe48c331 */ 5.0443872809e-02, /* 0x3d4e9e3c */ -1.9125689287e-03, /* 0xbafaaf2a */ 2.3525259166e-05, /* 0x37c5581c */ -9.1909917899e-08, /* 0xb3c56003 */ }; static const float V0[5] = { 1.9916731864e-02, /* 0x3ca3286a */ 2.0255257550e-04, /* 0x3954644b */ 1.3560879779e-06, /* 0x35b602d4 */ 6.2274145840e-09, /* 0x31d5f8eb */ 1.6655924903e-11, /* 0x2d9281cf */ }; float __ieee754_y1f(float x) { float z, s,c,ss,cc,u,v; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ if(ix>=0x7f800000) return one/(x+x*x); if(ix==0) return -one/zero; if(hx<0) return zero/zero; if(ix >= 0x40000000) { /* |x| >= 2.0 */ s = sinf(x); c = cosf(x); ss = -s-c; cc = s-c; if(ix<0x7f000000) { /* make sure x+x not overflow */ z = cosf(x+x); if ((s*c)>zero) cc = z/ss; else ss = z/cc; } /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) * where x0 = x-3pi/4 * Better formula: * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) * = 1/sqrt(2) * (sin(x) - cos(x)) * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) * = -1/sqrt(2) * (cos(x) + sin(x)) * To avoid cancellation, use * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) * to compute the worse one. */ if(ix>0x48000000) z = (invsqrtpi*ss)/sqrtf(x); else { u = ponef(x); v = qonef(x); z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); } return z; } if(ix<=0x24800000) { /* x < 2**-54 */ return(-tpi/x); } z = x*x; u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4]))); v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4])))); return(x*(u/v) + tpi*(__ieee754_j1f(x)*__ieee754_logf(x)-one/x)); } /* For x >= 8, the asymptotic expansions of pone is * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. * We approximate pone by * pone(x) = 1 + (R/S) * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10 * S = 1 + ps0*s^2 + ... + ps4*s^10 * and * | pone(x)-1-R/S | <= 2 ** ( -60.06) */ static const float pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ 1.1718750000e-01, /* 0x3df00000 */ 1.3239480972e+01, /* 0x4153d4ea */ 4.1205184937e+02, /* 0x43ce06a3 */ 3.8747453613e+03, /* 0x45722bed */ 7.9144794922e+03, /* 0x45f753d6 */ }; static const float ps8[5] = { 1.1420736694e+02, /* 0x42e46a2c */ 3.6509309082e+03, /* 0x45642ee5 */ 3.6956207031e+04, /* 0x47105c35 */ 9.7602796875e+04, /* 0x47bea166 */ 3.0804271484e+04, /* 0x46f0a88b */ }; static const float pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ 1.3199052094e-11, /* 0x2d68333f */ 1.1718749255e-01, /* 0x3defffff */ 6.8027510643e+00, /* 0x40d9b023 */ 1.0830818176e+02, /* 0x42d89dca */ 5.1763616943e+02, /* 0x440168b7 */ 5.2871520996e+02, /* 0x44042dc6 */ }; static const float ps5[5] = { 5.9280597687e+01, /* 0x426d1f55 */ 9.9140142822e+02, /* 0x4477d9b1 */ 5.3532670898e+03, /* 0x45a74a23 */ 7.8446904297e+03, /* 0x45f52586 */ 1.5040468750e+03, /* 0x44bc0180 */ }; static const float pr3[6] = { 3.0250391081e-09, /* 0x314fe10d */ 1.1718686670e-01, /* 0x3defffab */ 3.9329774380e+00, /* 0x407bb5e7 */ 3.5119403839e+01, /* 0x420c7a45 */ 9.1055007935e+01, /* 0x42b61c2a */ 4.8559066772e+01, /* 0x42423c7c */ }; static const float ps3[5] = { 3.4791309357e+01, /* 0x420b2a4d */ 3.3676245117e+02, /* 0x43a86198 */ 1.0468714600e+03, /* 0x4482dbe3 */ 8.9081134033e+02, /* 0x445eb3ed */ 1.0378793335e+02, /* 0x42cf936c */ }; static const float pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ 1.0771083225e-07, /* 0x33e74ea8 */ 1.1717621982e-01, /* 0x3deffa16 */ 2.3685150146e+00, /* 0x401795c0 */ 1.2242610931e+01, /* 0x4143e1bc */ 1.7693971634e+01, /* 0x418d8d41 */ 5.0735230446e+00, /* 0x40a25a4d */ }; static const float ps2[5] = { 2.1436485291e+01, /* 0x41ab7dec */ 1.2529022980e+02, /* 0x42fa9499 */ 2.3227647400e+02, /* 0x436846c7 */ 1.1767937469e+02, /* 0x42eb5bd7 */ 8.3646392822e+00, /* 0x4105d590 */ }; static float ponef(float x) { const float *p,*q; float z,r,s; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x41000000) {p = pr8; q= ps8;} else if(ix>=0x40f71c58){p = pr5; q= ps5;} else if(ix>=0x4036db68){p = pr3; q= ps3;} else if(ix>=0x40000000){p = pr2; q= ps2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); return one+ r/s; } /* For x >= 8, the asymptotic expansions of qone is * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. * We approximate pone by * qone(x) = s*(0.375 + (R/S)) * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10 * S = 1 + qs1*s^2 + ... + qs6*s^12 * and * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13) */ static const float qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ 0.0000000000e+00, /* 0x00000000 */ -1.0253906250e-01, /* 0xbdd20000 */ -1.6271753311e+01, /* 0xc1822c8d */ -7.5960174561e+02, /* 0xc43de683 */ -1.1849806641e+04, /* 0xc639273a */ -4.8438511719e+04, /* 0xc73d3683 */ }; static const float qs8[6] = { 1.6139537048e+02, /* 0x43216537 */ 7.8253862305e+03, /* 0x45f48b17 */ 1.3387534375e+05, /* 0x4802bcd6 */ 7.1965775000e+05, /* 0x492fb29c */ 6.6660125000e+05, /* 0x4922be94 */ -2.9449025000e+05, /* 0xc88fcb48 */ }; static const float qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ -2.0897993405e-11, /* 0xadb7d219 */ -1.0253904760e-01, /* 0xbdd1fffe */ -8.0564479828e+00, /* 0xc100e736 */ -1.8366960144e+02, /* 0xc337ab6b */ -1.3731937256e+03, /* 0xc4aba633 */ -2.6124443359e+03, /* 0xc523471c */ }; static const float qs5[6] = { 8.1276550293e+01, /* 0x42a28d98 */ 1.9917987061e+03, /* 0x44f8f98f */ 1.7468484375e+04, /* 0x468878f8 */ 4.9851425781e+04, /* 0x4742bb6d */ 2.7948074219e+04, /* 0x46da5826 */ -4.7191835938e+03, /* 0xc5937978 */ }; static const float qr3[6] = { -5.0783124372e-09, /* 0xb1ae7d4f */ -1.0253783315e-01, /* 0xbdd1ff5b */ -4.6101160049e+00, /* 0xc0938612 */ -5.7847221375e+01, /* 0xc267638e */ -2.2824453735e+02, /* 0xc3643e9a */ -2.1921012878e+02, /* 0xc35b35cb */ }; static const float qs3[6] = { 4.7665153503e+01, /* 0x423ea91e */ 6.7386511230e+02, /* 0x4428775e */ 3.3801528320e+03, /* 0x45534272 */ 5.5477290039e+03, /* 0x45ad5dd5 */ 1.9031191406e+03, /* 0x44ede3d0 */ -1.3520118713e+02, /* 0xc3073381 */ }; static const float qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ -1.7838172539e-07, /* 0xb43f8932 */ -1.0251704603e-01, /* 0xbdd1f475 */ -2.7522056103e+00, /* 0xc0302423 */ -1.9663616180e+01, /* 0xc19d4f16 */ -4.2325313568e+01, /* 0xc2294d1f */ -2.1371921539e+01, /* 0xc1aaf9b2 */ }; static const float qs2[6] = { 2.9533363342e+01, /* 0x41ec4454 */ 2.5298155212e+02, /* 0x437cfb47 */ 7.5750280762e+02, /* 0x443d602e */ 7.3939318848e+02, /* 0x4438d92a */ 1.5594900513e+02, /* 0x431bf2f2 */ -4.9594988823e+00, /* 0xc09eb437 */ }; static float qonef(float x) { const float *p,*q; float s,r,z; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix>=0x40200000) {p = qr8; q= qs8;} else if(ix>=0x40f71c58){p = qr5; q= qs5;} else if(ix>=0x4036db68){p = qr3; q= qs3;} else if(ix>=0x40000000){p = qr2; q= qs2;} z = one/(x*x); r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); return ((float).375 + r/s)/x; } --- NEW FILE: e_jn.c --- /* @(#)e_jn.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_jn.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* * __ieee754_jn(n, x), __ieee754_yn(n, x) * floating point Bessel's function of the 1st and 2nd kind * of order n * * Special cases: * y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal; * y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal. * Note 2. About jn(n,x), yn(n,x) * For n=0, j0(x) is called, * for n=1, j1(x) is called, * for n<x, forward recursion us used starting * from values of j0(x) and j1(x). * for n>x, a continued fraction approximation to * j(n,x)/j(n-1,x) is evaluated and then backward * recursion is used starting from a supposed value * for j(n,x). The resulting value of j(0,x) is * compared with the actual value to correct the * supposed value of j(n,x). * * yn(n,x) is similar in all respects, except * that forward recursion is used for all * values of n>1. * */ #include "math.h" #include "math_private.h" static const double invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */ one = 1.00000000000000000000e+00; /* 0x3FF00000, 0x00000000 */ static const double zero = 0.00000000000000000000e+00; double __ieee754_jn(int n, double x) { int32_t i,hx,ix,lx, sgn; double a, b, temp, di; double z, w; /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) * Thus, J(-n,x) = J(n,-x) */ EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* if J(n,NaN) is NaN */ if((ix|((u_int32_t)(lx|-lx))>>31)>0x7ff00000) return x+x; if(n<0){ n = -n; x = -x; hx ^= 0x80000000; } if(n==0) return(__ieee754_j0(x)); if(n==1) return(__ieee754_j1(x)); sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */ x = fabs(x); if((ix|lx)==0||ix>=0x7ff00000) /* if x is 0 or inf */ b = zero; else if((double)n<=x) { /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ if(ix>=0x52D00000) { /* x > 2**302 */ /* (x >> n**2) * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Let s=sin(x), c=cos(x), * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then * * n sin(xn)*sqt2 cos(xn)*sqt2 * ---------------------------------- * 0 s-c c+s * 1 -s-c -c+s * 2 -s+c -c-s * 3 s+c c-s */ switch(n&3) { case 0: temp = cos(x)+sin(x); break; case 1: temp = -cos(x)+sin(x); break; case 2: temp = -cos(x)-sin(x); break; case 3: temp = cos(x)-sin(x); break; } b = invsqrtpi*temp/sqrt(x); } else { a = __ieee754_j0(x); b = __ieee754_j1(x); for(i=1;i<n;i++){ temp = b; b = b*((double)(i+i)/x) - a; /* avoid underflow */ a = temp; } } } else { if(ix<0x3e100000) { /* x < 2**-29 */ /* x is tiny, return the first Taylor expansion of J(n,x) * J(n,x) = 1/n!*(x/2)^n - ... */ if(n>33) /* underflow */ b = zero; else { temp = x*0.5; b = temp; for (a=one,i=2;i<=n;i++) { a *= (double)i; /* a = n! */ b *= temp; /* b = (x/2)^n */ } b = b/a; } } else { /* use backward recurrence */ /* x x^2 x^2 * J(n,x)/J(n-1,x) = ---- ------ ------ ..... * 2n - 2(n+1) - 2(n+2) * * 1 1 1 * (for large x) = ---- ------ ------ ..... * 2n 2(n+1) 2(n+2) * -- - ------ - ------ - * x x x * * Let w = 2n/x and h=2/x, then the above quotient * is equal to the continued fraction: * 1 * = ----------------------- * 1 * w - ----------------- * 1 * w+h - --------- * w+2h - ... * * To determine how many terms needed, let * Q(0) = w, Q(1) = w(w+h) - 1, * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), * When Q(k) > 1e4 good for single * When Q(k) > 1e9 good for double * When Q(k) > 1e17 good for quadruple */ /* determine k */ double t,v; double q0,q1,h,tmp; int32_t k,m; w = (n+n)/(double)x; h = 2.0/(double)x; q0 = w; z = w+h; q1 = w*z - 1.0; k=1; while(q1<1.0e9) { k += 1; z += h; tmp = z*q1 - q0; q0 = q1; q1 = tmp; } m = n+n; for(t=zero, i = 2*(n+k); i>=m; i -= 2) t = one/(i/x-t); a = t; b = one; /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) * Hence, if n*(log(2n/x)) > ... * single 8.8722839355e+01 * double 7.09782712893383973096e+02 * long double 1.1356523406294143949491931077970765006170e+04 * then recurrent value may overflow and the result is * likely underflow to zero */ tmp = n; v = two/x; tmp = tmp*__ieee754_log(fabs(v*tmp)); if(tmp<7.09782712893383973096e+02) { for(i=n-1,di=(double)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; } } else { for(i=n-1,di=(double)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; /* scale b to avoid spurious overflow */ if(b>1e100) { a /= b; t /= b; b = one; } } } b = (t*__ieee754_j0(x)/b); } } if(sgn==1) return -b; else return b; } double __ieee754_yn(int n, double x) { int32_t i,hx,ix,lx; int32_t sign; double a, b, temp; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; /* if Y(n,NaN) is NaN */ if((ix|((u_int32_t)(lx|-lx))>>31)>0x7ff00000) return x+x; if((ix|lx)==0) return -one/zero; if(hx<0) return zero/zero; sign = 1; if(n<0){ n = -n; sign = 1 - ((n&1)<<1); } if(n==0) return(__ieee754_y0(x)); if(n==1) return(sign*__ieee754_y1(x)); if(ix==0x7ff00000) return zero; if(ix>=0x52D00000) { /* x > 2**302 */ /* (x >> n**2) * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) * Let s=sin(x), c=cos(x), * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then * * n sin(xn)*sqt2 cos(xn)*sqt2 * ---------------------------------- * 0 s-c c+s * 1 -s-c -c+s * 2 -s+c -c-s * 3 s+c c-s */ switch(n&3) { case 0: temp = sin(x)-cos(x); break; case 1: temp = -sin(x)-cos(x); break; case 2: temp = -sin(x)+cos(x); break; case 3: temp = sin(x)+cos(x); break; } b = invsqrtpi*temp/sqrt(x); } else { u_int32_t high; a = __ieee754_y0(x); b = __ieee754_y1(x); /* quit if b is -inf */ GET_HIGH_WORD(high,b); for(i=1;i<n&&high!=0xfff00000;i++){ temp = b; b = ((double)(i+i)/x)*b - a; GET_HIGH_WORD(high,b); a = temp; } } if(sign>0) return b; else return -b; } --- NEW FILE: e_jnf.c --- /* e_jnf.c -- float version of e_jn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_jnf.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float invsqrtpi= 5.6418961287e-01, /* 0x3f106ebb */ two = 2.0000000000e+00, /* 0x40000000 */ one = 1.0000000000e+00; /* 0x3F800000 */ static const float zero = 0.0000000000e+00; float __ieee754_jnf(int n, float x) { int32_t i,hx,ix, sgn; float a, b, temp, di; float z, w; /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) * Thus, J(-n,x) = J(n,-x) */ GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* if J(n,NaN) is NaN */ if(ix>0x7f800000) return x+x; if(n<0){ n = -n; x = -x; hx ^= 0x80000000; } if(n==0) return(__ieee754_j0f(x)); if(n==1) return(__ieee754_j1f(x)); sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */ x = fabsf(x); if(ix==0||ix>=0x7f800000) /* if x is 0 or inf */ b = zero; else if((float)n<=x) { /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ a = __ieee754_j0f(x); b = __ieee754_j1f(x); for(i=1;i<n;i++){ temp = b; b = b*((float)(i+i)/x) - a; /* avoid underflow */ a = temp; } } else { if(ix<0x30800000) { /* x < 2**-29 */ /* x is tiny, return the first Taylor expansion of J(n,x) * J(n,x) = 1/n!*(x/2)^n - ... */ if(n>33) /* underflow */ b = zero; else { temp = x*(float)0.5; b = temp; for (a=one,i=2;i<=n;i++) { a *= (float)i; /* a = n! */ b *= temp; /* b = (x/2)^n */ } b = b/a; } } else { /* use backward recurrence */ /* x x^2 x^2 * J(n,x)/J(n-1,x) = ---- ------ ------ ..... * 2n - 2(n+1) - 2(n+2) * * 1 1 1 * (for large x) = ---- ------ ------ ..... * 2n 2(n+1) 2(n+2) * -- - ------ - ------ - * x x x * * Let w = 2n/x and h=2/x, then the above quotient * is equal to the continued fraction: * 1 * = ----------------------- * 1 * w - ----------------- * 1 * w+h - --------- * w+2h - ... * * To determine how many terms needed, let * Q(0) = w, Q(1) = w(w+h) - 1, * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), * When Q(k) > 1e4 good for single * When Q(k) > 1e9 good for double * When Q(k) > 1e17 good for quadruple */ /* determine k */ float t,v; float q0,q1,h,tmp; int32_t k,m; w = (n+n)/(float)x; h = (float)2.0/(float)x; q0 = w; z = w+h; q1 = w*z - (float)1.0; k=1; while(q1<(float)1.0e9) { k += 1; z += h; tmp = z*q1 - q0; q0 = q1; q1 = tmp; } m = n+n; for(t=zero, i = 2*(n+k); i>=m; i -= 2) t = one/(i/x-t); a = t; b = one; /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) * Hence, if n*(log(2n/x)) > ... * single 8.8722839355e+01 * double 7.09782712893383973096e+02 * long double 1.1356523406294143949491931077970765006170e+04 * then recurrent value may overflow and the result is * likely underflow to zero */ tmp = n; v = two/x; tmp = tmp*__ieee754_logf(fabsf(v*tmp)); if(tmp<(float)8.8721679688e+01) { for(i=n-1,di=(float)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; } } else { for(i=n-1,di=(float)(i+i);i>0;i--){ temp = b; b *= di; b = b/x - a; a = temp; di -= two; /* scale b to avoid spurious overflow */ if(b>(float)1e10) { a /= b; t /= b; b = one; } } } b = (t*__ieee754_j0f(x)/b); } } if(sgn==1) return -b; else return b; } float __ieee754_ynf(int n, float x) { int32_t i,hx,ix,ib; int32_t sign; float a, b, temp; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; /* if Y(n,NaN) is NaN */ if(ix>0x7f800000) return x+x; if(ix==0) return -one/zero; if(hx<0) return zero/zero; sign = 1; if(n<0){ n = -n; sign = 1 - ((n&1)<<1); } if(n==0) return(__ieee754_y0f(x)); if(n==1) return(sign*__ieee754_y1f(x)); if(ix==0x7f800000) return zero; a = __ieee754_y0f(x); b = __ieee754_y1f(x); /* quit if b is -inf */ GET_FLOAT_WORD(ib,b); for(i=1;i<n&&ib!=0xff800000;i++){ temp = b; b = ((float)(i+i)/x)*b - a; GET_FLOAT_WORD(ib,b); a = temp; } if(sign>0) return b; else return -b; } --- NEW FILE: e_lgamma.c --- /* @(#)e_lgamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_lgamma.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* __ieee754_lgamma(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_lgamma_r */ #include "math.h" #include "math_private.h" extern int signgam; double __ieee754_lgamma(double x) { return __ieee754_lgamma_r(x,&signgam); } --- NEW FILE: e_lgamma_r.c --- /* @(#)er_lgamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_lgamma_r.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* __ieee754_lgamma_r(x, signgamp) * Reentrant version of the logarithm of the Gamma function * with user provide pointer for the sign of Gamma(x). * * Method: * 1. Argument Reduction for 0 < x <= 8 * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may * reduce x to a number in [1.5,2.5] by * lgamma(1+s) = log(s) + lgamma(s) * for example, * lgamma(7.3) = log(6.3) + lgamma(6.3) * = log(6.3*5.3) + lgamma(5.3) * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3) * 2. Polynomial approximation of lgamma around its * minimun ymin=1.461632144968362245 to maintain monotonicity. * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use * Let z = x-ymin; * lgamma(x) = -1.214862905358496078218 + z^2*poly(z) * where * poly(z) is a 14 degree polynomial. * 2. Rational approximation in the primary interval [2,3] * We use the following approximation: * s = x-2.0; * lgamma(x) = 0.5*s + s*P(s)/Q(s) * with accuracy * |P/Q - (lgamma(x)-0.5s)| < 2**-61.71 * Our algorithms are based on the following observation * * zeta(2)-1 2 zeta(3)-1 3 * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ... * 2 3 * * where Euler = 0.5771... is the Euler constant, which is very * close to 0.5. * * 3. For x>=8, we have * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+.... * (better formula: * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...) * Let z = 1/x, then we approximation * f(z) = lgamma(x) - (x-0.5)(log(x)-1) * by * 3 5 11 * w = w0 + w1*z + w2*z + w3*z + ... + w6*z * where * |w - f(z)| < 2**-58.74 * * 4. For negative x, since (G is gamma function) * -x*G(-x)*G(x) = pi/sin(pi*x), * we have * G(x) = pi/(sin(pi*x)*(-x)*G(-x)) * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0 * Hence, for x<0, signgam = sign(sin(pi*x)) and * lgamma(x) = log(|Gamma(x)|) * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x); * Note: one should avoid compute pi*(-x) directly in the * computation of sin(pi*(-x)). * * 5. Special Cases * lgamma(2+s) ~ s*(1-Euler) for tiny s * lgamma(1)=lgamma(2)=0 * lgamma(x) ~ -log(x) for tiny x * lgamma(0) = lgamma(inf) = inf * lgamma(-integer) = +-inf * */ #include "math.h" #include "math_private.h" static const double two52= 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */ a0 = 7.72156649015328655494e-02, /* 0x3FB3C467, 0xE37DB0C8 */ a1 = 3.22467033424113591611e-01, /* 0x3FD4A34C, 0xC4A60FAD */ a2 = 6.73523010531292681824e-02, /* 0x3FB13E00, 0x1A5562A7 */ a3 = 2.05808084325167332806e-02, /* 0x3F951322, 0xAC92547B */ a4 = 7.38555086081402883957e-03, /* 0x3F7E404F, 0xB68FEFE8 */ a5 = 2.89051383673415629091e-03, /* 0x3F67ADD8, 0xCCB7926B */ a6 = 1.19270763183362067845e-03, /* 0x3F538A94, 0x116F3F5D */ a7 = 5.10069792153511336608e-04, /* 0x3F40B6C6, 0x89B99C00 */ a8 = 2.20862790713908385557e-04, /* 0x3F2CF2EC, 0xED10E54D */ a9 = 1.08011567247583939954e-04, /* 0x3F1C5088, 0x987DFB07 */ a10 = 2.52144565451257326939e-05, /* 0x3EFA7074, 0x428CFA52 */ a11 = 4.48640949618915160150e-05, /* 0x3F07858E, 0x90A45837 */ tc = 1.46163214496836224576e+00, /* 0x3FF762D8, 0x6356BE3F */ tf = -1.21486290535849611461e-01, /* 0xBFBF19B9, 0xBCC38A42 */ /* tt = -(tail of tf) */ tt = -3.63867699703950536541e-18, /* 0xBC50C7CA, 0xA48A971F */ t0 = 4.83836122723810047042e-01, /* 0x3FDEF72B, 0xC8EE38A2 */ t1 = -1.47587722994593911752e-01, /* 0xBFC2E427, 0x8DC6C509 */ t2 = 6.46249402391333854778e-02, /* 0x3FB08B42, 0x94D5419B */ t3 = -3.27885410759859649565e-02, /* 0xBFA0C9A8, 0xDF35B713 */ t4 = 1.79706750811820387126e-02, /* 0x3F9266E7, 0x970AF9EC */ t5 = -1.03142241298341437450e-02, /* 0xBF851F9F, 0xBA91EC6A */ t6 = 6.10053870246291332635e-03, /* 0x3F78FCE0, 0xE370E344 */ t7 = -3.68452016781138256760e-03, /* 0xBF6E2EFF, 0xB3E914D7 */ t8 = 2.25964780900612472250e-03, /* 0x3F6282D3, 0x2E15C915 */ t9 = -1.40346469989232843813e-03, /* 0xBF56FE8E, 0xBF2D1AF1 */ t10 = 8.81081882437654011382e-04, /* 0x3F4CDF0C, 0xEF61A8E9 */ t11 = -5.38595305356740546715e-04, /* 0xBF41A610, 0x9C73E0EC */ t12 = 3.15632070903625950361e-04, /* 0x3F34AF6D, 0x6C0EBBF7 */ t13 = -3.12754168375120860518e-04, /* 0xBF347F24, 0xECC38C38 */ t14 = 3.35529192635519073543e-04, /* 0x3F35FD3E, 0xE8C2D3F4 */ u0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */ u1 = 6.32827064025093366517e-01, /* 0x3FE4401E, 0x8B005DFF */ u2 = 1.45492250137234768737e+00, /* 0x3FF7475C, 0xD119BD6F */ u3 = 9.77717527963372745603e-01, /* 0x3FEF4976, 0x44EA8450 */ u4 = 2.28963728064692451092e-01, /* 0x3FCD4EAE, 0xF6010924 */ u5 = 1.33810918536787660377e-02, /* 0x3F8B678B, 0xBF2BAB09 */ v1 = 2.45597793713041134822e+00, /* 0x4003A5D7, 0xC2BD619C */ v2 = 2.12848976379893395361e+00, /* 0x40010725, 0xA42B18F5 */ v3 = 7.69285150456672783825e-01, /* 0x3FE89DFB, 0xE45050AF */ v4 = 1.04222645593369134254e-01, /* 0x3FBAAE55, 0xD6537C88 */ v5 = 3.21709242282423911810e-03, /* 0x3F6A5ABB, 0x57D0CF61 */ s0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */ s1 = 2.14982415960608852501e-01, /* 0x3FCB848B, 0x36E20878 */ s2 = 3.25778796408930981787e-01, /* 0x3FD4D98F, 0x4F139F59 */ s3 = 1.46350472652464452805e-01, /* 0x3FC2BB9C, 0xBEE5F2F7 */ s4 = 2.66422703033638609560e-02, /* 0x3F9B481C, 0x7E939961 */ s5 = 1.84028451407337715652e-03, /* 0x3F5E26B6, 0x7368F239 */ s6 = 3.19475326584100867617e-05, /* 0x3F00BFEC, 0xDD17E945 */ r1 = 1.39200533467621045958e+00, /* 0x3FF645A7, 0x62C4AB74 */ r2 = 7.21935547567138069525e-01, /* 0x3FE71A18, 0x93D3DCDC */ r3 = 1.71933865632803078993e-01, /* 0x3FC601ED, 0xCCFBDF27 */ r4 = 1.86459191715652901344e-02, /* 0x3F9317EA, 0x742ED475 */ r5 = 7.77942496381893596434e-04, /* 0x3F497DDA, 0xCA41A95B */ r6 = 7.32668430744625636189e-06, /* 0x3EDEBAF7, 0xA5B38140 */ w0 = 4.18938533204672725052e-01, /* 0x3FDACFE3, 0x90C97D69 */ w1 = 8.33333333333329678849e-02, /* 0x3FB55555, 0x5555553B */ w2 = -2.77777777728775536470e-03, /* 0xBF66C16C, 0x16B02E5C */ w3 = 7.93650558643019558500e-04, /* 0x3F4A019F, 0x98CF38B6 */ w4 = -5.95187557450339963135e-04, /* 0xBF4380CB, 0x8C0FE741 */ w5 = 8.36339918996282139126e-04, /* 0x3F4B67BA, 0x4CDAD5D1 */ w6 = -1.63092934096575273989e-03; /* 0xBF5AB89D, 0x0B9E43E4 */ static const double zero= 0.00000000000000000000e+00; static double sin_pi(double x) { double y,z; int n,ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; if(ix<0x3fd00000) return __kernel_sin(pi*x,zero,0); y = -x; /* x is assume negative */ /* * argument reduction, make sure inexact flag not raised if input * is an integer */ z = floor(y); if(z!=y) { /* inexact anyway */ y *= 0.5; y = 2.0*(y - floor(y)); /* y = |x| mod 2.0 */ n = (int) (y*4.0); } else { if(ix>=0x43400000) { y = zero; n = 0; /* y must be even */ } else { if(ix<0x43300000) z = y+two52; /* exact */ GET_LOW_WORD(n,z); n &= 1; y = n; n<<= 2; } } switch (n) { case 0: y = __kernel_sin(pi*y,zero,0); break; case 1: case 2: y = __kernel_cos(pi*(0.5-y),zero); break; case 3: case 4: y = __kernel_sin(pi*(one-y),zero,0); break; case 5: case 6: y = -__kernel_cos(pi*(y-1.5),zero); break; default: y = __kernel_sin(pi*(y-2.0),zero,0); break; } return -y; } double __ieee754_lgamma_r(double x, int *signgamp) { double t,y,z,nadj,p,p1,p2,p3,q,r,w; int i,hx,lx,ix; EXTRACT_WORDS(hx,lx,x); /* purge off +-inf, NaN, +-0, and negative arguments */ *signgamp = 1; ix = hx&0x7fffffff; if(ix>=0x7ff00000) return x*x; if((ix|lx)==0) return one/zero; if(ix<0x3b900000) { /* |x|<2**-70, return -log(|x|) */ if(hx<0) { *signgamp = -1; return -__ieee754_log(-x); } else return -__ieee754_log(x); } if(hx<0) { if(ix>=0x43300000) /* |x|>=2**52, must be -integer */ return one/zero; t = sin_pi(x); if(t==zero) return one/zero; /* -integer */ nadj = __ieee754_log(pi/fabs(t*x)); if(t<zero) *signgamp = -1; x = -x; } /* purge off 1 and 2 */ if((((ix-0x3ff00000)|lx)==0)||(((ix-0x40000000)|lx)==0)) r = 0; /* for x < 2.0 */ else if(ix<0x40000000) { if(ix<=0x3feccccc) { /* lgamma(x) = lgamma(x+1)-log(x) */ r = -__ieee754_log(x); if(ix>=0x3FE76944) {y = one-x; i= 0;} else if(ix>=0x3FCDA661) {y= x-(tc-one); i=1;} else {y = x; i=2;} } else { r = zero; if(ix>=0x3FFBB4C3) {y=2.0-x;i=0;} /* [1.7316,2] */ else if(ix>=0x3FF3B4C4) {y=x-tc;i=1;} /* [1.23,1.73] */ else {y=x-one;i=2;} } switch(i) { case 0: z = y*y; p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10)))); p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11))))); p = y*p1+p2; r += (p-0.5*y); break; case 1: z = y*y; w = z*y; p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13))); p3 = t2+w*(t5+w*(t8+w*(t11+w*t14))); p = z*p1-(tt-w*(p2+y*p3)); r += (tf + p); break; case 2: p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5))))); p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5)))); r += (-0.5*y + p1/p2); } } else if(ix<0x40200000) { /* x < 8.0 */ i = (int)x; t = zero; y = x-(double)i; p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6))))); r = half*y+p/q; z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ switch(i) { case 7: z *= (y+6.0); /* FALLTHRU */ case 6: z *= (y+5.0); /* FALLTHRU */ case 5: z *= (y+4.0); /* FALLTHRU */ case 4: z *= (y+3.0); /* FALLTHRU */ case 3: z *= (y+2.0); /* FALLTHRU */ r += __ieee754_log(z); break; } /* 8.0 <= x < 2**58 */ } else if (ix < 0x43900000) { t = __ieee754_log(x); z = one/x; y = z*z; w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); r = (x-half)*(t-one)+w; } else /* 2**58 <= x <= inf */ r = x*(__ieee754_log(x)-one); if(hx<0) r = nadj - r; return r; } --- NEW FILE: e_lgammaf.c --- /* e_lgammaf.c -- float version of e_lgamma.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_lgammaf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* __ieee754_lgammaf(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_lgammaf_r */ #include "math.h" #include "math_private.h" extern int signgam; float __ieee754_lgammaf(float x) { return __ieee754_lgammaf_r(x,&signgam); } --- NEW FILE: e_lgammaf_r.c --- /* e_lgammaf_r.c -- float version of e_lgamma_r.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_lgammaf_r.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float two23= 8.3886080000e+06, /* 0x4b000000 */ half= 5.0000000000e-01, /* 0x3f000000 */ one = 1.0000000000e+00, /* 0x3f800000 */ pi = 3.1415927410e+00, /* 0x40490fdb */ a0 = 7.7215664089e-02, /* 0x3d9e233f */ a1 = 3.2246702909e-01, /* 0x3ea51a66 */ a2 = 6.7352302372e-02, /* 0x3d89f001 */ a3 = 2.0580807701e-02, /* 0x3ca89915 */ a4 = 7.3855509982e-03, /* 0x3bf2027e */ a5 = 2.8905137442e-03, /* 0x3b3d6ec6 */ a6 = 1.1927076848e-03, /* 0x3a9c54a1 */ a7 = 5.1006977446e-04, /* 0x3a05b634 */ a8 = 2.2086278477e-04, /* 0x39679767 */ a9 = 1.0801156895e-04, /* 0x38e28445 */ a10 = 2.5214456400e-05, /* 0x37d383a2 */ a11 = 4.4864096708e-05, /* 0x383c2c75 */ tc = 1.4616321325e+00, /* 0x3fbb16c3 */ tf = -1.2148628384e-01, /* 0xbdf8cdcd */ /* tt = -(tail of tf) */ tt = 6.6971006518e-09, /* 0x31e61c52 */ t0 = 4.8383611441e-01, /* 0x3ef7b95e */ t1 = -1.4758771658e-01, /* 0xbe17213c */ t2 = 6.4624942839e-02, /* 0x3d845a15 */ t3 = -3.2788541168e-02, /* 0xbd064d47 */ t4 = 1.7970675603e-02, /* 0x3c93373d */ t5 = -1.0314224288e-02, /* 0xbc28fcfe */ t6 = 6.1005386524e-03, /* 0x3bc7e707 */ t7 = -3.6845202558e-03, /* 0xbb7177fe */ t8 = 2.2596477065e-03, /* 0x3b141699 */ t9 = -1.4034647029e-03, /* 0xbab7f476 */ t10 = 8.8108185446e-04, /* 0x3a66f867 */ t11 = -5.3859531181e-04, /* 0xba0d3085 */ t12 = 3.1563205994e-04, /* 0x39a57b6b */ t13 = -3.1275415677e-04, /* 0xb9a3f927 */ t14 = 3.3552918467e-04, /* 0x39afe9f7 */ u0 = -7.7215664089e-02, /* 0xbd9e233f */ u1 = 6.3282704353e-01, /* 0x3f2200f4 */ u2 = 1.4549225569e+00, /* 0x3fba3ae7 */ u3 = 9.7771751881e-01, /* 0x3f7a4bb2 */ u4 = 2.2896373272e-01, /* 0x3e6a7578 */ u5 = 1.3381091878e-02, /* 0x3c5b3c5e */ v1 = 2.4559779167e+00, /* 0x401d2ebe */ v2 = 2.1284897327e+00, /* 0x4008392d */ v3 = 7.6928514242e-01, /* 0x3f44efdf */ v4 = 1.0422264785e-01, /* 0x3dd572af */ v5 = 3.2170924824e-03, /* 0x3b52d5db */ s0 = -7.7215664089e-02, /* 0xbd9e233f */ s1 = 2.1498242021e-01, /* 0x3e5c245a */ s2 = 3.2577878237e-01, /* 0x3ea6cc7a */ s3 = 1.4635047317e-01, /* 0x3e15dce6 */ s4 = 2.6642270386e-02, /* 0x3cda40e4 */ s5 = 1.8402845599e-03, /* 0x3af135b4 */ s6 = 3.1947532989e-05, /* 0x3805ff67 */ r1 = 1.3920053244e+00, /* 0x3fb22d3b */ r2 = 7.2193557024e-01, /* 0x3f38d0c5 */ r3 = 1.7193385959e-01, /* 0x3e300f6e */ r4 = 1.8645919859e-02, /* 0x3c98bf54 */ r5 = 7.7794247773e-04, /* 0x3a4beed6 */ r6 = 7.3266842264e-06, /* 0x36f5d7bd */ w0 = 4.1893854737e-01, /* 0x3ed67f1d */ w1 = 8.3333335817e-02, /* 0x3daaaaab */ w2 = -2.7777778450e-03, /* 0xbb360b61 */ w3 = 7.9365057172e-04, /* 0x3a500cfd */ w4 = -5.9518753551e-04, /* 0xba1c065c */ w5 = 8.3633989561e-04, /* 0x3a5b3dd2 */ w6 = -1.6309292987e-03; /* 0xbad5c4e8 */ static const float zero= 0.0000000000e+00; static float sin_pif(float x) { float y,z; int n,ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; if(ix<0x3e800000) return __kernel_sinf(pi*x,zero,0); y = -x; /* x is assume negative */ /* * argument reduction, make sure inexact flag not raised if input * is an integer */ z = floorf(y); if(z!=y) { /* inexact anyway */ y *= (float)0.5; y = (float)2.0*(y - floorf(y)); /* y = |x| mod 2.0 */ n = (int) (y*(float)4.0); } else { if(ix>=0x4b800000) { y = zero; n = 0; /* y must be even */ } else { if(ix<0x4b000000) z = y+two23; /* exact */ GET_FLOAT_WORD(n,z); n &= 1; y = n; n<<= 2; } } switch (n) { case 0: y = __kernel_sinf(pi*y,zero,0); break; case 1: case 2: y = __kernel_cosf(pi*((float)0.5-y),zero); break; case 3: case 4: y = __kernel_sinf(pi*(one-y),zero,0); break; case 5: case 6: y = -__kernel_cosf(pi*(y-(float)1.5),zero); break; default: y = __kernel_sinf(pi*(y-(float)2.0),zero,0); break; } return -y; } float __ieee754_lgammaf_r(float x, int *signgamp) { float t,y,z,nadj,p,p1,p2,p3,q,r,w; int i,hx,ix; GET_FLOAT_WORD(hx,x); /* purge off +-inf, NaN, +-0, and negative arguments */ *signgamp = 1; ix = hx&0x7fffffff; if(ix>=0x7f800000) return x*x; if(ix==0) return one/zero; if(ix<0x1c800000) { /* |x|<2**-70, return -log(|x|) */ if(hx<0) { *signgamp = -1; return -__ieee754_logf(-x); } else return -__ieee754_logf(x); } if(hx<0) { if(ix>=0x4b000000) /* |x|>=2**23, must be -integer */ return one/zero; t = sin_pif(x); if(t==zero) return one/zero; /* -integer */ nadj = __ieee754_logf(pi/fabsf(t*x)); if(t<zero) *signgamp = -1; x = -x; } /* purge off 1 and 2 */ if (ix==0x3f800000||ix==0x40000000) r = 0; /* for x < 2.0 */ else if(ix<0x40000000) { if(ix<=0x3f666666) { /* lgamma(x) = lgamma(x+1)-log(x) */ r = -__ieee754_logf(x); if(ix>=0x3f3b4a20) {y = one-x; i= 0;} else if(ix>=0x3e6d3308) {y= x-(tc-one); i=1;} else {y = x; i=2;} } else { r = zero; if(ix>=0x3fdda618) {y=(float)2.0-x;i=0;} /* [1.7316,2] */ else if(ix>=0x3F9da620) {y=x-tc;i=1;} /* [1.23,1.73] */ else {y=x-one;i=2;} } switch(i) { case 0: z = y*y; p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10)))); p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11))))); p = y*p1+p2; r += (p-(float)0.5*y); break; case 1: z = y*y; w = z*y; p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13))); p3 = t2+w*(t5+w*(t8+w*(t11+w*t14))); p = z*p1-(tt-w*(p2+y*p3)); r += (tf + p); break; case 2: p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5))))); p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5)))); r += (-(float)0.5*y + p1/p2); } } else if(ix<0x41000000) { /* x < 8.0 */ i = (int)x; t = zero; y = x-(float)i; p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6))))); r = half*y+p/q; z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ switch(i) { case 7: z *= (y+(float)6.0); /* FALLTHRU */ case 6: z *= (y+(float)5.0); /* FALLTHRU */ case 5: z *= (y+(float)4.0); /* FALLTHRU */ case 4: z *= (y+(float)3.0); /* FALLTHRU */ case 3: z *= (y+(float)2.0); /* FALLTHRU */ r += __ieee754_logf(z); break; } /* 8.0 <= x < 2**58 */ } else if (ix < 0x5c800000) { t = __ieee754_logf(x); z = one/x; y = z*z; w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); r = (x-half)*(t-one)+w; } else /* 2**58 <= x <= inf */ r = x*(__ieee754_logf(x)-one); if(hx<0) r = nadj - r; return r; } --- NEW FILE: e_log.c --- /* @(#)e_log.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_log.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_log(x) * Return the logrithm of x * * Method : * 1. Argument Reduction: find k and f such that * x = 2^k * (1+f), * where sqrt(2)/2 < 1+f < sqrt(2) . * * 2. Approximation of log(1+f). * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) * = 2s + 2/3 s**3 + 2/5 s**5 + ....., * = 2s + s*R * We use a special Reme algorithm on [0,0.1716] to generate * a polynomial of degree 14 to approximate R The maximum error * of this polynomial approximation is bounded by 2**-58.45. In * other words, * 2 4 6 8 10 12 14 * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s * (the values of Lg1 to Lg7 are listed in the program) * and * | 2 14 | -58.45 * | Lg1*s +...+Lg7*s - R(z) | <= 2 * | | * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. * In order to guarantee error in log below 1ulp, we compute log * by * log(1+f) = f - s*(f - R) (if f is not too large) * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy) * * 3. Finally, log(x) = k*ln2 + log(1+f). * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) * Here ln2 is split into two floating point number: * ln2_hi + ln2_lo, * where n*ln2_hi is always exact for |n| < 2000. * * Special cases: * log(x) is NaN with signal if x < 0 (including -INF) ; * log(+INF) is +INF; log(0) is -INF with signal; * log(NaN) is that NaN with no signal. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const double ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ static const double zero = 0.0; double __ieee754_log(double x) { double hfsq,f,s,z,R,w,t1,t2,dk; int32_t k,hx,i,j; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ if (((hx&0x7fffffff)|lx)==0) return -two54/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ GET_HIGH_WORD(hx,x); } if (hx >= 0x7ff00000) return x+x; k += (hx>>20)-1023; hx &= 0x000fffff; i = (hx+0x95f64)&0x100000; SET_HIGH_WORD(x,hx|(i^0x3ff00000)); /* normalize x or x/2 */ k += (i>>20); f = x-1.0; if((0x000fffff&(2+hx))<3) { /* |f| < 2**-20 */ if(f==zero) if(k==0) return zero; else {dk=(double)k; return dk*ln2_hi+dk*ln2_lo;} R = f*f*(0.5-0.33333333333333333*f); if(k==0) return f-R; else {dk=(double)k; return dk*ln2_hi-((R-dk*ln2_lo)-f);} } s = f/(2.0+f); dk = (double)k; z = s*s; i = hx-0x6147a; w = z*z; j = 0x6b851-hx; t1= w*(Lg2+w*(Lg4+w*Lg6)); t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7))); i |= j; R = t2+t1; if(i>0) { hfsq=0.5*f*f; if(k==0) return f-(hfsq-s*(hfsq+R)); else return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f); } else { if(k==0) return f-s*(f-R); else return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f); } } --- NEW FILE: e_log10.c --- /* @(#)e_log10.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_log10.c,v 1.10 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_log10(x) * Return the base 10 logarithm of x * * Method : * Let log10_2hi = leading 40 bits of log10(2) and * log10_2lo = log10(2) - log10_2hi, * ivln10 = 1/log(10) rounded. * Then * n = ilogb(x), * if(n<0) n = n+1; * x = scalbn(x,-n); * log10(x) := n*log10_2hi + (n*log10_2lo + ivln10*log(x)) * * Note 1: * To guarantee log10(10**n)=n, where 10**n is normal, the rounding * mode must set to Round-to-Nearest. * Note 2: * [1/log(10)] rounded to 53 bits has error .198 ulps; * log10 is monotonic at all binary break points. * * Special cases: * log10(x) is NaN with signal if x < 0; * log10(+INF) is +INF with no signal; log10(0) is -INF with signal; * log10(NaN) is that NaN with no signal; * log10(10**N) = N for N=0,1,...,22. * * Constants: * The hexadecimal values are the intended ones for the following constants. * The decimal values may be used, provided that the compiler will convert * from decimal to binary accurately enough to produce the hexadecimal values * shown. */ #include "math.h" #include "math_private.h" static const double two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ ivln10 = 4.34294481903251816668e-01, /* 0x3FDBCB7B, 0x1526E50E */ log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */ log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */ static const double zero = 0.0; double __ieee754_log10(double x) { double y,z; int32_t i,k,hx; u_int32_t lx; EXTRACT_WORDS(hx,lx,x); k=0; if (hx < 0x00100000) { /* x < 2**-1022 */ if (((hx&0x7fffffff)|lx)==0) return -two54/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 54; x *= two54; /* subnormal number, scale up x */ GET_HIGH_WORD(hx,x); } if (hx >= 0x7ff00000) return x+x; k += (hx>>20)-1023; i = ((u_int32_t)k&0x80000000)>>31; hx = (hx&0x000fffff)|((0x3ff-i)<<20); y = (double)(k+i); SET_HIGH_WORD(x,hx); z = y*log10_2lo + ivln10*__ieee754_log(x); return z+y*log10_2hi; } --- NEW FILE: e_log10f.c --- /* e_log10f.c -- float version of e_log10.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_log10f.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float two25 = 3.3554432000e+07, /* 0x4c000000 */ ivln10 = 4.3429449201e-01, /* 0x3ede5bd9 */ log10_2hi = 3.0102920532e-01, /* 0x3e9a2080 */ log10_2lo = 7.9034151668e-07; /* 0x355427db */ static const float zero = 0.0; float __ieee754_log10f(float x) { float y,z; int32_t i,k,hx; GET_FLOAT_WORD(hx,x); k=0; if (hx < 0x00800000) { /* x < 2**-126 */ if ((hx&0x7fffffff)==0) return -two25/zero; /* log(+-0)=-inf */ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 25; x *= two25; /* subnormal number, scale up x */ GET_FLOAT_WORD(hx,x); } if (hx >= 0x7f800000) return x+x; k += (hx>>23)-127; i = ((u_int32_t)k&0x80000000)>>31; hx = (hx&0x007fffff)|((0x7f-i)<<23); y = (float)(k+i); SET_FLOAT_WORD(x,hx); z = y*log10_2lo + ivln10*__ieee754_logf(x); return z+y*log10_2hi; } --- NEW FILE: e_logf.c --- /* e_logf.c -- float version of e_log.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_logf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ two25 = 3.355443200e+07, /* 0x4c000000 */ Lg1 = 6.6666668653e-01, /* 3F2AAAAB */ Lg2 = 4.0000000596e-01, /* 3ECCCCCD */ Lg3 = 2.8571429849e-01, /* 3E924925 */ Lg4 = 2.2222198546e-01, /* 3E638E29 */ Lg5 = 1.8183572590e-01, /* 3E3A3325 */ Lg6 = 1.5313838422e-01, /* 3E1CD04F */ Lg7 = 1.4798198640e-01; /* 3E178897 */ static const float zero = 0.0; float __ieee754_logf(float x) { float hfsq,f,s,z,R,w,t1,t2,dk; int32_t k,ix,i,j; GET_FLOAT_WORD(ix,x); k=0; if (ix < 0x00800000) { /* x < 2**-126 */ if ((ix&0x7fffffff)==0) return -two25/zero; /* log(+-0)=-inf */ if (ix<0) return (x-x)/zero; /* log(-#) = NaN */ k -= 25; x *= two25; /* subnormal number, scale up x */ GET_FLOAT_WORD(ix,x); } if (ix >= 0x7f800000) return x+x; k += (ix>>23)-127; ix &= 0x007fffff; i = (ix+(0x95f64<<3))&0x800000; SET_FLOAT_WORD(x,ix|(i^0x3f800000)); /* normalize x or x/2 */ k += (i>>23); f = x-(float)1.0; if((0x007fffff&(15+ix))<16) { /* |f| < 2**-20 */ if(f==zero) if(k==0) return zero; else {dk=(float)k; return dk*ln2_hi+dk*ln2_lo;} R = f*f*((float)0.5-(float)0.33333333333333333*f); if(k==0) return f-R; else {dk=(float)k; return dk*ln2_hi-((R-dk*ln2_lo)-f);} } s = f/((float)2.0+f); dk = (float)k; z = s*s; i = ix-(0x6147a<<3); w = z*z; j = (0x6b851<<3)-ix; t1= w*(Lg2+w*(Lg4+w*Lg6)); t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7))); i |= j; R = t2+t1; if(i>0) { hfsq=(float)0.5*f*f; if(k==0) return f-(hfsq-s*(hfsq+R)); else return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f); } else { if(k==0) return f-s*(f-R); else return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f); } } --- NEW FILE: e_pow.c --- /* @(#)e_pow.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_pow.c,v 1.9 2002/06/17 15:28:59 bde Exp $"; #endif /* __ieee754_pow(x,y) return x**y * * n * Method: Let x = 2 * (1+f) * 1. Compute and return log2(x) in two pieces: * log2(x) = w1 + w2, * where w1 has 53-24 = 29 bit trailing zeros. * 2. Perform y*log2(x) = n+y' by simulating muti-precision * arithmetic, where |y'|<=0.5. * 3. Return x**y = 2**n*exp(y'*log2) * * Special cases: * 1. (anything) ** 0 is 1 * 2. (anything) ** 1 is itself * 3. (anything) ** NAN is NAN * 4. NAN ** (anything except 0) is NAN * 5. +-(|x| > 1) ** +INF is +INF * 6. +-(|x| > 1) ** -INF is +0 * 7. +-(|x| < 1) ** +INF is +0 * 8. +-(|x| < 1) ** -INF is +INF * 9. +-1 ** +-INF is NAN * 10. +0 ** (+anything except 0, NAN) is +0 * 11. -0 ** (+anything except 0, NAN, odd integer) is +0 * 12. +0 ** (-anything except 0, NAN) is +INF * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF * 14. -0 ** (odd integer) = -( +0 ** (odd integer) ) * 15. +INF ** (+anything except 0,NAN) is +INF * 16. +INF ** (-anything except 0,NAN) is +0 * 17. -INF ** (anything) = -0 ** (-anything) * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer) * 19. (-anything except 0 and inf) ** (non-integer) is NAN * * Accuracy: * pow(x,y) returns x**y nearly rounded. In particular * pow(integer,integer) * always returns the correct integer provided it is * representable. * * Constants : * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const double bp[] = {1.0, 1.5,}, dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */ dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */ zero = 0.0, one = 1.0, two = 2.0, two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */ huge = 1.0e300, tiny = 1.0e-300, /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */ L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */ L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */ L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */ L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */ L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */ P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */ P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */ P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */ P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */ P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */ lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */ lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */ ovt = 8.0085662595372944372e-0017, /* -(1024-log2(ovfl+.5ulp)) */ cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */ cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */ cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/ ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */ ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/ ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ double __ieee754_pow(double x, double y) { double z,ax,z_h,z_l,p_h,p_l; double y1,t1,t2,r,s,t,u,v,w; int32_t i,j,k,yisint,n; int32_t hx,hy,ix,iy; u_int32_t lx,ly; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); ix = hx&0x7fffffff; iy = hy&0x7fffffff; /* y==zero: x**0 = 1 */ if((iy|ly)==0) return one; /* +-NaN return x+y */ if(ix > 0x7ff00000 || ((ix==0x7ff00000)&&(lx!=0)) || iy > 0x7ff00000 || ((iy==0x7ff00000)&&(ly!=0))) return x+y; /* determine if y is an odd int when x < 0 * yisint = 0 ... y is not an integer * yisint = 1 ... y is an odd int * yisint = 2 ... y is an even int */ yisint = 0; if(hx<0) { if(iy>=0x43400000) yisint = 2; /* even integer y */ else if(iy>=0x3ff00000) { k = (iy>>20)-0x3ff; /* exponent */ if(k>20) { j = ly>>(52-k); if((j<<(52-k))==ly) yisint = 2-(j&1); } else if(ly==0) { j = iy>>(20-k); if((j<<(20-k))==iy) yisint = 2-(j&1); } } } /* special value of y */ if(ly==0) { if (iy==0x7ff00000) { /* y is +-inf */ if(((ix-0x3ff00000)|lx)==0) return y - y; /* inf**+-1 is NaN */ else if (ix >= 0x3ff00000)/* (|x|>1)**+-inf = inf,0 */ return (hy>=0)? y: zero; else /* (|x|<1)**-,+inf = inf,0 */ return (hy<0)?-y: zero; } if(iy==0x3ff00000) { /* y is +-1 */ if(hy<0) return one/x; else return x; } if(hy==0x40000000) return x*x; /* y is 2 */ if(hy==0x3fe00000) { /* y is 0.5 */ if(hx>=0) /* x >= +0 */ return __ieee754_sqrt(x); } } ax = fabs(x); /* special value of x */ if(lx==0) { if(ix==0x7ff00000||ix==0||ix==0x3ff00000){ z = ax; /*x is +-0,+-inf,+-1*/ if(hy<0) z = one/z; /* z = (1/|x|) */ if(hx<0) { if(((ix-0x3ff00000)|yisint)==0) { z = (z-z)/(z-z); /* (-1)**non-int is NaN */ } else if(yisint==1) z = -z; /* (x<0)**odd = -(|x|**odd) */ } return z; } } /* (x<0)**(non-int) is NaN */ /* CYGNUS LOCAL: This used to be if((((hx>>31)+1)|yisint)==0) return (x-x)/(x-x); but ANSI C says a right shift of a signed negative quantity is implementation defined. */ if(((((u_int32_t)hx>>31)-1)|yisint)==0) return (x-x)/(x-x); /* |y| is huge */ if(iy>0x41e00000) { /* if |y| > 2**31 */ if(iy>0x43f00000){ /* if |y| > 2**64, must o/uflow */ if(ix<=0x3fefffff) return (hy<0)? huge*huge:tiny*tiny; if(ix>=0x3ff00000) return (hy>0)? huge*huge:tiny*tiny; } /* over/underflow if x is not close to one */ if(ix<0x3fefffff) return (hy<0)? huge*huge:tiny*tiny; if(ix>0x3ff00000) return (hy>0)? huge*huge:tiny*tiny; /* now |1-x| is tiny <= 2**-20, suffice to compute log(x) by x-x^2/2+x^3/3-x^4/4 */ t = ax-1; /* t has 20 trailing zeros */ w = (t*t)*(0.5-t*(0.3333333333333333333333-t*0.25)); u = ivln2_h*t; /* ivln2_h has 21 sig. bits */ v = t*ivln2_l-w*ivln2; t1 = u+v; SET_LOW_WORD(t1,0); t2 = v-(t1-u); } else { double s2,s_h,s_l,t_h,t_l; n = 0; /* take care subnormal number */ if(ix<0x00100000) {ax *= two53; n -= 53; GET_HIGH_WORD(ix,ax); } n += ((ix)>>20)-0x3ff; j = ix&0x000fffff; /* determine interval */ ix = j|0x3ff00000; /* normalize ix */ if(j<=0x3988E) k=0; /* |x|<sqrt(3/2) */ else if(j<0xBB67A) k=1; /* |x|<sqrt(3) */ else {k=0;n+=1;ix -= 0x00100000;} SET_HIGH_WORD(ax,ix); /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ v = one/(ax+bp[k]); s = u*v; s_h = s; SET_LOW_WORD(s_h,0); /* t_h=ax+bp[k] High */ t_h = zero; SET_HIGH_WORD(t_h,((ix>>1)|0x20000000)+0x00080000+(k<<18)); t_l = ax - (t_h-bp[k]); s_l = v*((u-s_h*t_h)-s_h*t_l); /* compute log(ax) */ s2 = s*s; r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); r += s_l*(s_h+s); s2 = s_h*s_h; t_h = 3.0+s2+r; SET_LOW_WORD(t_h,0); t_l = r-((t_h-3.0)-s2); /* u+v = s*(1+...) */ u = s_h*t_h; v = s_l*t_h+t_l*s; /* 2/(3log2)*(s+...) */ p_h = u+v; SET_LOW_WORD(p_h,0); p_l = v-(p_h-u); z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ z_l = cp_l*p_h+p_l*cp+dp_l[k]; /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */ t = (double)n; t1 = (((z_h+z_l)+dp_h[k])+t); SET_LOW_WORD(t1,0); t2 = z_l-(((t1-t)-dp_h[k])-z_h); } s = one; /* s (sign of result -ve**odd) = -1 else = 1 */ if(((((u_int32_t)hx>>31)-1)|(yisint-1))==0) s = -one;/* (-ve)**(odd int) */ /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ y1 = y; SET_LOW_WORD(y1,0); p_l = (y-y1)*t1+y*t2; p_h = y1*t1; z = p_l+p_h; EXTRACT_WORDS(j,i,z); if (j>=0x40900000) { /* z >= 1024 */ if(((j-0x40900000)|i)!=0) /* if z > 1024 */ return s*huge*huge; /* overflow */ else { if(p_l+ovt>z-p_h) return s*huge*huge; /* overflow */ } } else if((j&0x7fffffff)>=0x4090cc00 ) { /* z <= -1075 */ if(((j-0xc090cc00)|i)!=0) /* z < -1075 */ return s*tiny*tiny; /* underflow */ else { if(p_l<=z-p_h) return s*tiny*tiny; /* underflow */ } } /* * compute 2**(p_h+p_l) */ i = j&0x7fffffff; k = (i>>20)-0x3ff; n = 0; if(i>0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */ n = j+(0x00100000>>(k+1)); k = ((n&0x7fffffff)>>20)-0x3ff; /* new k for n */ t = zero; SET_HIGH_WORD(t,n&~(0x000fffff>>k)); n = ((n&0x000fffff)|0x00100000)>>(20-k); if(j<0) n = -n; p_h -= t; } t = p_l+p_h; SET_LOW_WORD(t,0); u = t*lg2_h; v = (p_l-(t-p_h))*lg2+t*lg2_l; z = u+v; w = v-(z-u); t = z*z; t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); r = (z*t1)/(t1-two)-(w+z*w); z = one-(r-z); GET_HIGH_WORD(j,z); j += (n<<20); if((j>>20)<=0) z = scalbn(z,n); /* subnormal output */ else SET_HIGH_WORD(z,j); return s*z; } --- NEW FILE: e_powf.c --- /* e_powf.c -- float version of e_pow.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_powf.c,v 1.9 2002/06/17 15:28:59 bde Exp $"; #endif #include "math.h" #include "math_private.h" static const float bp[] = {1.0, 1.5,}, dp_h[] = { 0.0, 5.84960938e-01,}, /* 0x3f15c000 */ dp_l[] = { 0.0, 1.56322085e-06,}, /* 0x35d1cfdc */ zero = 0.0, one = 1.0, two = 2.0, two24 = 16777216.0, /* 0x4b800000 */ huge = 1.0e30, tiny = 1.0e-30, /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ L1 = 6.0000002384e-01, /* 0x3f19999a */ L2 = 4.2857143283e-01, /* 0x3edb6db7 */ L3 = 3.3333334327e-01, /* 0x3eaaaaab */ L4 = 2.7272811532e-01, /* 0x3e8ba305 */ L5 = 2.3066075146e-01, /* 0x3e6c3255 */ L6 = 2.0697501302e-01, /* 0x3e53f142 */ P1 = 1.6666667163e-01, /* 0x3e2aaaab */ P2 = -2.7777778450e-03, /* 0xbb360b61 */ P3 = 6.6137559770e-05, /* 0x388ab355 */ P4 = -1.6533901999e-06, /* 0xb5ddea0e */ P5 = 4.1381369442e-08, /* 0x3331bb4c */ lg2 = 6.9314718246e-01, /* 0x3f317218 */ lg2_h = 6.93145752e-01, /* 0x3f317200 */ lg2_l = 1.42860654e-06, /* 0x35bfbe8c */ ovt = 4.2995665694e-08, /* -(128-log2(ovfl+.5ulp)) */ cp = 9.6179670095e-01, /* 0x3f76384f =2/(3ln2) */ cp_h = 9.6179199219e-01, /* 0x3f763800 =head of cp */ cp_l = 4.7017383622e-06, /* 0x369dc3a0 =tail of cp_h */ ivln2 = 1.4426950216e+00, /* 0x3fb8aa3b =1/ln2 */ ivln2_h = 1.4426879883e+00, /* 0x3fb8aa00 =16b 1/ln2*/ ivln2_l = 7.0526075433e-06; /* 0x36eca570 =1/ln2 tail*/ float __ieee754_powf(float x, float y) { float z,ax,z_h,z_l,p_h,p_l; float y1,t1,t2,r,s,t,u,v,w; int32_t i,j,k,yisint,n; int32_t hx,hy,ix,iy,is; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); ix = hx&0x7fffffff; iy = hy&0x7fffffff; /* y==zero: x**0 = 1 */ if(iy==0) return one; /* +-NaN return x+y */ if(ix > 0x7f800000 || iy > 0x7f800000) return x+y; /* determine if y is an odd int when x < 0 * yisint = 0 ... y is not an integer * yisint = 1 ... y is an odd int * yisint = 2 ... y is an even int */ yisint = 0; if(hx<0) { if(iy>=0x4b800000) yisint = 2; /* even integer y */ else if(iy>=0x3f800000) { k = (iy>>23)-0x7f; /* exponent */ j = iy>>(23-k); if((j<<(23-k))==iy) yisint = 2-(j&1); } } /* special value of y */ if (iy==0x7f800000) { /* y is +-inf */ if (ix==0x3f800000) return y - y; /* inf**+-1 is NaN */ else if (ix > 0x3f800000)/* (|x|>1)**+-inf = inf,0 */ return (hy>=0)? y: zero; else /* (|x|<1)**-,+inf = inf,0 */ return (hy<0)?-y: zero; } if(iy==0x3f800000) { /* y is +-1 */ if(hy<0) return one/x; else return x; } if(hy==0x40000000) return x*x; /* y is 2 */ if(hy==0x3f000000) { /* y is 0.5 */ if(hx>=0) /* x >= +0 */ return __ieee754_sqrtf(x); } ax = fabsf(x); /* special value of x */ if(ix==0x7f800000||ix==0||ix==0x3f800000){ z = ax; /*x is +-0,+-inf,+-1*/ if(hy<0) z = one/z; /* z = (1/|x|) */ if(hx<0) { if(((ix-0x3f800000)|yisint)==0) { z = (z-z)/(z-z); /* (-1)**non-int is NaN */ } else if(yisint==1) z = -z; /* (x<0)**odd = -(|x|**odd) */ } return z; } /* (x<0)**(non-int) is NaN */ if(((((u_int32_t)hx>>31)-1)|yisint)==0) return (x-x)/(x-x); /* |y| is huge */ if(iy>0x4d000000) { /* if |y| > 2**27 */ /* over/underflow if x is not close to one */ if(ix<0x3f7ffff8) return (hy<0)? huge*huge:tiny*tiny; if(ix>0x3f800007) return (hy>0)? huge*huge:tiny*tiny; /* now |1-x| is tiny <= 2**-20, suffice to compute log(x) by x-x^2/2+x^3/3-x^4/4 */ t = ax-1; /* t has 20 trailing zeros */ w = (t*t)*((float)0.5-t*((float)0.333333333333-t*(float)0.25)); u = ivln2_h*t; /* ivln2_h has 16 sig. bits */ v = t*ivln2_l-w*ivln2; t1 = u+v; GET_FLOAT_WORD(is,t1); SET_FLOAT_WORD(t1,is&0xfffff000); t2 = v-(t1-u); } else { float s2,s_h,s_l,t_h,t_l; n = 0; /* take care subnormal number */ if(ix<0x00800000) {ax *= two24; n -= 24; GET_FLOAT_WORD(ix,ax); } n += ((ix)>>23)-0x7f; j = ix&0x007fffff; /* determine interval */ ix = j|0x3f800000; /* normalize ix */ if(j<=0x1cc471) k=0; /* |x|<sqrt(3/2) */ else if(j<0x5db3d7) k=1; /* |x|<sqrt(3) */ else {k=0;n+=1;ix -= 0x00800000;} SET_FLOAT_WORD(ax,ix); /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ v = one/(ax+bp[k]); s = u*v; s_h = s; GET_FLOAT_WORD(is,s_h); SET_FLOAT_WORD(s_h,is&0xfffff000); /* t_h=ax+bp[k] High */ SET_FLOAT_WORD(t_h,((ix>>1)|0x20000000)+0x0040000+(k<<21)); t_l = ax - (t_h-bp[k]); s_l = v*((u-s_h*t_h)-s_h*t_l); /* compute log(ax) */ s2 = s*s; r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); r += s_l*(s_h+s); s2 = s_h*s_h; t_h = (float)3.0+s2+r; GET_FLOAT_WORD(is,t_h); SET_FLOAT_WORD(t_h,is&0xfffff000); t_l = r-((t_h-(float)3.0)-s2); /* u+v = s*(1+...) */ u = s_h*t_h; v = s_l*t_h+t_l*s; /* 2/(3log2)*(s+...) */ p_h = u+v; GET_FLOAT_WORD(is,p_h); SET_FLOAT_WORD(p_h,is&0xfffff000); p_l = v-(p_h-u); z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ z_l = cp_l*p_h+p_l*cp+dp_l[k]; /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */ t = (float)n; t1 = (((z_h+z_l)+dp_h[k])+t); GET_FLOAT_WORD(is,t1); SET_FLOAT_WORD(t1,is&0xfffff000); t2 = z_l-(((t1-t)-dp_h[k])-z_h); } s = one; /* s (sign of result -ve**odd) = -1 else = 1 */ if(((((u_int32_t)hx>>31)-1)|(yisint-1))==0) s = -one; /* (-ve)**(odd int) */ /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ GET_FLOAT_WORD(is,y); SET_FLOAT_WORD(y1,is&0xfffff000); p_l = (y-y1)*t1+y*t2; p_h = y1*t1; z = p_l+p_h; GET_FLOAT_WORD(j,z); if (j>0x43000000) /* if z > 128 */ return s*huge*huge; /* overflow */ else if (j==0x43000000) { /* if z == 128 */ if(p_l+ovt>z-p_h) return s*huge*huge; /* overflow */ } else if ((j&0x7fffffff)>0x43160000) /* z <= -150 */ return s*tiny*tiny; /* underflow */ else if (j==0xc3160000){ /* z == -150 */ if(p_l<=z-p_h) return s*tiny*tiny; /* underflow */ } /* * compute 2**(p_h+p_l) */ i = j&0x7fffffff; k = (i>>23)-0x7f; n = 0; if(i>0x3f000000) { /* if |z| > 0.5, set n = [z+0.5] */ n = j+(0x00800000>>(k+1)); k = ((n&0x7fffffff)>>23)-0x7f; /* new k for n */ SET_FLOAT_WORD(t,n&~(0x007fffff>>k)); n = ((n&0x007fffff)|0x00800000)>>(23-k); if(j<0) n = -n; p_h -= t; } t = p_l+p_h; GET_FLOAT_WORD(is,t); SET_FLOAT_WORD(t,is&0xfffff000); u = t*lg2_h; v = (p_l-(t-p_h))*lg2+t*lg2_l; z = u+v; w = v-(z-u); t = z*z; t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); r = (z*t1)/(t1-two)-(w+z*w); z = one-(r-z); GET_FLOAT_WORD(j,z); j += (n<<23); if((j>>23)<=0) z = scalbnf(z,n); /* subnormal output */ else SET_FLOAT_WORD(z,j); return s*z; } --- NEW FILE: e_rem_pio2.c --- /* @(#)e_rem_pio2.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_rem_pio2.c,v 1.7 2002/05/28 17:51:46 alfred Exp $"; #endif /* __ieee754_rem_pio2(x,y) * * return the remainder of x rem pi/2 in y[0]+y[1] * use __kernel_rem_pio2() */ #include "math.h" #include "math_private.h" /* * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi */ static const int32_t two_over_pi[] = { 0xA2F983, 0x6E4E44, 0x1529FC, 0x2757D1, 0xF534DD, 0xC0DB62, 0x95993C, 0x439041, 0xFE5163, 0xABDEBB, 0xC561B7, 0x246E3A, 0x424DD2, 0xE00649, 0x2EEA09, 0xD1921C, 0xFE1DEB, 0x1CB129, 0xA73EE8, 0x8235F5, 0x2EBB44, 0x84E99C, 0x7026B4, 0x5F7E41, 0x3991D6, 0x398353, 0x39F49C, 0x845F8B, 0xBDF928, 0x3B1FF8, 0x97FFDE, 0x05980F, 0xEF2F11, 0x8B5A0A, 0x6D1F6D, 0x367ECF, 0x27CB09, 0xB74F46, 0x3F669E, 0x5FEA2D, 0x7527BA, 0xC7EBE5, 0xF17B3D, 0x0739F7, 0x8A5292, 0xEA6BFB, 0x5FB11F, 0x8D5D08, 0x560330, 0x46FC7B, 0x6BABF0, 0xCFBC20, 0x9AF436, 0x1DA9E3, 0x91615E, 0xE61B08, 0x659985, 0x5F14A0, 0x68408D, 0xFFD880, 0x4D7327, 0x310606, 0x1556CA, 0x73A8C9, 0x60E27B, 0xC08C6B, }; static const int32_t npio2_hw[] = { 0x3FF921FB, 0x400921FB, 0x4012D97C, 0x401921FB, 0x401F6A7A, 0x4022D97C, 0x4025FDBB, 0x402921FB, 0x402C463A, 0x402F6A7A, 0x4031475C, 0x4032D97C, 0x40346B9C, 0x4035FDBB, 0x40378FDB, 0x403921FB, 0x403AB41B, 0x403C463A, 0x403DD85A, 0x403F6A7A, 0x40407E4C, 0x4041475C, 0x4042106C, 0x4042D97C, 0x4043A28C, 0x40446B9C, 0x404534AC, 0x4045FDBB, 0x4046C6CB, 0x40478FDB, 0x404858EB, 0x404921FB, }; /* * invpio2: 53 bits of 2/pi * pio2_1: first 33 bit of pi/2 * pio2_1t: pi/2 - pio2_1 * pio2_2: second 33 bit of pi/2 * pio2_2t: pi/2 - (pio2_1+pio2_2) * pio2_3: third 33 bit of pi/2 * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3) */ static const double zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */ invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ pio2_1 = 1.57079632673412561417e+00, /* 0x3FF921FB, 0x54400000 */ pio2_1t = 6.07710050650619224932e-11, /* 0x3DD0B461, 0x1A626331 */ pio2_2 = 6.07710050630396597660e-11, /* 0x3DD0B461, 0x1A600000 */ pio2_2t = 2.02226624879595063154e-21, /* 0x3BA3198A, 0x2E037073 */ pio2_3 = 2.02226624871116645580e-21, /* 0x3BA3198A, 0x2E000000 */ pio2_3t = 8.47842766036889956997e-32; /* 0x397B839A, 0x252049C1 */ int32_t __ieee754_rem_pio2(double x, double *y) { double z,w,t,r,fn; double tx[3]; int32_t e0,i,j,nx,n,ix,hx; u_int32_t low; GET_HIGH_WORD(hx,x); /* high word of x */ ix = hx&0x7fffffff; if(ix<=0x3fe921fb) /* |x| ~<= pi/4 , no need for reduction */ {y[0] = x; y[1] = 0; return 0;} if(ix<0x4002d97c) { /* |x| < 3pi/4, special case with n=+-1 */ if(hx>0) { z = x - pio2_1; if(ix!=0x3ff921fb) { /* 33+53 bit pi is good enough */ y[0] = z - pio2_1t; y[1] = (z-y[0])-pio2_1t; } else { /* near pi/2, use 33+33+53 bit pi */ z -= pio2_2; y[0] = z - pio2_2t; y[1] = (z-y[0])-pio2_2t; } return 1; } else { /* negative x */ z = x + pio2_1; if(ix!=0x3ff921fb) { /* 33+53 bit pi is good enough */ y[0] = z + pio2_1t; y[1] = (z-y[0])+pio2_1t; } else { /* near pi/2, use 33+33+53 bit pi */ z += pio2_2; y[0] = z + pio2_2t; y[1] = (z-y[0])+pio2_2t; } return -1; } } if(ix<=0x413921fb) { /* |x| ~<= 2^19*(pi/2), medium size */ t = fabs(x); n = (int32_t) (t*invpio2+half); fn = (double)n; r = t-fn*pio2_1; w = fn*pio2_1t; /* 1st round good to 85 bit */ if(n<32&&ix!=npio2_hw[n-1]) { y[0] = r-w; /* quick check no cancellation */ } else { u_int32_t high; j = ix>>20; y[0] = r-w; GET_HIGH_WORD(high,y[0]); i = j-((high>>20)&0x7ff); if(i>16) { /* 2nd iteration needed, good to 118 */ t = r; w = fn*pio2_2; r = t-w; w = fn*pio2_2t-((t-r)-w); y[0] = r-w; GET_HIGH_WORD(high,y[0]); i = j-((high>>20)&0x7ff); if(i>49) { /* 3rd iteration need, 151 bits acc */ t = r; /* will cover all possible cases */ w = fn*pio2_3; r = t-w; w = fn*pio2_3t-((t-r)-w); y[0] = r-w; } } } y[1] = (r-y[0])-w; if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;} else return n; } /* * all other (large) arguments */ if(ix>=0x7ff00000) { /* x is inf or NaN */ y[0]=y[1]=x-x; return 0; } /* set z = scalbn(|x|,ilogb(x)-23) */ GET_LOW_WORD(low,x); SET_LOW_WORD(z,low); e0 = (ix>>20)-1046; /* e0 = ilogb(z)-23; */ SET_HIGH_WORD(z, ix - ((int32_t)(e0<<20))); for(i=0;i<2;i++) { tx[i] = (double)((int32_t)(z)); z = (z-tx[i])*two24; } tx[2] = z; nx = 3; while(tx[nx-1]==zero) nx--; /* skip zero term */ n = __kernel_rem_pio2(tx,y,e0,nx,2,two_over_pi); if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;} return n; } --- NEW FILE: e_rem_pio2f.c --- /* e_rem_pio2f.c -- float version of e_rem_pio2.c * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_rem_pio2f.c,v 1.7 2002/05/28 17:51:46 alfred Exp $"; #endif /* __ieee754_rem_pio2f(x,y) * * return the remainder of x rem pi/2 in y[0]+y[1] * use __kernel_rem_pio2f() */ #include "math.h" #include "math_private.h" /* * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi */ static const int32_t two_over_pi[] = { 0xA2, 0xF9, 0x83, 0x6E, 0x4E, 0x44, 0x15, 0x29, 0xFC, 0x27, 0x57, 0xD1, 0xF5, 0x34, 0xDD, 0xC0, 0xDB, 0x62, 0x95, 0x99, 0x3C, 0x43, 0x90, 0x41, 0xFE, 0x51, 0x63, 0xAB, 0xDE, 0xBB, 0xC5, 0x61, 0xB7, 0x24, 0x6E, 0x3A, 0x42, 0x4D, 0xD2, 0xE0, 0x06, 0x49, 0x2E, 0xEA, 0x09, 0xD1, 0x92, 0x1C, 0xFE, 0x1D, 0xEB, 0x1C, 0xB1, 0x29, 0xA7, 0x3E, 0xE8, 0x82, 0x35, 0xF5, 0x2E, 0xBB, 0x44, 0x84, 0xE9, 0x9C, 0x70, 0x26, 0xB4, 0x5F, 0x7E, 0x41, 0x39, 0x91, 0xD6, 0x39, 0x83, 0x53, 0x39, 0xF4, 0x9C, 0x84, 0x5F, 0x8B, 0xBD, 0xF9, 0x28, 0x3B, 0x1F, 0xF8, 0x97, 0xFF, 0xDE, 0x05, 0x98, 0x0F, 0xEF, 0x2F, 0x11, 0x8B, 0x5A, 0x0A, 0x6D, 0x1F, 0x6D, 0x36, 0x7E, 0xCF, 0x27, 0xCB, 0x09, 0xB7, 0x4F, 0x46, 0x3F, 0x66, 0x9E, 0x5F, 0xEA, 0x2D, 0x75, 0x27, 0xBA, 0xC7, 0xEB, 0xE5, 0xF1, 0x7B, 0x3D, 0x07, 0x39, 0xF7, 0x8A, 0x52, 0x92, 0xEA, 0x6B, 0xFB, 0x5F, 0xB1, 0x1F, 0x8D, 0x5D, 0x08, 0x56, 0x03, 0x30, 0x46, 0xFC, 0x7B, 0x6B, 0xAB, 0xF0, 0xCF, 0xBC, 0x20, 0x9A, 0xF4, 0x36, 0x1D, 0xA9, 0xE3, 0x91, 0x61, 0x5E, 0xE6, 0x1B, 0x08, 0x65, 0x99, 0x85, 0x5F, 0x14, 0xA0, 0x68, 0x40, 0x8D, 0xFF, 0xD8, 0x80, 0x4D, 0x73, 0x27, 0x31, 0x06, 0x06, 0x15, 0x56, 0xCA, 0x73, 0xA8, 0xC9, 0x60, 0xE2, 0x7B, 0xC0, 0x8C, 0x6B, }; /* This array is like the one in e_rem_pio2.c, but the numbers are single precision and the last 8 bits are forced to 0. */ static const int32_t npio2_hw[] = { 0x3fc90f00, 0x40490f00, 0x4096cb00, 0x40c90f00, 0x40fb5300, 0x4116cb00, 0x412fed00, 0x41490f00, 0x41623100, 0x417b5300, 0x418a3a00, 0x4196cb00, 0x41a35c00, 0x41afed00, 0x41bc7e00, 0x41c90f00, 0x41d5a000, 0x41e23100, 0x41eec200, 0x41fb5300, 0x4203f200, 0x420a3a00, 0x42108300, 0x4216cb00, 0x421d1400, 0x42235c00, 0x4229a500, 0x422fed00, 0x42363600, 0x423c7e00, 0x4242c700, 0x42490f00 }; /* * invpio2: 24 bits of 2/pi * pio2_1: first 17 bit of pi/2 * pio2_1t: pi/2 - pio2_1 * pio2_2: second 17 bit of pi/2 * pio2_2t: pi/2 - (pio2_1+pio2_2) * pio2_3: third 17 bit of pi/2 * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3) */ static const float zero = 0.0000000000e+00, /* 0x00000000 */ half = 5.0000000000e-01, /* 0x3f000000 */ two8 = 2.5600000000e+02, /* 0x43800000 */ invpio2 = 6.3661980629e-01, /* 0x3f22f984 */ pio2_1 = 1.5707855225e+00, /* 0x3fc90f80 */ pio2_1t = 1.0804334124e-05, /* 0x37354443 */ pio2_2 = 1.0804273188e-05, /* 0x37354400 */ pio2_2t = 6.0770999344e-11, /* 0x2e85a308 */ pio2_3 = 6.0770943833e-11, /* 0x2e85a300 */ pio2_3t = 6.1232342629e-17; /* 0x248d3132 */ int32_t __ieee754_rem_pio2f(float x, float *y) { float z,w,t,r,fn; float tx[3]; int32_t e0,i,j,nx,n,ix,hx; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix<=0x3f490fd8) /* |x| ~<= pi/4 , no need for reduction */ {y[0] = x; y[1] = 0; return 0;} if(ix<0x4016cbe4) { /* |x| < 3pi/4, special case with n=+-1 */ if(hx>0) { z = x - pio2_1; if((ix&0xfffffff0)!=0x3fc90fd0) { /* 24+24 bit pi OK */ y[0] = z - pio2_1t; y[1] = (z-y[0])-pio2_1t; } else { /* near pi/2, use 24+24+24 bit pi */ z -= pio2_2; y[0] = z - pio2_2t; y[1] = (z-y[0])-pio2_2t; } return 1; } else { /* negative x */ z = x + pio2_1; if((ix&0xfffffff0)!=0x3fc90fd0) { /* 24+24 bit pi OK */ y[0] = z + pio2_1t; y[1] = (z-y[0])+pio2_1t; } else { /* near pi/2, use 24+24+24 bit pi */ z += pio2_2; y[0] = z + pio2_2t; y[1] = (z-y[0])+pio2_2t; } return -1; } } if(ix<=0x43490f80) { /* |x| ~<= 2^7*(pi/2), medium size */ t = fabsf(x); n = (int32_t) (t*invpio2+half); fn = (float)n; r = t-fn*pio2_1; w = fn*pio2_1t; /* 1st round good to 40 bit */ if(n<32&&(ix&0xffffff00)!=npio2_hw[n-1]) { y[0] = r-w; /* quick check no cancellation */ } else { u_int32_t high; j = ix>>23; y[0] = r-w; GET_FLOAT_WORD(high,y[0]); i = j-((high>>23)&0xff); if(i>8) { /* 2nd iteration needed, good to 57 */ t = r; w = fn*pio2_2; r = t-w; w = fn*pio2_2t-((t-r)-w); y[0] = r-w; GET_FLOAT_WORD(high,y[0]); i = j-((high>>23)&0xff); if(i>25) { /* 3rd iteration need, 74 bits acc */ t = r; /* will cover all possible cases */ w = fn*pio2_3; r = t-w; w = fn*pio2_3t-((t-r)-w); y[0] = r-w; } } } y[1] = (r-y[0])-w; if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;} else return n; } /* * all other (large) arguments */ if(ix>=0x7f800000) { /* x is inf or NaN */ y[0]=y[1]=x-x; return 0; } /* set z = scalbn(|x|,ilogb(x)-7) */ e0 = (ix>>23)-134; /* e0 = ilogb(z)-7; */ SET_FLOAT_WORD(z, ix - ((int32_t)(e0<<23))); for(i=0;i<2;i++) { tx[i] = (float)((int32_t)(z)); z = (z-tx[i])*two8; } tx[2] = z; nx = 3; while(tx[nx-1]==zero) nx--; /* skip zero term */ n = __kernel_rem_pio2f(tx,y,e0,nx,2,two_over_pi); if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;} return n; } --- NEW FILE: e_remainder.c --- /* @(#)e_remainder.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_remainder.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_remainder(x,p) * Return : * returns x REM p = x - [x/p]*p as if in infinite * precise arithmetic, where [x/p] is the (infinite bit) * integer nearest x/p (in half way case choose the even one). * Method : * Based on fmod() return x-[x/p]chopped*p exactlp. */ #include "math.h" #include "math_private.h" static const double zero = 0.0; double __ieee754_remainder(double x, double p) { int32_t hx,hp; u_int32_t sx,lx,lp; double p_half; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hp,lp,p); sx = hx&0x80000000; hp &= 0x7fffffff; hx &= 0x7fffffff; /* purge off exception values */ if((hp|lp)==0) return (x*p)/(x*p); /* p = 0 */ if((hx>=0x7ff00000)|| /* x not finite */ ((hp>=0x7ff00000)&& /* p is NaN */ (((hp-0x7ff00000)|lp)!=0))) return (x*p)/(x*p); if (hp<=0x7fdfffff) x = __ieee754_fmod(x,p+p); /* now x < 2p */ if (((hx-hp)|(lx-lp))==0) return zero*x; x = fabs(x); p = fabs(p); if (hp<0x00200000) { if(x+x>p) { x-=p; if(x+x>=p) x -= p; } } else { p_half = 0.5*p; if(x>p_half) { x-=p; if(x>=p_half) x -= p; } } GET_HIGH_WORD(hx,x); SET_HIGH_WORD(x,hx^sx); return x; } --- NEW FILE: e_remainderf.c --- /* e_remainderf.c -- float version of e_remainder.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_remainderf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float zero = 0.0; float __ieee754_remainderf(float x, float p) { int32_t hx,hp; u_int32_t sx; float p_half; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hp,p); sx = hx&0x80000000; hp &= 0x7fffffff; hx &= 0x7fffffff; /* purge off exception values */ if(hp==0) return (x*p)/(x*p); /* p = 0 */ if((hx>=0x7f800000)|| /* x not finite */ ((hp>0x7f800000))) /* p is NaN */ return (x*p)/(x*p); if (hp<=0x7effffff) x = __ieee754_fmodf(x,p+p); /* now x < 2p */ if ((hx-hp)==0) return zero*x; x = fabsf(x); p = fabsf(p); if (hp<0x01000000) { if(x+x>p) { x-=p; if(x+x>=p) x -= p; } } else { p_half = (float)0.5*p; if(x>p_half) { x-=p; if(x>=p_half) x -= p; } } GET_FLOAT_WORD(hx,x); SET_FLOAT_WORD(x,hx^sx); return x; } --- NEW FILE: e_scalb.c --- /* @(#)e_scalb.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_scalb.c,v 1.10 2003/10/27 01:28:07 das Exp $"; #endif /* * __ieee754_scalb(x, fn) is provide for * passing various standard test suite. One * should use scalbn() instead. */ #include "math.h" #include "math_private.h" /* XXX lost declaration of this and isinf() in math.h but still have funcs. */ int (isnan)(float x); #ifdef _SCALB_INT double __ieee754_scalb(double x, int fn) #else 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 } --- NEW FILE: e_scalbf.c --- /* e_scalbf.c -- float version of e_scalb.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_scalbf.c,v 1.8 2003/10/27 01:28:07 das Exp $"; #endif #include "math.h" #include "math_private.h" /* XXX lost declaration of this and isnan() in math.h but still have funcs. */ int (isnanf)(float x); #ifdef _SCALB_INT float __ieee754_scalbf(float x, int fn) #else float __ieee754_scalbf(float x, float fn) #endif { #ifdef _SCALB_INT return scalbnf(x,fn); #else if ((isnanf)(x)||(isnanf)(fn)) return x*fn; if (!finitef(fn)) { if(fn>(float)0.0) return x*fn; else return x/(-fn); } if (rintf(fn)!=fn) return (fn-fn)/(fn-fn); if ( fn > (float)65000.0) return scalbnf(x, 65000); if (-fn > (float)65000.0) return scalbnf(x,-65000); return scalbnf(x,(int)fn); #endif } --- NEW FILE: e_sinh.c --- /* @(#)e_sinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_sinh.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* __ieee754_sinh(x) * Method : * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 * 1. Replace x by |x| (sinh(-x) = -sinh(x)). * 2. * E + E/(E+1) * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x) * 2 * * 22 <= x <= lnovft : sinh(x) := exp(x)/2 * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2) * ln2ovft < x : sinh(x) := x*shuge (overflow) * * Special cases: * sinh(x) is |x| if x is +INF, -INF, or NaN. * only sinh(0)=0 is exact for finite x. */ #include "math.h" #include "math_private.h" static const double one = 1.0, shuge = 1.0e307; double __ieee754_sinh(double x) { double t,w,h; int32_t ix,jx; u_int32_t lx; /* High word of |x|. */ GET_HIGH_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7ff00000) return x+x; h = 0.5; if (jx<0) h = -h; /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */ if (ix < 0x40360000) { /* |x|<22 */ if (ix<0x3e300000) /* |x|<2**-28 */ if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ t = expm1(fabs(x)); if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one)); return h*(t+t/(t+one)); } /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */ if (ix < 0x40862E42) return h*__ieee754_exp(fabs(x)); /* |x| in [log(maxdouble), overflowthresold] */ GET_LOW_WORD(lx,x); if (ix<0x408633CE || ((ix==0x408633ce)&&(lx<=(u_int32_t)0x8fb9f87d))) { w = __ieee754_exp(0.5*fabs(x)); t = h*w; return t*w; } /* |x| > overflowthresold, sinh(x) overflow */ return x*shuge; } --- NEW FILE: e_sinhf.c --- /* e_sinhf.c -- float version of e_sinh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_sinhf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, shuge = 1.0e37; float __ieee754_sinhf(float x) { float t,w,h; int32_t ix,jx; GET_FLOAT_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7f800000) return x+x; h = 0.5; if (jx<0) h = -h; /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */ if (ix < 0x41b00000) { /* |x|<22 */ if (ix<0x31800000) /* |x|<2**-28 */ if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ t = expm1f(fabsf(x)); if(ix<0x3f800000) return h*((float)2.0*t-t*t/(t+one)); return h*(t+t/(t+one)); } /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */ if (ix < 0x42b17180) return h*__ieee754_expf(fabsf(x)); /* |x| in [log(maxdouble), overflowthresold] */ if (ix<=0x42b2d4fc) { w = __ieee754_expf((float)0.5*fabsf(x)); t = h*w; return t*w; } /* |x| > overflowthresold, sinh(x) overflow */ return x*shuge; } --- NEW FILE: e_sqrt.c --- /* @(#)e_sqrt.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_sqrt.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* __ieee754_sqrt(x) * Return correctly rounded sqrt. * ------------------------------------------ * | Use the hardware sqrt if you have one | * ------------------------------------------ * Method: * Bit by bit method using integer arithmetic. (Slow, but portable) * 1. Normalization * Scale x to y in [1,4) with even powers of 2: * find an integer k such that 1 <= (y=x*2^(2k)) < 4, then * sqrt(x) = 2^k * sqrt(y) * 2. Bit by bit computation * Let q = sqrt(y) truncated to i bit after binary point (q = 1), * i 0 * i+1 2 * s = 2*q , and y = 2 * ( y - q ). (1) * i i i i * * To compute q from q , one checks whether * i+1 i * * -(i+1) 2 * (q + 2 ) <= y. (2) * i * -(i+1) * If (2) is false, then q = q ; otherwise q = q + 2 . * i+1 i i+1 i * * With some algebric manipulation, it is not difficult to see * that (2) is equivalent to * -(i+1) * s + 2 <= y (3) * i i * * The advantage of (3) is that s and y can be computed by * i i * the following recurrence formula: * if (3) is false * * s = s , y = y ; (4) * i+1 i i+1 i * * otherwise, * -i -(i+1) * s = s + 2 , y = y - s - 2 (5) * i+1 i i+1 i i * * One may easily use induction to prove (4) and (5). * Note. Since the left hand side of (3) contain only i+2 bits, * it does not necessary to do a full (53-bit) comparison * in (3). * 3. Final rounding * After generating the 53 bits result, we compute one more bit. * Together with the remainder, we can decide whether the * result is exact, bigger than 1/2ulp, or less than 1/2ulp * (it will never equal to 1/2ulp). * The rounding mode can be detected by checking whether * huge + tiny is equal to huge, and whether huge - tiny is * equal to huge for some floating point number "huge" and "tiny". * * Special cases: * sqrt(+-0) = +-0 ... exact * sqrt(inf) = inf * sqrt(-ve) = NaN ... with invalid signal * sqrt(NaN) = NaN ... with invalid signal for signaling NaN * * Other methods : see the appended file at the end of the program below. *--------------- */ #include "math.h" #include "math_private.h" static const double one = 1.0, tiny=1.0e-300; double __ieee754_sqrt(double x) { double z; int32_t sign = (int)0x80000000; int32_t ix0,s0,q,m,t,i; u_int32_t r,t1,s1,ix1,q1; EXTRACT_WORDS(ix0,ix1,x); /* take care of Inf and NaN */ if((ix0&0x7ff00000)==0x7ff00000) { return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf sqrt(-inf)=sNaN */ } /* take care of zero */ if(ix0<=0) { if(((ix0&(~sign))|ix1)==0) return x;/* sqrt(+-0) = +-0 */ else if(ix0<0) return (x-x)/(x-x); /* sqrt(-ve) = sNaN */ } /* normalize x */ m = (ix0>>20); if(m==0) { /* subnormal x */ while(ix0==0) { m -= 21; ix0 |= (ix1>>11); ix1 <<= 21; } for(i=0;(ix0&0x00100000)==0;i++) ix0<<=1; m -= i-1; ix0 |= (ix1>>(32-i)); ix1 <<= i; } m -= 1023; /* unbias exponent */ ix0 = (ix0&0x000fffff)|0x00100000; if(m&1){ /* odd m, double x to make it even */ ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; } m >>= 1; /* m = [m/2] */ /* generate sqrt(x) bit by bit */ ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */ r = 0x00200000; /* r = moving bit from right to left */ while(r!=0) { t = s0+r; if(t<=ix0) { s0 = t+r; ix0 -= t; q += r; } ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; r>>=1; } r = sign; while(r!=0) { t1 = s1+r; t = s0; if((t<ix0)||((t==ix0)&&(t1<=ix1))) { s1 = t1+r; if(((t1&sign)==sign)&&(s1&sign)==0) s0 += 1; ix0 -= t; if (ix1 < t1) ix0 -= 1; ix1 -= t1; q1 += r; } ix0 += ix0 + ((ix1&sign)>>31); ix1 += ix1; r>>=1; } /* use floating add to find out rounding direction */ if((ix0|ix1)!=0) { z = one-tiny; /* trigger inexact flag */ if (z>=one) { z = one+tiny; if (q1==(u_int32_t)0xffffffff) { q1=0; q += 1;} else if (z>one) { if (q1==(u_int32_t)0xfffffffe) q+=1; q1+=2; } else q1 += (q1&1); } } ix0 = (q>>1)+0x3fe00000; ix1 = q1>>1; if ((q&1)==1) ix1 |= sign; ix0 += (m <<20); INSERT_WORDS(z,ix0,ix1); return z; } /* Other methods (use floating-point arithmetic) ------------- (This is a copy of a drafted paper by Prof W. Kahan and K.C. Ng, written in May, 1986) Two algorithms are given here to implement sqrt(x) (IEEE double precision arithmetic) in software. Both supply sqrt(x) correctly rounded. The first algorithm (in Section A) uses newton iterations and involves four divisions. The second one uses reciproot iterations to avoid division, but requires more multiplications. Both algorithms need the ability to chop results of arithmetic operations instead of round them, and the INEXACT flag to indicate when an arithmetic operation is executed exactly with no roundoff error, all part of the standard (IEEE 754-1985). The ability to perform shift, add, subtract and logical AND operations upon 32-bit words is needed too, though not part of the standard. A. sqrt(x) by Newton Iteration (1) Initial approximation Let x0 and x1 be the leading and the trailing 32-bit words of a floating point number x (in IEEE double format) respectively 1 11 52 ...widths ------------------------------------------------------ x: |s| e | f | ------------------------------------------------------ msb lsb msb lsb ...order ------------------------ ------------------------ x0: |s| e | f1 | x1: | f2 | ------------------------ ------------------------ By performing shifts and subtracts on x0 and x1 (both regarded as integers), we obtain an 8-bit approximation of sqrt(x) as follows. k := (x0>>1) + 0x1ff80000; y0 := k - T1[31&(k>>15)]. ... y ~ sqrt(x) to 8 bits Here k is a 32-bit integer and T1[] is an integer array containing correction terms. Now magically the floating value of y (y's leading 32-bit word is y0, the value of its trailing word is 0) approximates sqrt(x) to almost 8-bit. Value of T1: static int T1[32]= { 0, 1024, 3062, 5746, 9193, 13348, 18162, 23592, 29598, 36145, 43202, 50740, 58733, 67158, 75992, 85215, 83599, 71378, 60428, 50647, 41945, 34246, 27478, 21581, 16499, 12183, 8588, 5674, 3403, 1742, 661, 130,}; (2) Iterative refinement Apply Heron's rule three times to y, we have y approximates sqrt(x) to within 1 ulp (Unit in the Last Place): y := (y+x/y)/2 ... almost 17 sig. bits y := (y+x/y)/2 ... almost 35 sig. bits y := y-(y-x/y)/2 ... within 1 ulp Remark 1. Another way to improve y to within 1 ulp is: y := (y+x/y) ... almost 17 sig. bits to 2*sqrt(x) y := y - 0x00100006 ... almost 18 sig. bits to sqrt(x) 2 (x-y )*y y := y + 2* ---------- ...within 1 ulp 2 3y + x This formula has one division fewer than the one above; however, it requires more multiplications and additions. Also x must be scaled in advance to avoid spurious overflow in evaluating the expression 3y*y+x. Hence it is not recommended uless division is slow. If division is very slow, then one should use the reciproot algorithm given in section B. (3) Final adjustment By twiddling y's last bit it is possible to force y to be correctly rounded according to the prevailing rounding mode as follows. Let r and i be copies of the rounding mode and inexact flag before entering the square root program. Also we use the expression y+-ulp for the next representable floating numbers (up and down) of y. Note that y+-ulp = either fixed point y+-1, or multiply y by nextafter(1,+-inf) in chopped mode. I := FALSE; ... reset INEXACT flag I R := RZ; ... set rounding mode to round-toward-zero z := x/y; ... chopped quotient, possibly inexact If(not I) then { ... if the quotient is exact if(z=y) { I := i; ... restore inexact flag R := r; ... restore rounded mode return sqrt(x):=y. } else { z := z - ulp; ... special rounding } } i := TRUE; ... sqrt(x) is inexact If (r=RN) then z=z+ulp ... rounded-to-nearest If (r=RP) then { ... round-toward-+inf y = y+ulp; z=z+ulp; } y := y+z; ... chopped sum y0:=y0-0x00100000; ... y := y/2 is correctly rounded. I := i; ... restore inexact flag R := r; ... restore rounded mode return sqrt(x):=y. (4) Special cases Square root of +inf, +-0, or NaN is itself; Square root of a negative number is NaN with invalid signal. B. sqrt(x) by Reciproot Iteration (1) Initial approximation Let x0 and x1 be the leading and the trailing 32-bit words of a floating point number x (in IEEE double format) respectively (see section A). By performing shifs and subtracts on x0 and y0, we obtain a 7.8-bit approximation of 1/sqrt(x) as follows. k := 0x5fe80000 - (x0>>1); y0:= k - T2[63&(k>>14)]. ... y ~ 1/sqrt(x) to 7.8 bits Here k is a 32-bit integer and T2[] is an integer array containing correction terms. Now magically the floating value of y (y's leading 32-bit word is y0, the value of its trailing word y1 is set to zero) approximates 1/sqrt(x) to almost 7.8-bit. Value of T2: static int T2[64]= { 0x1500, 0x2ef8, 0x4d67, 0x6b02, 0x87be, 0xa395, 0xbe7a, 0xd866, 0xf14a, 0x1091b,0x11fcd,0x13552,0x14999,0x15c98,0x16e34,0x17e5f, 0x18d03,0x19a01,0x1a545,0x1ae8a,0x1b5c4,0x1bb01,0x1bfde,0x1c28d, 0x1c2de,0x1c0db,0x1ba73,0x1b11c,0x1a4b5,0x1953d,0x18266,0x16be0, 0x1683e,0x179d8,0x18a4d,0x19992,0x1a789,0x1b445,0x1bf61,0x1c989, 0x1d16d,0x1d77b,0x1dddf,0x1e2ad,0x1e5bf,0x1e6e8,0x1e654,0x1e3cd, 0x1df2a,0x1d635,0x1cb16,0x1be2c,0x1ae4e,0x19bde,0x1868e,0x16e2e, 0x1527f,0x1334a,0x11051,0xe951, 0xbe01, 0x8e0d, 0x5924, 0x1edd,}; (2) Iterative refinement Apply Reciproot iteration three times to y and multiply the result by x to get an approximation z that matches sqrt(x) to about 1 ulp. To be exact, we will have -1ulp < sqrt(x)-z<1.0625ulp. ... set rounding mode to Round-to-nearest y := y*(1.5-0.5*x*y*y) ... almost 15 sig. bits to 1/sqrt(x) y := y*((1.5-2^-30)+0.5*x*y*y)... about 29 sig. bits to 1/sqrt(x) ... special arrangement for better accuracy z := x*y ... 29 bits to sqrt(x), with z*y<1 z := z + 0.5*z*(1-z*y) ... about 1 ulp to sqrt(x) Remark 2. The constant 1.5-2^-30 is chosen to bias the error so that (a) the term z*y in the final iteration is always less than 1; (b) the error in the final result is biased upward so that -1 ulp < sqrt(x) - z < 1.0625 ulp instead of |sqrt(x)-z|<1.03125ulp. (3) Final adjustment By twiddling y's last bit it is possible to force y to be correctly rounded according to the prevailing rounding mode as follows. Let r and i be copies of the rounding mode and inexact flag before entering the square root program. Also we use the expression y+-ulp for the next representable floating numbers (up and down) of y. Note that y+-ulp = either fixed point y+-1, or multiply y by nextafter(1,+-inf) in chopped mode. R := RZ; ... set rounding mode to round-toward-zero switch(r) { case RN: ... round-to-nearest if(x<= z*(z-ulp)...chopped) z = z - ulp; else if(x<= z*(z+ulp)...chopped) z = z; else z = z+ulp; break; case RZ:case RM: ... round-to-zero or round-to--inf R:=RP; ... reset rounding mod to round-to-+inf if(x<z*z ... rounded up) z = z - ulp; else if(x>=(z+ulp)*(z+ulp) ...rounded up) z = z+ulp; break; case RP: ... round-to-+inf if(x>(z+ulp)*(z+ulp)...chopped) z = z+2*ulp; else if(x>z*z ...chopped) z = z+ulp; break; } Remark 3. The above comparisons can be done in fixed point. For example, to compare x and w=z*z chopped, it suffices to compare x1 and w1 (the trailing parts of x and w), regarding them as two's complement integers. ...Is z an exact square root? To determine whether z is an exact square root of x, let z1 be the trailing part of z, and also let x0 and x1 be the leading and trailing parts of x. If ((z1&0x03ffffff)!=0) ... not exact if trailing 26 bits of z!=0 I := 1; ... Raise Inexact flag: z is not exact else { j := 1 - [(x0>>20)&1] ... j = logb(x) mod 2 k := z1 >> 26; ... get z's 25-th and 26-th fraction bits I := i or (k&j) or ((k&(j+j+1))!=(x1&3)); } R:= r ... restore rounded mode return sqrt(x):=z. If multiplication is cheaper then the foregoing red tape, the Inexact flag can be evaluated by I := i; I := (z*z!=x) or I. Note that z*z can overwrite I; this value must be sensed if it is True. Remark 4. If z*z = x exactly, then bit 25 to bit 0 of z1 must be zero. -------------------- z1: | f2 | -------------------- bit 31 bit 0 Further more, bit 27 and 26 of z1, bit 0 and 1 of x1, and the odd or even of logb(x) have the following relations: ------------------------------------------------- bit 27,26 of z1 bit 1,0 of x1 logb(x) ------------------------------------------------- 00 00 odd and even 01 01 even 10 10 odd 10 00 even 11 01 even ------------------------------------------------- (4) Special cases (see (4) of Section A). */ --- NEW FILE: e_sqrt.o --- ELFÿ 1 C [ [ [ [ [ â' C C9° Z k ü#4Pü5c9ð Z kX i Z kC Z kÃÞ#Ü#HIÚÛÞ$$ C;@? J KJK° --- NEW FILE: e_sqrtf.c --- /* e_sqrtf.c -- float version of e_sqrt.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/e_sqrtf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, tiny=1.0e-30; float __ieee754_sqrtf(float x) { float z; int32_t sign = (int)0x80000000; int32_t ix,s,q,m,t,i; u_int32_t r; GET_FLOAT_WORD(ix,x); /* take care of Inf and NaN */ if((ix&0x7f800000)==0x7f800000) { return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf sqrt(-inf)=sNaN */ } /* take care of zero */ if(ix<=0) { if((ix&(~sign))==0) return x;/* sqrt(+-0) = +-0 */ else if(ix<0) return (x-x)/(x-x); /* sqrt(-ve) = sNaN */ } /* normalize x */ m = (ix>>23); if(m==0) { /* subnormal x */ for(i=0;(ix&0x00800000)==0;i++) ix<<=1; m -= i-1; } m -= 127; /* unbias exponent */ ix = (ix&0x007fffff)|0x00800000; if(m&1) /* odd m, double x to make it even */ ix += ix; m >>= 1; /* m = [m/2] */ /* generate sqrt(x) bit by bit */ ix += ix; q = s = 0; /* q = sqrt(x) */ r = 0x01000000; /* r = moving bit from right to left */ while(r!=0) { t = s+r; if(t<=ix) { s = t+r; ix -= t; q += r; } ix += ix; r>>=1; } /* use floating add to find out rounding direction */ if(ix!=0) { z = one-tiny; /* trigger inexact flag */ if (z>=one) { z = one+tiny; if (z>one) q += 2; else q += (q&1); } } ix = (q>>1)+0x3f000000; ix += (m <<23); SET_FLOAT_WORD(z,ix); return z; } --- NEW FILE: k_cos.c --- /* @(#)k_cos.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_cos.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * __kernel_cos( x, y ) * kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164 * Input x is assumed to be bounded by ~pi/4 in magnitude. * Input y is the tail of x. * * Algorithm * 1. Since cos(-x) = cos(x), we need only to consider positive x. * 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0. * 3. cos(x) is approximated by a polynomial of degree 14 on * [0,pi/4] * 4 14 * cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x * where the remez error is * * | 2 4 6 8 10 12 14 | -58 * |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2 * | | * * 4 6 8 10 12 14 * 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then * cos(x) = 1 - x*x/2 + r * since cos(x+y) ~ cos(x) - sin(x)*y * ~ cos(x) - x*y, * a correction term is necessary in cos(x) and hence * cos(x+y) = 1 - (x*x/2 - (r - x*y)) * For better accuracy when x > 0.3, let qx = |x|/4 with * the last 32 bits mask off, and if x > 0.78125, let qx = 0.28125. * Then * cos(x+y) = (1-qx) - ((x*x/2-qx) - (r-x*y)). * Note that 1-qx and (x*x/2-qx) is EXACT here, and the * magnitude of the latter is at least a quarter of x*x/2, * thus, reducing the rounding error in the subtraction. */ #include "math.h" #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */ C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */ C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */ C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */ C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */ C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */ double __kernel_cos(double x, double y) { double a,hz,z,r,qx; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; /* ix = |x|'s high word*/ if(ix<0x3e400000) { /* if x < 2**27 */ if(((int)x)==0) return one; /* generate inexact */ } z = x*x; r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6))))); if(ix < 0x3FD33333) /* if |x| < 0.3 */ return one - (0.5*z - (z*r - x*y)); else { if(ix > 0x3fe90000) { /* x > 0.78125 */ qx = 0.28125; } else { INSERT_WORDS(qx,ix-0x00200000,0); /* x/4 */ } hz = 0.5*z-qx; a = one-qx; return a - (hz - (z*r-x*y)); } } --- NEW FILE: k_cosf.c --- /* k_cosf.c -- float version of k_cos.c * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_cosf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3f800000 */ C1 = 4.1666667908e-02, /* 0x3d2aaaab */ C2 = -1.3888889225e-03, /* 0xbab60b61 */ C3 = 2.4801587642e-05, /* 0x37d00d01 */ C4 = -2.7557314297e-07, /* 0xb493f27c */ C5 = 2.0875723372e-09, /* 0x310f74f6 */ C6 = -1.1359647598e-11; /* 0xad47d74e */ float __kernel_cosf(float x, float y) { float a,hz,z,r,qx; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; /* ix = |x|'s high word*/ if(ix<0x32000000) { /* if x < 2**27 */ if(((int)x)==0) return one; /* generate inexact */ } z = x*x; r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6))))); if(ix < 0x3e99999a) /* if |x| < 0.3 */ return one - ((float)0.5*z - (z*r - x*y)); else { if(ix > 0x3f480000) { /* x > 0.78125 */ qx = (float)0.28125; } else { SET_FLOAT_WORD(qx,ix-0x01000000); /* x/4 */ } hz = (float)0.5*z-qx; a = one-qx; return a - (hz - (z*r-x*y)); } } --- NEW FILE: k_cosf.o --- ELFÿ A5P N O D N O D --- NEW FILE: k_rem_pio2.c --- /* @(#)k_rem_pio2.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_rem_pio2.c,v 1.6 2002/05/28 17:51:46 alfred Exp $"; #endif /* * __kernel_rem_pio2(x,y,e0,nx,prec,ipio2) * double x[],y[]; int e0,nx,prec; int ipio2[]; * * __kernel_rem_pio2 return the last three digits of N with * y = x - N*pi/2 * so that |y| < pi/2. * * The method is to compute the integer (mod 8) and fraction parts of * (2/pi)*x without doing the full multiplication. In general we * skip the part of the product that are known to be a huge integer ( * more accurately, = 0 mod 8 ). Thus the number of operations are * independent of the exponent of the input. * * (2/pi) is represented by an array of 24-bit integers in ipio2[]. * * Input parameters: * x[] The input value (must be positive) is broken into nx * pieces of 24-bit integers in double precision format. * x[i] will be the i-th 24 bit of x. The scaled exponent * of x[0] is given in input parameter e0 (i.e., x[0]*2^e0 * match x's up to 24 bits. * * Example of breaking a double positive z into x[0]+x[1]+x[2]: * e0 = ilogb(z)-23 * z = scalbn(z,-e0) * for i = 0,1,2 * x[i] = floor(z) * z = (z-x[i])*2**24 * * * y[] ouput result in an array of double precision numbers. * The dimension of y[] is: * 24-bit precision 1 * 53-bit precision 2 * 64-bit precision 2 * 113-bit precision 3 * The actual value is the sum of them. Thus for 113-bit * precison, one may have to do something like: * * long double t,w,r_head, r_tail; * t = (long double)y[2] + (long double)y[1]; * w = (long double)y[0]; * r_head = t+w; * r_tail = w - (r_head - t); * * e0 The exponent of x[0] * * nx dimension of x[] * * prec an integer indicating the precision: * 0 24 bits (single) * 1 53 bits (double) * 2 64 bits (extended) * 3 113 bits (quad) * * ipio2[] * integer array, contains the (24*i)-th to (24*i+23)-th * bit of 2/pi after binary point. The corresponding * floating value is * * ipio2[i] * 2^(-24(i+1)). * * External function: * double scalbn(), floor(); * * * Here is the description of some local variables: * * jk jk+1 is the initial number of terms of ipio2[] needed * in the computation. The recommended value is 2,3,4, * 6 for single, double, extended,and quad. * * jz local integer variable indicating the number of * terms of ipio2[] used. * * jx nx - 1 * * jv index for pointing to the suitable ipio2[] for the * computation. In general, we want * ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8 * is an integer. Thus * e0-3-24*jv >= 0 or (e0-3)/24 >= jv * Hence jv = max(0,(e0-3)/24). * * jp jp+1 is the number of terms in PIo2[] needed, jp = jk. * * q[] double array with integral value, representing the * 24-bits chunk of the product of x and 2/pi. * * q0 the corresponding exponent of q[0]. Note that the * exponent for q[i] would be q0-24*i. * * PIo2[] double precision array, obtained by cutting pi/2 * into 24 bits chunks. * * f[] ipio2[] in floating point * * iq[] integer array by breaking up q[] in 24-bits chunk. * * fq[] final product of x*(2/pi) in fq[0],..,fq[jk] * * ih integer. If >0 it indicates q[] is >= 0.5, hence * it also indicates the *sign* of the result. * */ /* * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const int init_jk[] = {2,3,4,6}; /* initial value for jk */ static const double PIo2[] = { 1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */ 7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */ 5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */ 3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */ 1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */ 1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */ 2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */ 2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */ }; static const double zero = 0.0, one = 1.0, two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */ twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */ int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec, const int32_t *ipio2) { int32_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]; /* 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)((int32_t)(twon24* z)); iq[i] = (int32_t)(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 = (int32_t) 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) ih = iq[jz-1]>>23; else if(z>=0.5) ih=2; if(ih>0) { /* q > 0.5 */ n += 1; carry = 0; for(i=0;i<jz ;i++) { /* compute 1-q */ j = iq[i]; if(carry==0) { if(j!=0) { carry = 1; iq[i] = 0x1000000- j; } } else iq[i] = 0xffffff - j; } if(q0>0) { /* rare case: chance is 1 in 12 */ switch(q0) { case 1: iq[jz-1] &= 0x7fffff; break; case 2: iq[jz-1] &= 0x3fffff; break; } } if(ih==2) { z = one - z; if(carry!=0) z -= scalbn(one,q0); } } /* check if recomputation is needed */ if(z==zero) { j = 0; for (i=jz-1;i>=jk;i--) j |= iq[i]; if(j==0) { /* need recomputation */ for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */ for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */ f[jx+i] = (double) ipio2[jv+i]; for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw; } jz += k; goto recompute; } } /* chop off zero terms */ if(z==0.0) { jz -= 1; q0 -= 24; while(iq[jz]==0) { jz--; q0-=24;} } else { /* break z into 24-bit if necessary */ z = scalbn(z,-q0); if(z>=two24) { fw = (double)((int32_t)(twon24*z)); iq[jz] = (int32_t)(z-two24*fw); jz += 1; q0 += 24; iq[jz] = (int32_t) fw; } else iq[jz] = (int32_t) z ; } /* convert integer "bit" chunk to floating-point value */ fw = scalbn(one,q0); for(i=jz;i>=0;i--) { q[i] = fw*(double)iq[i]; fw*=twon24; } /* compute PIo2[0,...,jp]*q[jz,...,0] */ for(i=jz;i>=0;i--) { for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k]; fq[jz-i] = fw; } /* compress fq[] into y[] */ switch(prec) { case 0: fw = 0.0; for (i=jz;i>=0;i--) fw += fq[i]; y[0] = (ih==0)? fw: -fw; break; case 1: case 2: fw = 0.0; for (i=jz;i>=0;i--) fw += fq[i]; y[0] = (ih==0)? fw: -fw; fw = fq[0]-fw; for (i=1;i<=jz;i++) fw += fq[i]; y[1] = (ih==0)? fw: -fw; break; case 3: /* painful */ for (i=jz;i>0;i--) { fw = fq[i-1]+fq[i]; fq[i] += fq[i-1]-fw; fq[i-1] = fw; } for (i=jz;i>1;i--) { fw = fq[i-1]+fq[i]; fq[i] += fq[i-1]-fw; fq[i-1] = fw; } for (fw=0.0,i=jz;i>=2;i--) fw += fq[i]; if(ih==0) { y[0] = fq[0]; y[1] = fq[1]; y[2] = fw; } else { y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw; } } return n&7; } --- NEW FILE: k_rem_pio2f.c --- /* k_rem_pio2f.c -- float version of k_rem_pio2.c * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_rem_pio2f.c,v 1.6 2002/05/28 17:51:46 alfred Exp $"; #endif #include "math.h" #include "math_private.h" /* In the float version, the input parameter x contains 8 bit integers, not 24 bit integers. 113 bit precision is not supported. */ static const int init_jk[] = {4,7,9}; /* initial value for jk */ static const float PIo2[] = { 1.5703125000e+00, /* 0x3fc90000 */ 4.5776367188e-04, /* 0x39f00000 */ 2.5987625122e-05, /* 0x37da0000 */ 7.5437128544e-08, /* 0x33a20000 */ 6.0026650317e-11, /* 0x2e840000 */ 7.3896444519e-13, /* 0x2b500000 */ 5.3845816694e-15, /* 0x27c20000 */ 5.6378512969e-18, /* 0x22d00000 */ 8.3009228831e-20, /* 0x1fc40000 */ 3.2756352257e-22, /* 0x1bc60000 */ 6.3331015649e-25, /* 0x17440000 */ }; static const float zero = 0.0, one = 1.0, two8 = 2.5600000000e+02, /* 0x43800000 */ twon8 = 3.9062500000e-03; /* 0x3b800000 */ int __kernel_rem_pio2f(float *x, float *y, int e0, int nx, int prec, const int32_t *ipio2) { int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih; float 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)/8; if(jv<0) jv=0; q0 = e0-8*(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 : (float) 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 = (float)((int32_t)(twon8* z)); iq[i] = (int32_t)(z-two8*fw); z = q[j-1]+fw; } /* compute n */ z = scalbnf(z,q0); /* actual value of z */ z -= (float)8.0*floorf(z*(float)0.125); /* trim off integer >= 8 */ n = (int32_t) z; z -= (float)n; ih = 0; if(q0>0) { /* need iq[jz-1] to determine n */ i = (iq[jz-1]>>(8-q0)); n += i; iq[jz-1] -= i<<(8-q0); ih = iq[jz-1]>>(7-q0); } else if(q0==0) ih = iq[jz-1]>>8; else if(z>=(float)0.5) ih=2; if(ih>0) { /* q > 0.5 */ n += 1; carry = 0; for(i=0;i<jz ;i++) { /* compute 1-q */ j = iq[i]; if(carry==0) { if(j!=0) { carry = 1; iq[i] = 0x100- j; } } else iq[i] = 0xff - j; } if(q0>0) { /* rare case: chance is 1 in 12 */ switch(q0) { case 1: iq[jz-1] &= 0x7f; break; case 2: iq[jz-1] &= 0x3f; break; } } if(ih==2) { z = one - z; if(carry!=0) z -= scalbnf(one,q0); } } /* check if recomputation is needed */ if(z==zero) { j = 0; for (i=jz-1;i>=jk;i--) j |= iq[i]; if(j==0) { /* need recomputation */ for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */ for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */ f[jx+i] = (float) ipio2[jv+i]; for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw; } jz += k; goto recompute; } } /* chop off zero terms */ if(z==(float)0.0) { jz -= 1; q0 -= 8; while(iq[jz]==0) { jz--; q0-=8;} } else { /* break z into 8-bit if necessary */ z = scalbnf(z,-q0); if(z>=two8) { fw = (float)((int32_t)(twon8*z)); iq[jz] = (int32_t)(z-two8*fw); jz += 1; q0 += 8; iq[jz] = (int32_t) fw; } else iq[jz] = (int32_t) z ; } /* convert integer "bit" chunk to floating-point value */ fw = scalbnf(one,q0); for(i=jz;i>=0;i--) { q[i] = fw*(float)iq[i]; fw*=twon8; } /* compute PIo2[0,...,jp]*q[jz,...,0] */ for(i=jz;i>=0;i--) { for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k]; fq[jz-i] = fw; } /* compress fq[] into y[] */ switch(prec) { case 0: fw = 0.0; for (i=jz;i>=0;i--) fw += fq[i]; y[0] = (ih==0)? fw: -fw; break; case 1: case 2: fw = 0.0; for (i=jz;i>=0;i--) fw += fq[i]; y[0] = (ih==0)? fw: -fw; fw = fq[0]-fw; for (i=1;i<=jz;i++) fw += fq[i]; y[1] = (ih==0)? fw: -fw; break; case 3: /* painful */ for (i=jz;i>0;i--) { fw = fq[i-1]+fq[i]; fq[i] += fq[i-1]-fw; fq[i-1] = fw; } for (i=jz;i>1;i--) { fw = fq[i-1]+fq[i]; fq[i] += fq[i-1]-fw; fq[i-1] = fw; } for (fw=0.0,i=jz;i>=2;i--) fw += fq[i]; if(ih==0) { y[0] = fq[0]; y[1] = fq[1]; y[2] = fw; } else { y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw; } } return n&7; } --- NEW FILE: k_sin.c --- /* @(#)k_sin.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_sin.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* __kernel_sin( x, y, iy) * kernel sin function on [-pi/4, pi/4], pi/4 ~ 0.7854 * Input x is assumed to be bounded by ~pi/4 in magnitude. * Input y is the tail of x. * Input iy indicates whether y is 0. (if iy=0, y assume to be 0). * * Algorithm * 1. Since sin(-x) = -sin(x), we need only to consider positive x. * 2. if x < 2^-27 (hx<0x3e400000 0), return x with inexact if x!=0. * 3. sin(x) is approximated by a polynomial of degree 13 on * [0,pi/4] * 3 13 * sin(x) ~ x + S1*x + ... + S6*x * where * * |sin(x) 2 4 6 8 10 12 | -58 * |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2 * | x | * * 4. sin(x+y) = sin(x) + sin'(x')*y * ~ sin(x) + (1-x*x/2)*y * For better accuracy, let * 3 2 2 2 2 * r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6)))) * then 3 2 * sin(x) = x + (S1*x + (x *(r-y/2)+y)) */ #include "math.h" #include "math_private.h" static const double half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */ S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */ S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */ S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */ S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */ S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */ double __kernel_sin(double x, double y, int iy) { double z,r,v; int32_t ix; GET_HIGH_WORD(ix,x); ix &= 0x7fffffff; /* high word of x */ if(ix<0x3e400000) /* |x| < 2**-27 */ {if((int)x==0) return x;} /* generate inexact */ z = x*x; v = z*x; r = S2+z*(S3+z*(S4+z*(S5+z*S6))); if(iy==0) return x+v*(S1+z*r); else return x-((z*(half*y-v*r)-y)-v*S1); } --- NEW FILE: k_sinf.c --- /* k_sinf.c -- float version of k_sin.c * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_sinf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float half = 5.0000000000e-01,/* 0x3f000000 */ S1 = -1.6666667163e-01, /* 0xbe2aaaab */ S2 = 8.3333337680e-03, /* 0x3c088889 */ S3 = -1.9841270114e-04, /* 0xb9500d01 */ S4 = 2.7557314297e-06, /* 0x3638ef1b */ S5 = -2.5050759689e-08, /* 0xb2d72f34 */ S6 = 1.5896910177e-10; /* 0x2f2ec9d3 */ float __kernel_sinf(float x, float y, int iy) { float z,r,v; int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; /* high word of x */ if(ix<0x32000000) /* |x| < 2**-27 */ {if((int)x==0) return x;} /* generate inexact */ z = x*x; v = z*x; r = S2+z*(S3+z*(S4+z*(S5+z*S6))); if(iy==0) return x+v*(S1+z*r); else return x-((z*(half*y-v*r)-y)-v*S1); } --- NEW FILE: k_standard.c --- /* @(#)k_standard.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_standard.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" #include <errno.h> #ifndef _USE_WRITE #include <stdio.h> /* fputs(), stderr */ #define WRITE2(u,v) fputs(u, stderr) #else /* !defined(_USE_WRITE) */ #include <unistd.h> /* write */ #define WRITE2(u,v) write(2, u, v) #undef fflush #endif /* !defined(_USE_WRITE) */ static const double zero = 0.0; /* used as const */ /* * Standard conformance (non-IEEE) on exception cases. * Mapping: * 1 -- acos(|x|>1) * 2 -- asin(|x|>1) * 3 -- atan2(+-0,+-0) * 4 -- hypot overflow * 5 -- cosh overflow * 6 -- exp overflow * 7 -- exp underflow * 8 -- y0(0) * 9 -- y0(-ve) * 10-- y1(0) * 11-- y1(-ve) * 12-- yn(0) * 13-- yn(-ve) * 14-- lgamma(finite) overflow * 15-- lgamma(-integer) * 16-- log(0) * 17-- log(x<0) * 18-- log10(0) * 19-- log10(x<0) * 20-- pow(0.0,0.0) * 21-- pow(x,y) overflow * 22-- pow(x,y) underflow * 23-- pow(0,negative) * 24-- pow(neg,non-integral) * 25-- sinh(finite) overflow * 26-- sqrt(negative) * 27-- fmod(x,0) * 28-- remainder(x,0) * 29-- acosh(x<1) * 30-- atanh(|x|>1) * 31-- atanh(|x|=1) * 32-- scalb overflow * 33-- scalb underflow * 34-- j0(|x|>X_TLOSS) * 35-- y0(x>X_TLOSS) * 36-- j1(|x|>X_TLOSS) * 37-- y1(x>X_TLOSS) * 38-- jn(|x|>X_TLOSS, n) * 39-- yn(x>X_TLOSS, n) * 40-- gamma(finite) overflow * 41-- gamma(-integer) * 42-- pow(NaN,0.0) */ double __kernel_standard(double x, double y, int type) { struct exception exc; #ifndef HUGE_VAL /* this is the only routine that uses HUGE_VAL */ #define HUGE_VAL inf double inf = 0.0; SET_HIGH_WORD(inf,0x7ff00000); /* set inf to infinite */ #endif #ifdef _USE_WRITE (void) fflush(stdout); #endif exc.arg1 = x; exc.arg2 = y; switch(type) { case 1: case 101: /* acos(|x|>1) */ exc.type = DOMAIN; exc.name = type < 100 ? "acos" : "acosf"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if(_LIB_VERSION == _SVID_) { (void) WRITE2("acos: DOMAIN error\n", 19); } errno = EDOM; } break; case 2: case 102: /* asin(|x|>1) */ exc.type = DOMAIN; exc.name = type < 100 ? "asin" : "asinf"; exc.retval = zero; if(_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if(_LIB_VERSION == _SVID_) { (void) WRITE2("asin: DOMAIN error\n", 19); } errno = EDOM; } break; case 3: case 103: /* atan2(+-0,+-0) */ exc.arg1 = y; exc.arg2 = x; exc.type = DOMAIN; exc.name = type < 100 ? "atan2" : "atan2f"; exc.retval = zero; if(_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if(_LIB_VERSION == _SVID_) { (void) WRITE2("atan2: DOMAIN error\n", 20); } errno = EDOM; } break; case 4: case 104: /* hypot(finite,finite) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "hypot" : "hypotf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 5: case 105: /* cosh(finite) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "cosh" : "coshf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 6: case 106: /* exp(finite) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "exp" : "expf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 7: case 107: /* exp(finite) underflow */ exc.type = UNDERFLOW; exc.name = type < 100 ? "exp" : "expf"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 8: case 108: /* y0(0) = -inf */ exc.type = DOMAIN; /* should be SING for IEEE */ exc.name = type < 100 ? "y0" : "y0f"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("y0: DOMAIN error\n", 17); } errno = EDOM; } break; case 9: case 109: /* y0(x<0) = NaN */ exc.type = DOMAIN; exc.name = type < 100 ? "y0" : "y0f"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("y0: DOMAIN error\n", 17); } errno = EDOM; } break; case 10: case 110: /* y1(0) = -inf */ exc.type = DOMAIN; /* should be SING for IEEE */ exc.name = type < 100 ? "y1" : "y1f"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("y1: DOMAIN error\n", 17); } errno = EDOM; } break; case 11: case 111: /* y1(x<0) = NaN */ exc.type = DOMAIN; exc.name = type < 100 ? "y1" : "y1f"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("y1: DOMAIN error\n", 17); } errno = EDOM; } break; case 12: case 112: /* yn(n,0) = -inf */ exc.type = DOMAIN; /* should be SING for IEEE */ exc.name = type < 100 ? "yn" : "ynf"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("yn: DOMAIN error\n", 17); } errno = EDOM; } break; case 13: case 113: /* yn(x<0) = NaN */ exc.type = DOMAIN; exc.name = type < 100 ? "yn" : "ynf"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("yn: DOMAIN error\n", 17); } errno = EDOM; } break; case 14: case 114: /* lgamma(finite) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "lgamma" : "lgammaf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 15: case 115: /* lgamma(-integer) or lgamma(0) */ exc.type = SING; exc.name = type < 100 ? "lgamma" : "lgammaf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("lgamma: SING error\n", 19); } errno = EDOM; } break; case 16: case 116: /* log(0) */ exc.type = SING; exc.name = type < 100 ? "log" : "logf"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("log: SING error\n", 16); } errno = EDOM; } break; case 17: case 117: /* log(x<0) */ exc.type = DOMAIN; exc.name = type < 100 ? "log" : "logf"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("log: DOMAIN error\n", 18); } errno = EDOM; } break; case 18: case 118: /* log10(0) */ exc.type = SING; exc.name = type < 100 ? "log10" : "log10f"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("log10: SING error\n", 18); } errno = EDOM; } break; case 19: case 119: /* log10(x<0) */ exc.type = DOMAIN; exc.name = type < 100 ? "log10" : "log10f"; if (_LIB_VERSION == _SVID_) exc.retval = -HUGE; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("log10: DOMAIN error\n", 20); } errno = EDOM; } break; case 20: case 120: /* pow(0.0,0.0) */ /* error only if _LIB_VERSION == _SVID_ */ exc.type = DOMAIN; exc.name = type < 100 ? "pow" : "powf"; exc.retval = zero; if (_LIB_VERSION != _SVID_) exc.retval = 1.0; else if (!matherr(&exc)) { (void) WRITE2("pow(0,0): DOMAIN error\n", 23); errno = EDOM; } break; case 21: case 121: /* pow(x,y) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "pow" : "powf"; if (_LIB_VERSION == _SVID_) { exc.retval = HUGE; y *= 0.5; if(x<zero&&rint(y)!=y) exc.retval = -HUGE; } else { exc.retval = HUGE_VAL; y *= 0.5; if(x<zero&&rint(y)!=y) exc.retval = -HUGE_VAL; } if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 22: case 122: /* pow(x,y) underflow */ exc.type = UNDERFLOW; exc.name = type < 100 ? "pow" : "powf"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 23: case 123: /* 0**neg */ exc.type = DOMAIN; exc.name = type < 100 ? "pow" : "powf"; if (_LIB_VERSION == _SVID_) exc.retval = zero; else exc.retval = -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("pow(0,neg): DOMAIN error\n", 25); } errno = EDOM; } break; case 24: case 124: /* neg**non-integral */ exc.type = DOMAIN; exc.name = type < 100 ? "pow" : "powf"; if (_LIB_VERSION == _SVID_) exc.retval = zero; else exc.retval = zero/zero; /* X/Open allow NaN */ if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("neg**non-integral: DOMAIN error\n", 32); } errno = EDOM; } break; case 25: case 125: /* sinh(finite) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "sinh" : "sinhf"; if (_LIB_VERSION == _SVID_) exc.retval = ( (x>zero) ? HUGE : -HUGE); else exc.retval = ( (x>zero) ? HUGE_VAL : -HUGE_VAL); if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 26: case 126: /* sqrt(x<0) */ exc.type = DOMAIN; exc.name = type < 100 ? "sqrt" : "sqrtf"; if (_LIB_VERSION == _SVID_) exc.retval = zero; else exc.retval = zero/zero; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("sqrt: DOMAIN error\n", 19); } errno = EDOM; } break; case 27: case 127: /* fmod(x,0) */ exc.type = DOMAIN; exc.name = type < 100 ? "fmod" : "fmodf"; if (_LIB_VERSION == _SVID_) exc.retval = x; else exc.retval = zero/zero; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("fmod: DOMAIN error\n", 20); } errno = EDOM; } break; case 28: case 128: /* remainder(x,0) */ exc.type = DOMAIN; exc.name = type < 100 ? "remainder" : "remainderf"; exc.retval = zero/zero; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("remainder: DOMAIN error\n", 24); } errno = EDOM; } break; case 29: case 129: /* acosh(x<1) */ exc.type = DOMAIN; exc.name = type < 100 ? "acosh" : "acoshf"; exc.retval = zero/zero; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("acosh: DOMAIN error\n", 20); } errno = EDOM; } break; case 30: case 130: /* atanh(|x|>1) */ exc.type = DOMAIN; exc.name = type < 100 ? "atanh" : "atanhf"; exc.retval = zero/zero; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("atanh: DOMAIN error\n", 20); } errno = EDOM; } break; case 31: case 131: /* atanh(|x|=1) */ exc.type = SING; exc.name = type < 100 ? "atanh" : "atanhf"; exc.retval = x/zero; /* sign(x)*inf */ if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("atanh: SING error\n", 18); } errno = EDOM; } break; case 32: case 132: /* scalb overflow; SVID also returns +-HUGE_VAL */ exc.type = OVERFLOW; exc.name = type < 100 ? "scalb" : "scalbf"; exc.retval = x > zero ? HUGE_VAL : -HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 33: case 133: /* scalb underflow */ exc.type = UNDERFLOW; exc.name = type < 100 ? "scalb" : "scalbf"; exc.retval = copysign(zero,x); if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 34: case 134: /* j0(|x|>X_TLOSS) */ exc.type = TLOSS; exc.name = type < 100 ? "j0" : "j0f"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2(exc.name, 2); (void) WRITE2(": TLOSS error\n", 14); } errno = ERANGE; } break; case 35: case 135: /* y0(x>X_TLOSS) */ exc.type = TLOSS; exc.name = type < 100 ? "y0" : "y0f"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2(exc.name, 2); (void) WRITE2(": TLOSS error\n", 14); } errno = ERANGE; } break; case 36: case 136: /* j1(|x|>X_TLOSS) */ exc.type = TLOSS; exc.name = type < 100 ? "j1" : "j1f"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2(exc.name, 2); (void) WRITE2(": TLOSS error\n", 14); } errno = ERANGE; } break; case 37: case 137: /* y1(x>X_TLOSS) */ exc.type = TLOSS; exc.name = type < 100 ? "y1" : "y1f"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2(exc.name, 2); (void) WRITE2(": TLOSS error\n", 14); } errno = ERANGE; } break; case 38: case 138: /* jn(|x|>X_TLOSS) */ exc.type = TLOSS; exc.name = type < 100 ? "jn" : "jnf"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2(exc.name, 2); (void) WRITE2(": TLOSS error\n", 14); } errno = ERANGE; } break; case 39: case 139: /* yn(x>X_TLOSS) */ exc.type = TLOSS; exc.name = type < 100 ? "yn" : "ynf"; exc.retval = zero; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2(exc.name, 2); (void) WRITE2(": TLOSS error\n", 14); } errno = ERANGE; } break; case 40: case 140: /* gamma(finite) overflow */ exc.type = OVERFLOW; exc.name = type < 100 ? "gamma" : "gammaf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = ERANGE; else if (!matherr(&exc)) { errno = ERANGE; } break; case 41: case 141: /* gamma(-integer) or gamma(0) */ exc.type = SING; exc.name = type < 100 ? "gamma" : "gammaf"; if (_LIB_VERSION == _SVID_) exc.retval = HUGE; else exc.retval = HUGE_VAL; if (_LIB_VERSION == _POSIX_) errno = EDOM; else if (!matherr(&exc)) { if (_LIB_VERSION == _SVID_) { (void) WRITE2("gamma: SING error\n", 18); } errno = EDOM; } break; case 42: case 142: /* pow(NaN,0.0) */ /* error only if _LIB_VERSION == _SVID_ & _XOPEN_ */ exc.type = DOMAIN; exc.name = type < 100 ? "pow" : "powf"; exc.retval = x; if (_LIB_VERSION == _IEEE_ || _LIB_VERSION == _POSIX_) exc.retval = 1.0; else if (!matherr(&exc)) { errno = EDOM; } break; } return exc.retval; } --- NEW FILE: k_tan.c --- /* @(#)k_tan.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_tan.c,v 1.8 2003/01/01 18:48:44 schweikh Exp $"; #endif /* __kernel_tan( x, y, k ) * kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854 * Input x is assumed to be bounded by ~pi/4 in magnitude. * Input y is the tail of x. * Input k indicates whether tan (if k=1) or * -1/tan (if k= -1) is returned. * * Algorithm * 1. Since tan(-x) = -tan(x), we need only to consider positive x. * 2. if x < 2^-28 (hx<0x3e300000 0), return x with inexact if x!=0. * 3. tan(x) is approximated by an odd polynomial of degree 27 on * [0,0.67434] * 3 27 * tan(x) ~ x + T1*x + ... + T13*x * where * * |tan(x) 2 4 26 | -59.2 * |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2 * | x | * * Note: tan(x+y) = tan(x) + tan'(x)*y * ~ tan(x) + (1+x*x)*y * Therefore, for better accuracy in computing tan(x+y), let * 3 2 2 2 2 * r = x *(T2+x *(T3+x *(...+x *(T12+x *T13)))) * then * 3 2 * tan(x+y) = x + (T1*x + (x *(r+y)+y)) * * 4. For x in [0.67434,pi/4], let y = pi/4 - x, then * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y)) * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y))) */ #include "math.h" #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ pio4 = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */ pio4lo= 3.06161699786838301793e-17, /* 0x3C81A626, 0x33145C07 */ T[] = { 3.33333333333334091986e-01, /* 0x3FD55555, 0x55555563 */ 1.33333333333201242699e-01, /* 0x3FC11111, 0x1110FE7A */ 5.39682539762260521377e-02, /* 0x3FABA1BA, 0x1BB341FE */ 2.18694882948595424599e-02, /* 0x3F9664F4, 0x8406D637 */ 8.86323982359930005737e-03, /* 0x3F8226E3, 0xE96E8493 */ 3.59207910759131235356e-03, /* 0x3F6D6D22, 0xC9560328 */ 1.45620945432529025516e-03, /* 0x3F57DBC8, 0xFEE08315 */ 5.88041240820264096874e-04, /* 0x3F4344D8, 0xF2F26501 */ 2.46463134818469906812e-04, /* 0x3F3026F7, 0x1A8D1068 */ 7.81794442939557092300e-05, /* 0x3F147E88, 0xA03792A6 */ 7.14072491382608190305e-05, /* 0x3F12B80F, 0x32F0A7E9 */ -1.85586374855275456654e-05, /* 0xBEF375CB, 0xDB605373 */ 2.59073051863633712884e-05, /* 0x3EFB2A70, 0x74BF7AD4 */ }; double __kernel_tan(double x, double y, int iy) { double z,r,v,w,s; int32_t ix,hx; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; /* high word of |x| */ if(ix<0x3e300000) /* x < 2**-28 */ {if((int)x==0) { /* generate inexact */ u_int32_t low; GET_LOW_WORD(low,x); if(((ix|low)|(iy+1))==0) return one/fabs(x); else return (iy==1)? x: -one/x; } } if(ix>=0x3FE59428) { /* |x|>=0.6744 */ if(hx<0) {x = -x; y = -y;} z = pio4-x; w = pio4lo-y; x = z+w; y = 0.0; } z = x*x; w = z*z; /* Break x^5*(T[1]+x^2*T[2]+...) into * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) + * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12])) */ r = T[1]+w*(T[3]+w*(T[5]+w*(T[7]+w*(T[9]+w*T[11])))); v = z*(T[2]+w*(T[4]+w*(T[6]+w*(T[8]+w*(T[10]+w*T[12]))))); s = z*x; r = y + z*(s*(r+v)+y); r += T[0]*s; w = x+r; if(ix>=0x3FE59428) { v = (double)iy; return (double)(1-((hx>>30)&2))*(v-2.0*(x-(w*w/(w+v)-r))); } if(iy==1) return w; else { /* if allow error up to 2 ulp, simply return -1.0/(x+r) here */ /* compute -1.0/(x+r) accurately */ double a,t; z = w; SET_LOW_WORD(z,0); v = r-(z - x); /* z+v = r+x */ t = a = -1.0/w; /* a = -1.0/w */ SET_LOW_WORD(t,0); s = 1.0+t*z; return t+a*(s+t*v); } } --- NEW FILE: k_tanf.c --- /* k_tanf.c -- float version of k_tan.c * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/k_tanf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3f800000 */ pio4 = 7.8539812565e-01, /* 0x3f490fda */ pio4lo= 3.7748947079e-08, /* 0x33222168 */ T[] = { 3.3333334327e-01, /* 0x3eaaaaab */ 1.3333334029e-01, /* 0x3e088889 */ 5.3968254477e-02, /* 0x3d5d0dd1 */ 2.1869488060e-02, /* 0x3cb327a4 */ 8.8632395491e-03, /* 0x3c11371f */ 3.5920790397e-03, /* 0x3b6b6916 */ 1.4562094584e-03, /* 0x3abede48 */ 5.8804126456e-04, /* 0x3a1a26c8 */ 2.4646313977e-04, /* 0x398137b9 */ 7.8179444245e-05, /* 0x38a3f445 */ 7.1407252108e-05, /* 0x3895c07a */ -1.8558637748e-05, /* 0xb79bae5f */ 2.5907305826e-05, /* 0x37d95384 */ }; float __kernel_tanf(float x, float y, int iy) { float z,r,v,w,s; int32_t ix,hx; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; /* high word of |x| */ if(ix<0x31800000) /* x < 2**-28 */ {if((int)x==0) { /* generate inexact */ if((ix|(iy+1))==0) return one/fabsf(x); else return (iy==1)? x: -one/x; } } if(ix>=0x3f2ca140) { /* |x|>=0.6744 */ if(hx<0) {x = -x; y = -y;} z = pio4-x; w = pio4lo-y; x = z+w; y = 0.0; } z = x*x; w = z*z; /* Break x^5*(T[1]+x^2*T[2]+...) into * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) + * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12])) */ r = T[1]+w*(T[3]+w*(T[5]+w*(T[7]+w*(T[9]+w*T[11])))); v = z*(T[2]+w*(T[4]+w*(T[6]+w*(T[8]+w*(T[10]+w*T[12]))))); s = z*x; r = y + z*(s*(r+v)+y); r += T[0]*s; w = x+r; if(ix>=0x3f2ca140) { v = (float)iy; return (float)(1-((hx>>30)&2))*(v-(float)2.0*(x-(w*w/(w+v)-r))); } if(iy==1) return w; else { /* if allow error up to 2 ulp, simply return -1.0/(x+r) here */ /* compute -1.0/(x+r) accurately */ float a,t; int32_t i; z = w; GET_FLOAT_WORD(i,z); SET_FLOAT_WORD(z,i&0xfffff000); v = r-(z - x); /* z+v = r+x */ t = a = -(float)1.0/w; /* a = -1.0/w */ GET_FLOAT_WORD(i,t); SET_FLOAT_WORD(t,i&0xfffff000); s = (float)1.0+t*z; return t+a*(s+t*v); } } --- NEW FILE: s_asinh.c --- /* @(#)s_asinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_asinh.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* asinh(x) * Method : * Based on * asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ] * we have * asinh(x) := x if 1+x*x=1, * := sign(x)*(log(x)+ln2)) for large |x|, else * := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2))) */ #include "math.h" #include "math_private.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ huge= 1.00000000000000000000e+300; double asinh(double x) { double t,w; int32_t hx,ix; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) return x+x; /* x is inf or NaN */ if(ix< 0x3e300000) { /* |x|<2**-28 */ if(huge+x>one) return x; /* return x inexact except 0 */ } if(ix>0x41b00000) { /* |x| > 2**28 */ w = __ieee754_log(fabs(x))+ln2; } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */ t = fabs(x); w = __ieee754_log(2.0*t+one/(__ieee754_sqrt(x*x+one)+t)); } else { /* 2.0 > |x| > 2**-28 */ t = x*x; w =log1p(fabs(x)+t/(one+__ieee754_sqrt(one+t))); } if(hx>0) return w; else return -w; } --- NEW FILE: s_asinhf.c --- /* s_asinhf.c -- float version of s_asinh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_asinhf.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0000000000e+00, /* 0x3F800000 */ ln2 = 6.9314718246e-01, /* 0x3f317218 */ huge= 1.0000000000e+30; float asinhf(float x) { float t,w; int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) return x+x; /* x is inf or NaN */ if(ix< 0x31800000) { /* |x|<2**-28 */ if(huge+x>one) return x; /* return x inexact except 0 */ } if(ix>0x4d800000) { /* |x| > 2**28 */ w = __ieee754_logf(fabsf(x))+ln2; } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */ t = fabsf(x); w = __ieee754_logf((float)2.0*t+one/(__ieee754_sqrtf(x*x+one)+t)); } else { /* 2.0 > |x| > 2**-28 */ t = x*x; w =log1pf(fabsf(x)+t/(one+__ieee754_sqrtf(one+t))); } if(hx>0) return w; else return -w; } --- NEW FILE: s_atan.c --- /* @(#)s_atan.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_atan.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* atan(x) * Method * 1. Reduce x to positive by atan(x) = -atan(-x). * 2. According to the integer k=4t+0.25 chopped, t=x, the argument * is further reduced to one of the following intervals and the * arctangent of t is evaluated by the corresponding formula: * * [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...) * [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) ) * [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) ) * [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) ) * [39/16,INF] atan(x) = atan(INF) + atan( -1/t ) * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const double atanhi[] = { 4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */ 7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */ 9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */ 1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */ }; static const double atanlo[] = { 2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */ 3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */ 1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */ 6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */ }; static const double aT[] = { 3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */ -1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */ 1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */ -1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */ 9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */ -7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */ 6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */ -5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */ 4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */ -3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */ 1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */ }; static const double one = 1.0, huge = 1.0e300; double atan(double x) { double w,s1,s2,z; int32_t ix,hx,id; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x44100000) { /* if |x| >= 2^66 */ u_int32_t low; GET_LOW_WORD(low,x); if(ix>0x7ff00000|| (ix==0x7ff00000&&(low!=0))) return x+x; /* NaN */ if(hx>0) return atanhi[3]+atanlo[3]; else return -atanhi[3]-atanlo[3]; } if (ix < 0x3fdc0000) { /* |x| < 0.4375 */ if (ix < 0x3e200000) { /* |x| < 2^-29 */ if(huge+x>one) return x; /* raise inexact */ } id = -1; } else { x = fabs(x); if (ix < 0x3ff30000) { /* |x| < 1.1875 */ if (ix < 0x3fe60000) { /* 7/16 <=|x|<11/16 */ id = 0; x = (2.0*x-one)/(2.0+x); } else { /* 11/16<=|x|< 19/16 */ id = 1; x = (x-one)/(x+one); } } else { if (ix < 0x40038000) { /* |x| < 2.4375 */ id = 2; x = (x-1.5)/(one+1.5*x); } else { /* 2.4375 <= |x| < 2^66 */ id = 3; x = -1.0/x; } }} /* end of argument reduction */ z = x*x; w = z*z; /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */ s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10]))))); s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9])))); if (id<0) return x - x*(s1+s2); else { z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x); return (hx<0)? -z:z; } } --- NEW FILE: s_atanf.c --- /* s_atanf.c -- float version of s_atan.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_atanf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float atanhi[] = { 4.6364760399e-01, /* atan(0.5)hi 0x3eed6338 */ 7.8539812565e-01, /* atan(1.0)hi 0x3f490fda */ 9.8279368877e-01, /* atan(1.5)hi 0x3f7b985e */ 1.5707962513e+00, /* atan(inf)hi 0x3fc90fda */ }; static const float atanlo[] = { 5.0121582440e-09, /* atan(0.5)lo 0x31ac3769 */ 3.7748947079e-08, /* atan(1.0)lo 0x33222168 */ 3.4473217170e-08, /* atan(1.5)lo 0x33140fb4 */ 7.5497894159e-08, /* atan(inf)lo 0x33a22168 */ }; static const float aT[] = { 3.3333334327e-01, /* 0x3eaaaaaa */ -2.0000000298e-01, /* 0xbe4ccccd */ 1.4285714924e-01, /* 0x3e124925 */ -1.1111110449e-01, /* 0xbde38e38 */ 9.0908870101e-02, /* 0x3dba2e6e */ -7.6918758452e-02, /* 0xbd9d8795 */ 6.6610731184e-02, /* 0x3d886b35 */ -5.8335702866e-02, /* 0xbd6ef16b */ 4.9768779427e-02, /* 0x3d4bda59 */ -3.6531571299e-02, /* 0xbd15a221 */ 1.6285819933e-02, /* 0x3c8569d7 */ }; static const float one = 1.0, huge = 1.0e30; float atanf(float x) { float w,s1,s2,z; int32_t ix,hx,id; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x50800000) { /* if |x| >= 2^34 */ if(ix>0x7f800000) return x+x; /* NaN */ if(hx>0) return atanhi[3]+atanlo[3]; else return -atanhi[3]-atanlo[3]; } if (ix < 0x3ee00000) { /* |x| < 0.4375 */ if (ix < 0x31000000) { /* |x| < 2^-29 */ if(huge+x>one) return x; /* raise inexact */ } id = -1; } else { x = fabsf(x); if (ix < 0x3f980000) { /* |x| < 1.1875 */ if (ix < 0x3f300000) { /* 7/16 <=|x|<11/16 */ id = 0; x = ((float)2.0*x-one)/((float)2.0+x); } else { /* 11/16<=|x|< 19/16 */ id = 1; x = (x-one)/(x+one); } } else { if (ix < 0x401c0000) { /* |x| < 2.4375 */ id = 2; x = (x-(float)1.5)/(one+(float)1.5*x); } else { /* 2.4375 <= |x| < 2^66 */ id = 3; x = -(float)1.0/x; } }} /* end of argument reduction */ z = x*x; w = z*z; /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */ s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10]))))); s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9])))); if (id<0) return x - x*(s1+s2); else { z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x); return (hx<0)? -z:z; } } --- NEW FILE: s_cbrt.c --- /* @(#)s_cbrt.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_cbrt.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" /* cbrt(x) * Return cube root of x */ static const u_int32_t B1 = 715094163, /* B1 = (682-0.03306235651)*2**20 */ B2 = 696219795; /* B2 = (664-0.03306235651)*2**20 */ static const double C = 5.42857142857142815906e-01, /* 19/35 = 0x3FE15F15, 0xF15F15F1 */ D = -7.05306122448979611050e-01, /* -864/1225 = 0xBFE691DE, 0x2532C834 */ E = 1.41428571428571436819e+00, /* 99/70 = 0x3FF6A0EA, 0x0EA0EA0F */ F = 1.60714285714285720630e+00, /* 45/28 = 0x3FF9B6DB, 0x6DB6DB6E */ G = 3.57142857142857150787e-01; /* 5/14 = 0x3FD6DB6D, 0xB6DB6DB7 */ double cbrt(double x) { int32_t hx; double r,s,t=0.0,w; u_int32_t sign; u_int32_t high,low; GET_HIGH_WORD(hx,x); sign=hx&0x80000000; /* sign= sign(x) */ hx ^=sign; if(hx>=0x7ff00000) return(x+x); /* cbrt(NaN,INF) is itself */ GET_LOW_WORD(low,x); if((hx|low)==0) return(x); /* cbrt(0) is itself */ SET_HIGH_WORD(x,hx); /* x <- |x| */ /* rough cbrt to 5 bits */ if(hx<0x00100000) /* subnormal number */ {SET_HIGH_WORD(t,0x43500000); /* set t= 2**54 */ t*=x; GET_HIGH_WORD(high,t); SET_HIGH_WORD(t,high/3+B2); } else SET_HIGH_WORD(t,hx/3+B1); /* new cbrt to 23 bits, may be implemented in single precision */ r=t*t/x; s=C+r*t; t*=G+F/(s+E+D/s); /* chopped to 20 bits and make it larger than cbrt(x) */ GET_HIGH_WORD(high,t); INSERT_WORDS(t,high+0x00000001,0); /* one step newton iteration to 53 bits with error less than 0.667 ulps */ s=t*t; /* t*t is exact */ r=x/s; w=t+t; r=(r-t)/(w+r); /* r-s is exact */ t=t+t*r; /* retore the sign bit */ GET_HIGH_WORD(high,t); SET_HIGH_WORD(t,high|sign); return(t); } --- NEW FILE: s_cbrtf.c --- /* s_cbrtf.c -- float version of s_cbrt.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_cbrtf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" /* cbrtf(x) * Return cube root of x */ static const unsigned B1 = 709958130, /* B1 = (84+2/3-0.03306235651)*2**23 */ B2 = 642849266; /* B2 = (76+2/3-0.03306235651)*2**23 */ static const float C = 5.4285717010e-01, /* 19/35 = 0x3f0af8b0 */ D = -7.0530611277e-01, /* -864/1225 = 0xbf348ef1 */ E = 1.4142856598e+00, /* 99/70 = 0x3fb50750 */ F = 1.6071428061e+00, /* 45/28 = 0x3fcdb6db */ G = 3.5714286566e-01; /* 5/14 = 0x3eb6db6e */ float cbrtf(float x) { float r,s,t; int32_t hx; u_int32_t sign; u_int32_t high; GET_FLOAT_WORD(hx,x); sign=hx&0x80000000; /* sign= sign(x) */ hx ^=sign; if(hx>=0x7f800000) return(x+x); /* cbrt(NaN,INF) is itself */ if(hx==0) return(x); /* cbrt(0) is itself */ SET_FLOAT_WORD(x,hx); /* x <- |x| */ /* rough cbrt to 5 bits */ if(hx<0x00800000) /* subnormal number */ {SET_FLOAT_WORD(t,0x4b800000); /* set t= 2**24 */ t*=x; GET_FLOAT_WORD(high,t); SET_FLOAT_WORD(t,high/3+B2); } else SET_FLOAT_WORD(t,hx/3+B1); /* new cbrt to 23 bits */ r=t*t/x; s=C+r*t; t*=G+F/(s+E+D/s); /* retore the sign bit */ GET_FLOAT_WORD(high,t); SET_FLOAT_WORD(t,high|sign); return(t); } --- NEW FILE: s_ceil.c --- /* @(#)s_ceil.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_ceil.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* * ceil(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to ceil(x). */ #include "math.h" #include "math_private.h" static const double huge = 1.0e300; double ceil(double x) { int32_t i0,i1,j0; u_int32_t i,j; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ if(i0<0) {i0=0x80000000;i1=0;} else if((i0|i1)!=0) { i0=0x3ff00000;i1=0;} } } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0>0) i0 += (0x00100000)>>j0; i0 &= (~i); i1=0; } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0>0) { if(j0==20) i0+=1; else { j = i1 + (1<<(52-j0)); if(j<i1) i0+=1; /* got a carry */ i1 = j; } } i1 &= (~i); } } INSERT_WORDS(x,i0,i1); return x; } --- NEW FILE: s_ceilf.c --- /* s_ceilf.c -- float version of s_ceil.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_ceilf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float huge = 1.0e30; float ceilf(float x) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */ if(i0<0) {i0=0x80000000;} else if(i0!=0) { i0=0x3f800000;} } } else { i = (0x007fffff)>>j0; if((i0&i)==0) return x; /* x is integral */ if(huge+x>(float)0.0) { /* raise inexact flag */ if(i0>0) i0 += (0x00800000)>>j0; i0 &= (~i); } } } else { if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } SET_FLOAT_WORD(x,i0); return x; } --- NEW FILE: s_copysign.c --- /* @(#)s_copysign.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_copysign.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* * copysign(double x, double y) * copysign(x,y) returns a value with the magnitude of x and * with the sign bit of y. */ #include "math.h" #include "math_private.h" double copysign(double x, double y) { u_int32_t hx,hy; GET_HIGH_WORD(hx,x); GET_HIGH_WORD(hy,y); SET_HIGH_WORD(x,(hx&0x7fffffff)|(hy&0x80000000)); return x; } --- NEW FILE: s_copysignf.c --- /* s_copysignf.c -- float version of s_copysign.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_copysignf.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* * copysignf(float x, float y) * copysignf(x,y) returns a value with the magnitude of x and * with the sign bit of y. */ #include "math.h" #include "math_private.h" float copysignf(float x, float y) { u_int32_t ix,iy; GET_FLOAT_WORD(ix,x); GET_FLOAT_WORD(iy,y); SET_FLOAT_WORD(x,(ix&0x7fffffff)|(iy&0x80000000)); return x; } --- NEW FILE: s_cos.c --- /* @(#)s_cos.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_cos.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* cos(x) * Return cosine function of x. * * kernel function: * __kernel_sin ... sine function on [-pi/4,pi/4] * __kernel_cos ... cosine function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 * in [-pi/4 , +pi/4], and let n = k mod 4. * We have * * n sin(x) cos(x) tan(x) * ---------------------------------------------------------- * 0 S C T * 1 C -S -1/T * 2 -S -C T * 3 -C S -1/T * ---------------------------------------------------------- * * Special cases: * Let trig be any of sin, cos, or tan. * trig(+-INF) is NaN, with signals; * trig(NaN) is that NaN; * * Accuracy: * TRIG(x) returns trig(x) nearly rounded */ #include "math.h" #include "math_private.h" double cos(double x) { double y[2],z=0.0; int32_t n, ix; /* High word of x. */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) return __kernel_cos(x,z); /* cos(Inf or NaN) is NaN */ else if (ix>=0x7ff00000) return x-x; /* argument reduction needed */ else { n = __ieee754_rem_pio2(x,y); switch(n&3) { case 0: return __kernel_cos(y[0],y[1]); case 1: return -__kernel_sin(y[0],y[1],1); case 2: return -__kernel_cos(y[0],y[1]); default: return __kernel_sin(y[0],y[1],1); } } } --- NEW FILE: s_cosf.c --- /* s_cosf.c -- float version of s_cos.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_cosf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one=1.0; float cosf(float x) { float y[2],z=0.0; int32_t n,ix; GET_FLOAT_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3f490fd8) return __kernel_cosf(x,z); /* cos(Inf or NaN) is NaN */ else if (ix>=0x7f800000) return x-x; /* argument reduction needed */ else { n = __ieee754_rem_pio2f(x,y); switch(n&3) { case 0: return __kernel_cosf(y[0],y[1]); case 1: return -__kernel_sinf(y[0],y[1],1); case 2: return -__kernel_cosf(y[0],y[1]); default: return __kernel_sinf(y[0],y[1],1); } } } --- NEW FILE: s_erf.c --- /* @(#)s_erf.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_erf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* double erf(double x) * double erfc(double x) * x * 2 |\ * erf(x) = --------- | exp(-t*t)dt * sqrt(pi) \| * 0 * * erfc(x) = 1-erf(x) * Note that * erf(-x) = -erf(x) * erfc(-x) = 2 - erfc(x) * * Method: * 1. For |x| in [0, 0.84375] * erf(x) = x + x*R(x^2) * erfc(x) = 1 - erf(x) if x in [-.84375,0.25] * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375] * where R = P/Q where P is an odd poly of degree 8 and * Q is an odd poly of degree 10. * -57.90 * | R - (erf(x)-x)/x | <= 2 * * * Remark. The formula is derived by noting * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....) * and that * 2/sqrt(pi) = 1.128379167095512573896158903121545171688 * is close to one. The interval is chosen because the fix * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is * near 0.6174), and by some experiment, 0.84375 is chosen to * guarantee the error is less than one ulp for erf. * * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and * c = 0.84506291151 rounded to single (24 bits) * erf(x) = sign(x) * (c + P1(s)/Q1(s)) * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0 * 1+(c+P1(s)/Q1(s)) if x < 0 * |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06 * Remark: here we use the taylor series expansion at x=1. * erf(1+s) = erf(1) + s*Poly(s) * = 0.845.. + P1(s)/Q1(s) * That is, we use rational approximation to approximate * erf(1+s) - (c = (single)0.84506291151) * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25] * where * P1(s) = degree 6 poly in s * Q1(s) = degree 6 poly in s * * 3. For x in [1.25,1/0.35(~2.857143)], * erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1) * erf(x) = 1 - erfc(x) * where * R1(z) = degree 7 poly in z, (z=1/x^2) * S1(z) = degree 8 poly in z * * 4. For x in [1/0.35,28] * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0 * = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6<x<0 * = 2.0 - tiny (if x <= -6) * erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6, else * erf(x) = sign(x)*(1.0 - tiny) * where * R2(z) = degree 6 poly in z, (z=1/x^2) * S2(z) = degree 7 poly in z * * Note1: * To compute exp(-x*x-0.5625+R/S), let s be a single * precision number and s := x; then * -x*x = -s*s + (s-x)*(s+x) * exp(-x*x-0.5626+R/S) = * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S); * Note2: * Here 4 and 5 make use of the asymptotic series * exp(-x*x) * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) ) * x*sqrt(pi) * We use rational approximation to approximate * g(s)=f(1/x^2) = log(erfc(x)*x) - x*x + 0.5625 * Here is the error bound for R1/S1 and R2/S2 * |R1/S1 - f(x)| < 2**(-62.57) * |R2/S2 - f(x)| < 2**(-61.52) * * 5. For inf > x >= 28 * erf(x) = sign(x) *(1 - tiny) (raise inexact) * erfc(x) = tiny*tiny (raise underflow) if x > 0 * = 2 - tiny if x<0 * * 7. Special case: * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, * erfc/erf(NaN) is NaN */ #include "math.h" #include "math_private.h" static const double tiny = 1e-300, half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */ /* c = (float)0.84506291151 */ erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */ /* * Coefficients for approximation to erf on [0,0.84375] */ efx = 1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */ efx8= 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */ pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */ pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */ pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */ pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */ pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */ qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */ qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */ qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */ qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */ qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */ /* * Coefficients for approximation to erf in [0.84375,1.25] */ pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */ pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */ pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */ pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */ pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */ pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */ pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */ qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */ qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */ qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */ qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */ qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */ qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */ /* * Coefficients for approximation to erfc in [1.25,1/0.35] */ ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */ ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */ ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */ ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */ ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */ ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */ ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */ ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */ sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */ sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */ sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */ sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */ sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */ sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */ sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */ sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */ /* * Coefficients for approximation to erfc in [1/.35,28] */ rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */ rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */ rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */ rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */ rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */ rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */ rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */ sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */ sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */ sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */ sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */ sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */ sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */ sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */ double erf(double x) { int32_t hx,ix,i; double R,S,P,Q,s,y,z,r; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) { /* erf(nan)=nan */ i = ((u_int32_t)hx>>31)<<1; return (double)(1-i)+one/x; /* erf(+-inf)=+-1 */ } if(ix < 0x3feb0000) { /* |x|<0.84375 */ if(ix < 0x3e300000) { /* |x|<2**-28 */ if (ix < 0x00800000) return 0.125*(8.0*x+efx8*x); /*avoid underflow */ return x + efx*x; } z = x*x; r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); y = r/s; return x + x*y; } if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */ s = fabs(x)-one; P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); if(hx>=0) return erx + P/Q; else return -erx - P/Q; } if (ix >= 0x40180000) { /* inf>|x|>=6 */ if(hx>=0) return one-tiny; else return tiny-one; } x = fabs(x); s = one/(x*x); if(ix< 0x4006DB6E) { /* |x| < 1/0.35 */ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( ra5+s*(ra6+s*ra7)))))); S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( sa5+s*(sa6+s*(sa7+s*sa8))))))); } else { /* |x| >= 1/0.35 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( rb5+s*rb6))))); S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( sb5+s*(sb6+s*sb7)))))); } z = x; SET_LOW_WORD(z,0); r = __ieee754_exp(-z*z-0.5625)*__ieee754_exp((z-x)*(z+x)+R/S); if(hx>=0) return one-r/x; else return r/x-one; } double erfc(double x) { int32_t hx,ix; double R,S,P,Q,s,y,z,r; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7ff00000) { /* erfc(nan)=nan */ /* erfc(+-inf)=0,2 */ return (double)(((u_int32_t)hx>>31)<<1)+one/x; } if(ix < 0x3feb0000) { /* |x|<0.84375 */ if(ix < 0x3c700000) /* |x|<2**-56 */ return one-x; z = x*x; r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); y = r/s; if(hx < 0x3fd00000) { /* x<1/4 */ return one-(x+x*y); } else { r = x*y; r += (x-half); return half - r ; } } if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */ s = fabs(x)-one; P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); if(hx>=0) { z = one-erx; return z - P/Q; } else { z = erx+P/Q; return one+z; } } if (ix < 0x403c0000) { /* |x|<28 */ x = fabs(x); s = one/(x*x); if(ix< 0x4006DB6D) { /* |x| < 1/.35 ~ 2.857143*/ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( ra5+s*(ra6+s*ra7)))))); S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( sa5+s*(sa6+s*(sa7+s*sa8))))))); } else { /* |x| >= 1/.35 ~ 2.857143 */ if(hx<0&&ix>=0x40180000) return two-tiny;/* x < -6 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( rb5+s*rb6))))); S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( sb5+s*(sb6+s*sb7)))))); } z = x; SET_LOW_WORD(z,0); r = __ieee754_exp(-z*z-0.5625)* __ieee754_exp((z-x)*(z+x)+R/S); if(hx>0) return r/x; else return two-r/x; } else { if(hx>0) return tiny*tiny; else return two-tiny; } } --- NEW FILE: s_erff.c --- /* s_erff.c -- float version of s_erf.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_erff.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float tiny = 1e-30, half= 5.0000000000e-01, /* 0x3F000000 */ one = 1.0000000000e+00, /* 0x3F800000 */ two = 2.0000000000e+00, /* 0x40000000 */ /* c = (subfloat)0.84506291151 */ erx = 8.4506291151e-01, /* 0x3f58560b */ /* * Coefficients for approximation to erf on [0,0.84375] */ efx = 1.2837916613e-01, /* 0x3e0375d4 */ efx8= 1.0270333290e+00, /* 0x3f8375d4 */ pp0 = 1.2837916613e-01, /* 0x3e0375d4 */ pp1 = -3.2504209876e-01, /* 0xbea66beb */ pp2 = -2.8481749818e-02, /* 0xbce9528f */ pp3 = -5.7702702470e-03, /* 0xbbbd1489 */ pp4 = -2.3763017452e-05, /* 0xb7c756b1 */ qq1 = 3.9791721106e-01, /* 0x3ecbbbce */ qq2 = 6.5022252500e-02, /* 0x3d852a63 */ qq3 = 5.0813062117e-03, /* 0x3ba68116 */ qq4 = 1.3249473704e-04, /* 0x390aee49 */ qq5 = -3.9602282413e-06, /* 0xb684e21a */ /* * Coefficients for approximation to erf in [0.84375,1.25] */ pa0 = -2.3621185683e-03, /* 0xbb1acdc6 */ pa1 = 4.1485610604e-01, /* 0x3ed46805 */ pa2 = -3.7220788002e-01, /* 0xbebe9208 */ pa3 = 3.1834661961e-01, /* 0x3ea2fe54 */ pa4 = -1.1089469492e-01, /* 0xbde31cc2 */ pa5 = 3.5478305072e-02, /* 0x3d1151b3 */ pa6 = -2.1663755178e-03, /* 0xbb0df9c0 */ qa1 = 1.0642088205e-01, /* 0x3dd9f331 */ qa2 = 5.4039794207e-01, /* 0x3f0a5785 */ qa3 = 7.1828655899e-02, /* 0x3d931ae7 */ qa4 = 1.2617121637e-01, /* 0x3e013307 */ qa5 = 1.3637083583e-02, /* 0x3c5f6e13 */ qa6 = 1.1984500103e-02, /* 0x3c445aa3 */ /* * Coefficients for approximation to erfc in [1.25,1/0.35] */ ra0 = -9.8649440333e-03, /* 0xbc21a093 */ ra1 = -6.9385856390e-01, /* 0xbf31a0b7 */ ra2 = -1.0558626175e+01, /* 0xc128f022 */ ra3 = -6.2375331879e+01, /* 0xc2798057 */ ra4 = -1.6239666748e+02, /* 0xc322658c */ ra5 = -1.8460508728e+02, /* 0xc3389ae7 */ ra6 = -8.1287437439e+01, /* 0xc2a2932b */ ra7 = -9.8143291473e+00, /* 0xc11d077e */ sa1 = 1.9651271820e+01, /* 0x419d35ce */ sa2 = 1.3765776062e+02, /* 0x4309a863 */ sa3 = 4.3456588745e+02, /* 0x43d9486f */ sa4 = 6.4538726807e+02, /* 0x442158c9 */ sa5 = 4.2900814819e+02, /* 0x43d6810b */ sa6 = 1.0863500214e+02, /* 0x42d9451f */ sa7 = 6.5702495575e+00, /* 0x40d23f7c */ sa8 = -6.0424413532e-02, /* 0xbd777f97 */ /* * Coefficients for approximation to erfc in [1/.35,28] */ rb0 = -9.8649431020e-03, /* 0xbc21a092 */ rb1 = -7.9928326607e-01, /* 0xbf4c9dd4 */ rb2 = -1.7757955551e+01, /* 0xc18e104b */ rb3 = -1.6063638306e+02, /* 0xc320a2ea */ rb4 = -6.3756646729e+02, /* 0xc41f6441 */ rb5 = -1.0250950928e+03, /* 0xc480230b */ rb6 = -4.8351919556e+02, /* 0xc3f1c275 */ sb1 = 3.0338060379e+01, /* 0x41f2b459 */ sb2 = 3.2579251099e+02, /* 0x43a2e571 */ sb3 = 1.5367296143e+03, /* 0x44c01759 */ sb4 = 3.1998581543e+03, /* 0x4547fdbb */ sb5 = 2.5530502930e+03, /* 0x451f90ce */ sb6 = 4.7452853394e+02, /* 0x43ed43a7 */ sb7 = -2.2440952301e+01; /* 0xc1b38712 */ float erff(float x) { int32_t hx,ix,i; float R,S,P,Q,s,y,z,r; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) { /* erf(nan)=nan */ i = ((u_int32_t)hx>>31)<<1; return (float)(1-i)+one/x; /* erf(+-inf)=+-1 */ } if(ix < 0x3f580000) { /* |x|<0.84375 */ if(ix < 0x31800000) { /* |x|<2**-28 */ if (ix < 0x04000000) /*avoid underflow */ return (float)0.125*((float)8.0*x+efx8*x); return x + efx*x; } z = x*x; r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); y = r/s; return x + x*y; } if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */ s = fabsf(x)-one; P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); if(hx>=0) return erx + P/Q; else return -erx - P/Q; } if (ix >= 0x40c00000) { /* inf>|x|>=6 */ if(hx>=0) return one-tiny; else return tiny-one; } x = fabsf(x); s = one/(x*x); if(ix< 0x4036DB6E) { /* |x| < 1/0.35 */ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( ra5+s*(ra6+s*ra7)))))); S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( sa5+s*(sa6+s*(sa7+s*sa8))))))); } else { /* |x| >= 1/0.35 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( rb5+s*rb6))))); S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( sb5+s*(sb6+s*sb7)))))); } GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(z,ix&0xfffff000); r = __ieee754_expf(-z*z-(float)0.5625)*__ieee754_expf((z-x)*(z+x)+R/S); if(hx>=0) return one-r/x; else return r/x-one; } float erfcf(float x) { int32_t hx,ix; float R,S,P,Q,s,y,z,r; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; if(ix>=0x7f800000) { /* erfc(nan)=nan */ /* erfc(+-inf)=0,2 */ return (float)(((u_int32_t)hx>>31)<<1)+one/x; } if(ix < 0x3f580000) { /* |x|<0.84375 */ if(ix < 0x23800000) /* |x|<2**-56 */ return one-x; z = x*x; r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); y = r/s; if(hx < 0x3e800000) { /* x<1/4 */ return one-(x+x*y); } else { r = x*y; r += (x-half); return half - r ; } } if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */ s = fabsf(x)-one; P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); if(hx>=0) { z = one-erx; return z - P/Q; } else { z = erx+P/Q; return one+z; } } if (ix < 0x41e00000) { /* |x|<28 */ x = fabsf(x); s = one/(x*x); if(ix< 0x4036DB6D) { /* |x| < 1/.35 ~ 2.857143*/ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( ra5+s*(ra6+s*ra7)))))); S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( sa5+s*(sa6+s*(sa7+s*sa8))))))); } else { /* |x| >= 1/.35 ~ 2.857143 */ if(hx<0&&ix>=0x40c00000) return two-tiny;/* x < -6 */ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( rb5+s*rb6))))); S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( sb5+s*(sb6+s*sb7)))))); } GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(z,ix&0xfffff000); r = __ieee754_expf(-z*z-(float)0.5625)* __ieee754_expf((z-x)*(z+x)+R/S); if(hx>0) return r/x; else return two-r/x; } else { if(hx>0) return tiny*tiny; else return two-tiny; } } --- NEW FILE: s_expm1.c --- /* @(#)s_expm1.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_expm1.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* expm1(x) * Returns exp(x)-1, the exponential of x minus 1. * * Method * 1. Argument reduction: * Given x, find r and integer k such that * * x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658 * * Here a correction term c will be computed to compensate * the error in r when rounded to a floating-point number. * * 2. Approximating expm1(r) by a special rational function on * the interval [0,0.34658]: * Since * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ... * we define R1(r*r) by * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r) * That is, * R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r) * = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r)) * = 1 - r^2/60 + r^4/2520 - r^6/100800 + ... * We use a special Reme algorithm on [0,0.347] to generate * a polynomial of degree 5 in r*r to approximate R1. The * maximum error of this polynomial approximation is bounded * by 2**-61. In other words, * R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5 * where Q1 = -1.6666666666666567384E-2, * Q2 = 3.9682539681370365873E-4, * Q3 = -9.9206344733435987357E-6, * Q4 = 2.5051361420808517002E-7, * Q5 = -6.2843505682382617102E-9; * (where z=r*r, and the values of Q1 to Q5 are listed below) * with error bounded by * | 5 | -61 * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2 * | | * * expm1(r) = exp(r)-1 is then computed by the following * specific way which minimize the accumulation rounding error: * 2 3 * r r [ 3 - (R1 + R1*r/2) ] * expm1(r) = r + --- + --- * [--------------------] * 2 2 [ 6 - r*(3 - R1*r/2) ] * * To compensate the error in the argument reduction, we use * expm1(r+c) = expm1(r) + c + expm1(r)*c * ~ expm1(r) + c + r*c * Thus c+r*c will be added in as the correction terms for * expm1(r+c). Now rearrange the term to avoid optimization * screw up: * ( 2 2 ) * ({ ( r [ R1 - (3 - R1*r/2) ] ) } r ) * expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- ) * ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 ) * ( ) * * = r - E * 3. Scale back to obtain expm1(x): * From step 1, we have * expm1(x) = either 2^k*[expm1(r)+1] - 1 * = or 2^k*[expm1(r) + (1-2^-k)] * 4. Implementation notes: * (A). To save one multiplication, we scale the coefficient Qi * to Qi*2^i, and replace z by (x^2)/2. * (B). To achieve maximum accuracy, we compute expm1(x) by * (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf) * (ii) if k=0, return r-E * (iii) if k=-1, return 0.5*(r-E)-0.5 * (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E) * else return 1.0+2.0*(r-E); * (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1) * (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else * (vii) return 2^k(1-((E+2^-k)-r)) * * Special cases: * expm1(INF) is INF, expm1(NaN) is NaN; * expm1(-INF) is -1, and * for finite argument, only expm1(0)=0 is exact. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Misc. info. * For IEEE double * if x > 7.09782712893383973096e+02 then expm1(x) overflow * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. */ #include "math.h" #include "math_private.h" static const double one = 1.0, huge = 1.0e+300, tiny = 1.0e-300, o_threshold = 7.09782712893383973096e+02,/* 0x40862E42, 0xFEFA39EF */ ln2_hi = 6.93147180369123816490e-01,/* 0x3fe62e42, 0xfee00000 */ ln2_lo = 1.90821492927058770002e-10,/* 0x3dea39ef, 0x35793c76 */ invln2 = 1.44269504088896338700e+00,/* 0x3ff71547, 0x652b82fe */ /* scaled coefficients related to expm1 */ Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */ Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */ Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */ Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ double expm1(double x) { double y,hi,lo,c,t,e,hxs,hfx,r1; int32_t k,xsb; u_int32_t hx; GET_HIGH_WORD(hx,x); xsb = hx&0x80000000; /* sign bit of x */ if(xsb==0) y=x; else y= -x; /* y = |x| */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out huge and non-finite argument */ if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */ if(hx >= 0x40862E42) { /* if |x|>=709.78... */ if(hx>=0x7ff00000) { u_int32_t low; GET_LOW_WORD(low,x); if(((hx&0xfffff)|low)!=0) return x+x; /* NaN */ else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ } if(x > o_threshold) return huge*huge; /* overflow */ } if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */ if(x+tiny<0.0) /* raise inexact */ return tiny-one; /* return -1 */ } } /* argument reduction */ if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */ if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */ if(xsb==0) {hi = x - ln2_hi; lo = ln2_lo; k = 1;} else {hi = x + ln2_hi; lo = -ln2_lo; k = -1;} } else { k = invln2*x+((xsb==0)?0.5:-0.5); t = k; hi = x - t*ln2_hi; /* t*ln2_hi is exact here */ lo = t*ln2_lo; } x = hi - lo; c = (hi-x)-lo; } else if(hx < 0x3c900000) { /* when |x|<2**-54, return x */ t = huge+x; /* return x with inexact flags when x!=0 */ return x - (t-(huge+x)); } else k = 0; /* x is now in primary range */ hfx = 0.5*x; hxs = x*hfx; r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5)))); t = 3.0-r1*hfx; e = hxs*((r1-t)/(6.0 - x*t)); if(k==0) return x - (x*e-hxs); /* c is 0 */ else { e = (x*(e-c)-c); e -= hxs; if(k== -1) return 0.5*(x-e)-0.5; if(k==1) if(x < -0.25) return -2.0*(e-(x+0.5)); else return one+2.0*(x-e); if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ u_int32_t high; y = one-(e-x); GET_HIGH_WORD(high,y); SET_HIGH_WORD(y,high+(k<<20)); /* add k to y's exponent */ return y-one; } t = one; if(k<20) { u_int32_t high; SET_HIGH_WORD(t,0x3ff00000 - (0x200000>>k)); /* t=1-2^-k */ y = t-(e-x); GET_HIGH_WORD(high,y); SET_HIGH_WORD(y,high+(k<<20)); /* add k to y's exponent */ } else { u_int32_t high; SET_HIGH_WORD(t,((0x3ff-k)<<20)); /* 2^-k */ y = x-(e+t); y += one; GET_HIGH_WORD(high,y); SET_HIGH_WORD(y,high+(k<<20)); /* add k to y's exponent */ } } return y; } --- NEW FILE: s_expm1f.c --- /* s_expm1f.c -- float version of s_expm1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_expm1f.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0, huge = 1.0e+30, tiny = 1.0e-30, o_threshold = 8.8721679688e+01,/* 0x42b17180 */ ln2_hi = 6.9313812256e-01,/* 0x3f317180 */ ln2_lo = 9.0580006145e-06,/* 0x3717f7d1 */ invln2 = 1.4426950216e+00,/* 0x3fb8aa3b */ /* scaled coefficients related to expm1 */ Q1 = -3.3333335072e-02, /* 0xbd088889 */ Q2 = 1.5873016091e-03, /* 0x3ad00d01 */ Q3 = -7.9365076090e-05, /* 0xb8a670cd */ Q4 = 4.0082177293e-06, /* 0x36867e54 */ Q5 = -2.0109921195e-07; /* 0xb457edbb */ float expm1f(float x) { float y,hi,lo,c,t,e,hxs,hfx,r1; int32_t k,xsb; u_int32_t hx; GET_FLOAT_WORD(hx,x); xsb = hx&0x80000000; /* sign bit of x */ if(xsb==0) y=x; else y= -x; /* y = |x| */ hx &= 0x7fffffff; /* high word of |x| */ /* filter out huge and non-finite argument */ if(hx >= 0x4195b844) { /* if |x|>=27*ln2 */ if(hx >= 0x42b17218) { /* if |x|>=88.721... */ if(hx>0x7f800000) return x+x; /* NaN */ if(hx==0x7f800000) return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ if(x > o_threshold) return huge*huge; /* overflow */ } if(xsb!=0) { /* x < -27*ln2, return -1.0 with inexact */ if(x+tiny<(float)0.0) /* raise inexact */ return tiny-one; /* return -1 */ } } /* argument reduction */ if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */ if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */ if(xsb==0) {hi = x - ln2_hi; lo = ln2_lo; k = 1;} else {hi = x + ln2_hi; lo = -ln2_lo; k = -1;} } else { k = invln2*x+((xsb==0)?(float)0.5:(float)-0.5); t = k; hi = x - t*ln2_hi; /* t*ln2_hi is exact here */ lo = t*ln2_lo; } x = hi - lo; c = (hi-x)-lo; } else if(hx < 0x33000000) { /* when |x|<2**-25, return x */ t = huge+x; /* return x with inexact flags when x!=0 */ return x - (t-(huge+x)); } else k = 0; /* x is now in primary range */ hfx = (float)0.5*x; hxs = x*hfx; r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5)))); t = (float)3.0-r1*hfx; e = hxs*((r1-t)/((float)6.0 - x*t)); if(k==0) return x - (x*e-hxs); /* c is 0 */ else { e = (x*(e-c)-c); e -= hxs; if(k== -1) return (float)0.5*(x-e)-(float)0.5; if(k==1) if(x < (float)-0.25) return -(float)2.0*(e-(x+(float)0.5)); else return one+(float)2.0*(x-e); if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ int32_t i; y = one-(e-x); GET_FLOAT_WORD(i,y); SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */ return y-one; } t = one; if(k<23) { int32_t i; SET_FLOAT_WORD(t,0x3f800000 - (0x1000000>>k)); /* t=1-2^-k */ y = t-(e-x); GET_FLOAT_WORD(i,y); SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */ } else { int32_t i; SET_FLOAT_WORD(t,((0x7f-k)<<23)); /* 2^-k */ y = x-(e+t); y += one; GET_FLOAT_WORD(i,y); SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */ } } return y; } --- NEW FILE: s_fabs.c --- /* @(#)s_fabs.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_fabs.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * fabs(x) returns the absolute value of x. */ #include "math.h" #include "math_private.h" double fabs(double x) { u_int32_t high; GET_HIGH_WORD(high,x); SET_HIGH_WORD(x,high&0x7fffffff); return x; } --- NEW FILE: s_fabsf.c --- /* s_fabsf.c -- float version of s_fabs.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_fabsf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * fabsf(x) returns the absolute value of x. */ #include "math.h" #include "math_private.h" float fabsf(float x) { u_int32_t ix; GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(x,ix&0x7fffffff); return x; } --- NEW FILE: s_fabsl.c --- /*- * Copyright (c) 2003 Dag-Erling Coïdan Smørgrav * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer * in this position and unchanged. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * $FreeBSD: src/lib/msun/src/s_fabsl.c,v 1.2 2003/10/25 19:53:28 des Exp $ */ #include <math.h> #include "fpmath.h" long double fabsl(long double x) { union IEEEl2bits u; u.e = x; u.bits.sign = 0; return (u.e); } --- NEW FILE: s_finite.c --- /* @(#)s_finite.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_finite.c,v 1.8 2003/07/23 04:53:46 peter Exp $"; #endif /* * finite(x) returns 1 is x is finite, else 0; * no branching! */ #include "math.h" #include "math_private.h" int finite(double x) { int32_t hx; GET_HIGH_WORD(hx,x); return (int)((u_int32_t)((hx&0x7fffffff)-0x7ff00000)>>31); } --- NEW FILE: s_finitef.c --- /* s_finitef.c -- float version of s_finite.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_finitef.c,v 1.6 2002/05/28 17:51:46 alfred Exp $"; #endif /* * finitef(x) returns 1 is x is finite, else 0; * no branching! */ #include "math.h" #include "math_private.h" int finitef(float x) { int32_t ix; GET_FLOAT_WORD(ix,x); return (int)((u_int32_t)((ix&0x7fffffff)-0x7f800000)>>31); } --- NEW FILE: s_floor.c --- /* @(#)s_floor.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_floor.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* * floor(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floor(x). */ #include "math.h" #include "math_private.h" static const double huge = 1.0e300; double floor(double x) { int32_t i0,i1,j0; u_int32_t i,j; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ if(i0>=0) {i0=i1=0;} else if(((i0&0x7fffffff)|i1)!=0) { i0=0xbff00000;i1=0;} } } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0<0) i0 += (0x00100000)>>j0; i0 &= (~i); i1=0; } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ if(huge+x>0.0) { /* raise inexact flag */ if(i0<0) { if(j0==20) i0+=1; else { j = i1+(1<<(52-j0)); if(j<i1) i0 +=1 ; /* got a carry */ i1=j; } } i1 &= (~i); } } INSERT_WORDS(x,i0,i1); return x; } --- NEW FILE: s_floorf.c --- /* s_floorf.c -- float version of s_floor.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_floorf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * floorf(x) * Return x rounded toward -inf to integral value * Method: * Bit twiddling. * Exception: * Inexact flag raised if x not equal to floorf(x). */ #include "math.h" #include "math_private.h" static const float huge = 1.0e30; float floorf(float x) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { /* raise inexact if x != 0 */ if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */ if(i0>=0) {i0=0;} else if((i0&0x7fffffff)!=0) { i0=0xbf800000;} } } else { i = (0x007fffff)>>j0; if((i0&i)==0) return x; /* x is integral */ if(huge+x>(float)0.0) { /* raise inexact flag */ if(i0<0) i0 += (0x00800000)>>j0; i0 &= (~i); } } } else { if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } SET_FLOAT_WORD(x,i0); return x; } --- NEW FILE: s_frexp.c --- /* @(#)s_frexp.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_frexp.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* * for non-zero x * x = frexp(arg,&exp); * return a double fp quantity x such that 0.5 <= |x| <1.0 * and the corresponding binary exponent "exp". That is * arg = x*2^exp. * If arg is inf, 0.0, or NaN, then frexp(arg,&exp) returns arg * with *exp=0. */ #include "math.h" #include "math_private.h" static const double two54 = 1.80143985094819840000e+16; /* 0x43500000, 0x00000000 */ double frexp(double x, int *eptr) { int32_t hx, ix, lx; EXTRACT_WORDS(hx,lx,x); ix = 0x7fffffff&hx; *eptr = 0; if(ix>=0x7ff00000||((ix|lx)==0)) return x; /* 0,inf,nan */ if (ix<0x00100000) { /* subnormal */ x *= two54; GET_HIGH_WORD(hx,x); ix = hx&0x7fffffff; *eptr = -54; } *eptr += (ix>>20)-1022; hx = (hx&0x800fffff)|0x3fe00000; SET_HIGH_WORD(x,hx); return x; } --- NEW FILE: s_frexpf.c --- /* s_frexpf.c -- float version of s_frexp.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_frexpf.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float two25 = 3.3554432000e+07; /* 0x4c000000 */ float frexpf(float x, int *eptr) { int32_t hx,ix; GET_FLOAT_WORD(hx,x); ix = 0x7fffffff&hx; *eptr = 0; if(ix>=0x7f800000||(ix==0)) return x; /* 0,inf,nan */ if (ix<0x00800000) { /* subnormal */ x *= two25; GET_FLOAT_WORD(hx,x); ix = hx&0x7fffffff; *eptr = -25; } *eptr += (ix>>23)-126; hx = (hx&0x807fffff)|0x3f000000; *(int*)&x = hx; return x; } --- NEW FILE: s_ilogb.c --- /* @(#)s_ilogb.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_ilogb.c,v 1.8 2003/07/23 04:53:46 peter Exp $"; #endif /* ilogb(double x) * return the binary exponent of non-zero x * ilogb(0) = 0x80000001 * ilogb(inf/NaN) = 0x7fffffff (no signal is raised) */ #include "math.h" #include "math_private.h" int ilogb(double x) { int32_t hx,lx,ix; EXTRACT_WORDS(hx,lx,x); hx &= 0x7fffffff; if(hx<0x00100000) { if((hx|lx)==0) return 0x80000001; /* ilogb(0) = 0x80000001 */ else /* subnormal x */ if(hx==0) { for (ix = -1043; lx>0; lx<<=1) ix -=1; } else { for (ix = -1022,hx<<=11; hx>0; hx<<=1) ix -=1; } return ix; } else if (hx<0x7ff00000) return (hx>>20)-1023; else return 0x7fffffff; } --- NEW FILE: s_ilogbf.c --- /* s_ilogbf.c -- float version of s_ilogb.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_ilogbf.c,v 1.6 2002/05/28 17:51:46 alfred Exp $"; #endif #include "math.h" #include "math_private.h" int ilogbf(float x) { int32_t hx,ix; GET_FLOAT_WORD(hx,x); hx &= 0x7fffffff; if(hx<0x00800000) { if(hx==0) return 0x80000001; /* ilogb(0) = 0x80000001 */ else /* subnormal x */ for (ix = -126,hx<<=8; hx>0; hx<<=1) ix -=1; return ix; } else if (hx<0x7f800000) return (hx>>23)-127; else return 0x7fffffff; } --- NEW FILE: s_isnan.c --- /* @(#)s_isnan.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* For binary compat; to be removed in FreeBSD 6.0. */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_isnan.c,v 1.7 2003/02/12 20:03:41 mike Exp $"; #endif /* * isnan(x) returns 1 is x is nan, else 0; * no branching! */ #include "math.h" #include "math_private.h" #undef isnan int isnan(double x) { int32_t hx,lx; EXTRACT_WORDS(hx,lx,x); hx &= 0x7fffffff; hx |= (u_int32_t)(lx|(-lx))>>31; hx = 0x7ff00000 - hx; return (int)((u_int32_t)(hx))>>31; } --- NEW FILE: s_isnanf.c --- /* s_isnanf.c -- float version of s_isnan.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* For binary compat; to be removed in FreeBSD 6.0. */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_isnanf.c,v 1.7 2003/02/12 20:03:41 mike Exp $"; #endif /* * isnanf(x) returns 1 is x is nan, else 0; * no branching! */ #include "math.h" #include "math_private.h" #undef isnanf int isnanf(float x) { int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; ix = 0x7f800000 - ix; return (int)(((u_int32_t)(ix))>>31); } --- NEW FILE: s_ldexp.c --- /* @(#)s_ldexp.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_ldexp.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" #include <errno.h> 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; } --- NEW FILE: s_ldexpf.c --- /* s_ldexpf.c -- float version of s_ldexp.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_ldexpf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" #include <errno.h> float ldexpf(float value, int exp) { if(!finitef(value)||value==(float)0.0) return value; value = scalbnf(value,exp); if(!finitef(value)||value==(float)0.0) errno = ERANGE; return value; } --- NEW FILE: s_ldexpf.o --- ELFÿ $ C C.D D $ C C.D D --- NEW FILE: s_lib_version.c --- /* @(#)s_lib_ver.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_lib_version.c,v 1.5 1999/08/28 00:06:52 peter Exp $"; #endif /* * MACRO for standards */ #include "math.h" #include "math_private.h" /* * define and initialize _LIB_VERSION */ #ifdef _POSIX_MODE _LIB_VERSION_TYPE _LIB_VERSION = _POSIX_; #else #ifdef _XOPEN_MODE _LIB_VERSION_TYPE _LIB_VERSION = _XOPEN_; #else #ifdef _SVID3_MODE _LIB_VERSION_TYPE _LIB_VERSION = _SVID_; #else /* default _IEEE_MODE */ _LIB_VERSION_TYPE _LIB_VERSION = _IEEE_; #endif #endif #endif --- NEW FILE: s_log1p.c --- /* @(#)s_log1p.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_log1p.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* double log1p(double x) * * Method : * 1. Argument Reduction: find k and f such that * 1+x = 2^k * (1+f), * where sqrt(2)/2 < 1+f < sqrt(2) . * * Note. If k=0, then f=x is exact. However, if k!=0, then f * may not be representable exactly. In that case, a correction * term is need. Let u=1+x rounded. Let c = (1+x)-u, then * log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u), * and add back the correction term c/u. * (Note: when x > 2**53, one can simply return log(x)) * * 2. Approximation of log1p(f). * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) * = 2s + 2/3 s**3 + 2/5 s**5 + ....., * = 2s + s*R * We use a special Reme algorithm on [0,0.1716] to generate * a polynomial of degree 14 to approximate R The maximum error * of this polynomial approximation is bounded by 2**-58.45. In * other words, * 2 4 6 8 10 12 14 * R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s * (the values of Lp1 to Lp7 are listed in the program) * and * | 2 14 | -58.45 * | Lp1*s +...+Lp7*s - R(z) | <= 2 * | | * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. * In order to guarantee error in log below 1ulp, we compute log * by * log1p(f) = f - (hfsq - s*(hfsq+R)). * * 3. Finally, log1p(x) = k*ln2 + log1p(f). * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) * Here ln2 is split into two floating point number: * ln2_hi + ln2_lo, * where n*ln2_hi is always exact for |n| < 2000. * * Special cases: * log1p(x) is NaN with signal if x < -1 (including -INF) ; * log1p(+INF) is +INF; log1p(-1) is -INF with signal; * log1p(NaN) is that NaN with no signal. * * Accuracy: * according to an error analysis, the error is always less than * 1 ulp (unit in the last place). * * Constants: * The hexadecimal values are the intended ones for the following * constants. The decimal values may be used, provided that the * compiler will convert from decimal to binary accurately enough * to produce the hexadecimal values shown. * * Note: Assuming log() return accurate answer, the following * algorithm can be used to compute log1p(x) to within a few ULP: * * u = 1+x; * if(u==1.0) return x ; else * return log(u)*(x/(u-1.0)); * * See HP-15C Advanced Functions Handbook, p.193. */ #include "math.h" #include "math_private.h" static const double ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ static const double zero = 0.0; double log1p(double x) { double hfsq,f,c,s,z,R,u; int32_t k,hx,hu,ax; GET_HIGH_WORD(hx,x); ax = hx&0x7fffffff; k = 1; if (hx < 0x3FDA827A) { /* x < 0.41422 */ if(ax>=0x3ff00000) { /* x <= -1.0 */ if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */ else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ } if(ax<0x3e200000) { /* |x| < 2**-29 */ if(two54+x>zero /* raise inexact */ &&ax<0x3c900000) /* |x| < 2**-54 */ return x; else return x - x*x*0.5; } if(hx>0||hx<=((int32_t)0xbfd2bec3)) { k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */ } if (hx >= 0x7ff00000) return x+x; if(k!=0) { if(hx<0x43400000) { u = 1.0+x; GET_HIGH_WORD(hu,u); k = (hu>>20)-1023; c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */ c /= u; } else { u = x; GET_HIGH_WORD(hu,u); k = (hu>>20)-1023; c = 0; } hu &= 0x000fffff; if(hu<0x6a09e) { SET_HIGH_WORD(u,hu|0x3ff00000); /* normalize u */ } else { k += 1; SET_HIGH_WORD(u,hu|0x3fe00000); /* normalize u/2 */ hu = (0x00100000-hu)>>2; } f = u-1.0; } hfsq=0.5*f*f; if(hu==0) { /* |f| < 2**-20 */ if(f==zero) if(k==0) return zero; else {c += k*ln2_lo; return k*ln2_hi+c;} R = hfsq*(1.0-0.66666666666666666*f); if(k==0) return f-R; else return k*ln2_hi-((R-(k*ln2_lo+c))-f); } s = f/(2.0+f); z = s*s; R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); if(k==0) return f-(hfsq-s*(hfsq+R)); else return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); } --- NEW FILE: s_log1pf.c --- /* s_log1pf.c -- float version of s_log1p.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_log1pf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ two25 = 3.355443200e+07, /* 0x4c000000 */ Lp1 = 6.6666668653e-01, /* 3F2AAAAB */ Lp2 = 4.0000000596e-01, /* 3ECCCCCD */ Lp3 = 2.8571429849e-01, /* 3E924925 */ Lp4 = 2.2222198546e-01, /* 3E638E29 */ Lp5 = 1.8183572590e-01, /* 3E3A3325 */ Lp6 = 1.5313838422e-01, /* 3E1CD04F */ Lp7 = 1.4798198640e-01; /* 3E178897 */ static const float zero = 0.0; float log1pf(float x) { float hfsq,f,c,s,z,R,u; int32_t k,hx,hu,ax; GET_FLOAT_WORD(hx,x); ax = hx&0x7fffffff; k = 1; if (hx < 0x3ed413d7) { /* x < 0.41422 */ if(ax>=0x3f800000) { /* x <= -1.0 */ if(x==(float)-1.0) return -two25/zero; /* log1p(-1)=+inf */ else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ } if(ax<0x31000000) { /* |x| < 2**-29 */ if(two25+x>zero /* raise inexact */ &&ax<0x24800000) /* |x| < 2**-54 */ return x; else return x - x*x*(float)0.5; } if(hx>0||hx<=((int32_t)0xbe95f61f)) { k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */ } if (hx >= 0x7f800000) return x+x; if(k!=0) { if(hx<0x5a000000) { u = (float)1.0+x; GET_FLOAT_WORD(hu,u); k = (hu>>23)-127; /* correction term */ c = (k>0)? (float)1.0-(u-x):x-(u-(float)1.0); c /= u; } else { u = x; GET_FLOAT_WORD(hu,u); k = (hu>>23)-127; c = 0; } hu &= 0x007fffff; if(hu<0x3504f7) { SET_FLOAT_WORD(u,hu|0x3f800000);/* normalize u */ } else { k += 1; SET_FLOAT_WORD(u,hu|0x3f000000); /* normalize u/2 */ hu = (0x00800000-hu)>>2; } f = u-(float)1.0; } hfsq=(float)0.5*f*f; if(hu==0) { /* |f| < 2**-20 */ if(f==zero) if(k==0) return zero; else {c += k*ln2_lo; return k*ln2_hi+c;} R = hfsq*((float)1.0-(float)0.66666666666666666*f); if(k==0) return f-R; else return k*ln2_hi-((R-(k*ln2_lo+c))-f); } s = f/((float)2.0+f); z = s*s; R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); if(k==0) return f-(hfsq-s*(hfsq+R)); else return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); } --- NEW FILE: s_logb.c --- /* @(#)s_logb.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_logb.c,v 1.9 2003/07/23 04:53:46 peter Exp $"; #endif /* * double logb(x) * IEEE 754 logb. Included to pass IEEE test suite. Not recommend. * Use ilogb instead. */ #include "math.h" #include "math_private.h" double logb(double x) { int32_t lx,ix; EXTRACT_WORDS(ix,lx,x); ix &= 0x7fffffff; /* high |x| */ if((ix|lx)==0) return -1.0/fabs(x); if(ix>=0x7ff00000) return x*x; if((ix>>=20)==0) /* IEEE 754 logb */ return -1022.0; else return (double) (ix-1023); } --- NEW FILE: s_logbf.c --- /* s_logbf.c -- float version of s_logb.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_logbf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float logbf(float x) { int32_t ix; GET_FLOAT_WORD(ix,x); ix &= 0x7fffffff; /* high |x| */ if(ix==0) return (float)-1.0/fabsf(x); if(ix>=0x7f800000) return x*x; if((ix>>=23)==0) /* IEEE 754 logb */ return -126.0; else return (float) (ix-127); } --- NEW FILE: s_matherr.c --- /* @(#)s_matherr.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_matherr.c,v 1.6 2002/05/28 17:51:46 alfred Exp $"; #endif #include "math.h" #include "math_private.h" int matherr(struct exception *x) { int n=0; if(x->arg1!=x->arg1) return 0; return n; } --- NEW FILE: s_modf.c --- /* @(#)s_modf.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_modf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * modf(double x, double *iptr) * return fraction part of x, and return x's integral part in *iptr. * Method: * Bit twiddling. * * Exception: * No exception. */ #include "math.h" #include "math_private.h" static const double one = 1.0; double modf(double x, double *iptr) { int32_t i0,i1,j0; u_int32_t i; EXTRACT_WORDS(i0,i1,x); j0 = ((i0>>20)&0x7ff)-0x3ff; /* exponent of x */ if(j0<20) { /* integer part in high x */ if(j0<0) { /* |x|<1 */ INSERT_WORDS(*iptr,i0&0x80000000,0); /* *iptr = +-0 */ return x; } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) { /* x is integral */ u_int32_t high; *iptr = x; GET_HIGH_WORD(high,x); INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ return x; } else { INSERT_WORDS(*iptr,i0&(~i),0); return x - *iptr; } } } else if (j0>51) { /* no fraction part */ u_int32_t high; *iptr = x*one; GET_HIGH_WORD(high,x); INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ return x; } else { /* fraction part in low x */ i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) { /* x is integral */ u_int32_t high; *iptr = x; GET_HIGH_WORD(high,x); INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ return x; } else { INSERT_WORDS(*iptr,i0,i1&(~i)); return x - *iptr; } } } --- NEW FILE: s_modff.c --- /* s_modff.c -- float version of s_modf.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_modff.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one = 1.0; float modff(float x, float *iptr) { int32_t i0,j0; u_int32_t i; GET_FLOAT_WORD(i0,x); j0 = ((i0>>23)&0xff)-0x7f; /* exponent of x */ if(j0<23) { /* integer part in x */ if(j0<0) { /* |x|<1 */ SET_FLOAT_WORD(*iptr,i0&0x80000000); /* *iptr = +-0 */ return x; } else { i = (0x007fffff)>>j0; if((i0&i)==0) { /* x is integral */ u_int32_t ix; *iptr = x; GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */ return x; } else { SET_FLOAT_WORD(*iptr,i0&(~i)); return x - *iptr; } } } else { /* no fraction part */ u_int32_t ix; *iptr = x*one; GET_FLOAT_WORD(ix,x); SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */ return x; } } --- NEW FILE: s_nextafter.c --- /* @(#)s_nextafter.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_nextafter.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* IEEE functions * nextafter(x,y) * return the next machine floating-point number of x in the * direction toward y. * Special cases: */ #include "math.h" #include "math_private.h" double nextafter(double x, double y) { int32_t hx,hy,ix,iy; u_int32_t lx,ly; EXTRACT_WORDS(hx,lx,x); EXTRACT_WORDS(hy,ly,y); ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffff; /* |y| */ if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */ return x+y; if(x==y) return x; /* x=y, return x */ if((ix|lx)==0) { /* x == 0 */ INSERT_WORDS(x,hy&0x80000000,1); /* return +-minsubnormal */ y = x*x; if(y==x) return y; else return x; /* raise underflow flag */ } if(hx>=0) { /* x > 0 */ if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x < y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } else { /* x < 0 */ if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */ if(lx==0) hx -= 1; lx -= 1; } else { /* x > y, x += ulp */ lx += 1; if(lx==0) hx += 1; } } hy = hx&0x7ff00000; if(hy>=0x7ff00000) return x+x; /* overflow */ if(hy<0x00100000) { /* underflow */ y = x*x; if(y!=x) { /* raise underflow flag */ INSERT_WORDS(y,hx,lx); return y; } } INSERT_WORDS(x,hx,lx); return x; } --- NEW FILE: s_nextafterf.c --- /* s_nextafterf.c -- float version of s_nextafter.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_nextafterf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float nextafterf(float x, float y) { int32_t hx,hy,ix,iy; GET_FLOAT_WORD(hx,x); GET_FLOAT_WORD(hy,y); ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffff; /* |y| */ if((ix>0x7f800000) || /* x is nan */ (iy>0x7f800000)) /* y is nan */ return x+y; if(x==y) return x; /* x=y, return x */ if(ix==0) { /* x == 0 */ SET_FLOAT_WORD(x,(hy&0x80000000)|1);/* return +-minsubnormal */ y = x*x; if(y==x) return y; else return x; /* raise underflow flag */ } if(hx>=0) { /* x > 0 */ if(hx>hy) { /* x > y, x -= ulp */ hx -= 1; } else { /* x < y, x += ulp */ hx += 1; } } else { /* x < 0 */ if(hy>=0||hx>hy){ /* x < y, x -= ulp */ hx -= 1; } else { /* x > y, x += ulp */ hx += 1; } } hy = hx&0x7f800000; if(hy>=0x7f800000) return x+x; /* overflow */ if(hy<0x00800000) { /* underflow */ y = x*x; if(y!=x) { /* raise underflow flag */ SET_FLOAT_WORD(y,hx); return y; } } SET_FLOAT_WORD(x,hx); return x; } --- NEW FILE: s_rint.c --- /* @(#)s_rint.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_rint.c,v 1.10 2003/07/23 04:53:46 peter Exp $"; #endif /* * rint(x) * Return x rounded to integral value according to the prevailing * rounding mode. * Method: * Using floating addition. * Exception: * Inexact flag raised if x not equal to rint(x). */ #include "math.h" #include "math_private.h" /* * TWO23 is long double instead of double to avoid a bug in gcc. Without * this, gcc thinks that TWO23[sx]+x and w-TWO23[sx] already have double * precision and doesn't clip them to double precision when they are * assigned and returned. Use long double even in the !__STDC__ case in * case this is compiled with gcc -traditional. */ static const long double TWO52[2]={ 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */ }; double rint(double x) { int32_t i0,j0,sx; u_int32_t i,i1; double w,t; EXTRACT_WORDS(i0,i1,x); sx = (i0>>31)&1; j0 = ((i0>>20)&0x7ff)-0x3ff; if(j0<20) { if(j0<0) { if(((i0&0x7fffffff)|i1)==0) return x; i1 |= (i0&0x0fffff); i0 &= 0xfffe0000; i0 |= ((i1|-i1)>>12)&0x80000; SET_HIGH_WORD(x,i0); w = TWO52[sx]+x; t = w-TWO52[sx]; GET_HIGH_WORD(i0,t); SET_HIGH_WORD(t,(i0&0x7fffffff)|(sx<<31)); return t; } else { i = (0x000fffff)>>j0; if(((i0&i)|i1)==0) return x; /* x is integral */ i>>=1; if(((i0&i)|i1)!=0) { if(j0==19) i1 = 0x40000000; else i0 = (i0&(~i))|((0x20000)>>j0); } } } else if (j0>51) { if(j0==0x400) return x+x; /* inf or NaN */ else return x; /* x is integral */ } else { i = ((u_int32_t)(0xffffffff))>>(j0-20); if((i1&i)==0) return x; /* x is integral */ i>>=1; if((i1&i)!=0) i1 = (i1&(~i))|((0x40000000)>>(j0-20)); } INSERT_WORDS(x,i0,i1); w = TWO52[sx]+x; return w-TWO52[sx]; } --- NEW FILE: s_rintf.c --- /* s_rintf.c -- float version of s_rint.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_rintf.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" /* * TWO23 is double instead of float to avoid a bug in gcc. Without * this, gcc thinks that TWO23[sx]+x and w-TWO23[sx] already have float * precision and doesn't clip them to float precision when they are * assigned and returned. */ static const double TWO23[2]={ 8.3886080000e+06, /* 0x4b000000 */ -8.3886080000e+06, /* 0xcb000000 */ }; float rintf(float x) { int32_t i0,j0,sx; u_int32_t i,i1; float w,t; GET_FLOAT_WORD(i0,x); sx = (i0>>31)&1; j0 = ((i0>>23)&0xff)-0x7f; if(j0<23) { if(j0<0) { if((i0&0x7fffffff)==0) return x; i1 = (i0&0x07fffff); i0 &= 0xfff00000; i0 |= ((i1|-i1)>>9)&0x400000; SET_FLOAT_WORD(x,i0); w = TWO23[sx]+x; t = w-TWO23[sx]; GET_FLOAT_WORD(i0,t); SET_FLOAT_WORD(t,(i0&0x7fffffff)|(sx<<31)); return t; } else { i = (0x007fffff)>>j0; if((i0&i)==0) return x; /* x is integral */ i>>=1; if((i0&i)!=0) i0 = (i0&(~i))|((0x100000)>>j0); } } else { if(j0==0x80) return x+x; /* inf or NaN */ else return x; /* x is integral */ } SET_FLOAT_WORD(x,i0); w = TWO23[sx]+x; return w-TWO23[sx]; } --- NEW FILE: s_scalbn.c --- /* @(#)s_scalbn.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_scalbn.c,v 1.9 2003/07/23 04:53:47 peter Exp $"; #endif /* * scalbn (double x, int n) * scalbn(x,n) returns x* 2**n computed by exponent * manipulation rather than by actually performing an * exponentiation or a multiplication. */ #include "math.h" #include "math_private.h" static const double two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */ huge = 1.0e+300, tiny = 1.0e-300; double scalbn (double x, int n) { int32_t k,hx,lx; EXTRACT_WORDS(hx,lx,x); k = (hx&0x7ff00000)>>20; /* extract exponent */ if (k==0) { /* 0 or subnormal x */ if ((lx|(hx&0x7fffffff))==0) return x; /* +-0 */ x *= two54; GET_HIGH_WORD(hx,x); k = ((hx&0x7ff00000)>>20) - 54; if (n< -50000) return tiny*x; /*underflow*/ } if (k==0x7ff) return x+x; /* NaN or Inf */ k = k+n; if (k > 0x7fe) return huge*copysign(huge,x); /* overflow */ if (k > 0) /* normal result */ {SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); return x;} if (k <= -54) if (n > 50000) /* in case integer overflow in n+k */ return huge*copysign(huge,x); /*overflow*/ else return tiny*copysign(tiny,x); /*underflow*/ k += 54; /* subnormal result */ SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); return x*twom54; } --- NEW FILE: s_scalbnf.c --- /* s_scalbnf.c -- float version of s_scalbn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_scalbnf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float two25 = 3.355443200e+07, /* 0x4c000000 */ twom25 = 2.9802322388e-08, /* 0x33000000 */ huge = 1.0e+30, tiny = 1.0e-30; float scalbnf (float x, int n) { int32_t k,ix; GET_FLOAT_WORD(ix,x); k = (ix&0x7f800000)>>23; /* extract exponent */ if (k==0) { /* 0 or subnormal x */ if ((ix&0x7fffffff)==0) return x; /* +-0 */ x *= two25; GET_FLOAT_WORD(ix,x); k = ((ix&0x7f800000)>>23) - 25; if (n< -50000) return tiny*x; /*underflow*/ } if (k==0xff) return x+x; /* NaN or Inf */ k = k+n; if (k > 0xfe) return huge*copysignf(huge,x); /* overflow */ if (k > 0) /* normal result */ {SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); return x;} if (k <= -25) if (n > 50000) /* in case integer overflow in n+k */ return huge*copysignf(huge,x); /*overflow*/ else return tiny*copysignf(tiny,x); /*underflow*/ k += 25; /* subnormal result */ SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); return x*twom25; } --- NEW FILE: s_signgam.c --- #include "math.h" #include "math_private.h" int signgam = 0; --- NEW FILE: s_significand.c --- /* @(#)s_signif.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_significand.c,v 1.9 2003/07/23 04:53:47 peter Exp $"; #endif /* * significand(x) computes just * scalb(x, (double) -ilogb(x)), * for exercising the fraction-part(F) IEEE 754-1985 test vector. */ #include "math.h" #include "math_private.h" double significand(double x) { return __ieee754_scalb(x,(double) -ilogb(x)); } --- NEW FILE: s_significandf.c --- /* s_significandf.c -- float version of s_significand.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_significandf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float significandf(float x) { return __ieee754_scalbf(x,(float) -ilogbf(x)); } --- NEW FILE: s_sin.c --- /* @(#)s_sin.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_sin.c,v 1.9 2003/07/23 04:53:47 peter Exp $"; #endif /* sin(x) * Return sine function of x. * * kernel function: * __kernel_sin ... sine function on [-pi/4,pi/4] * __kernel_cos ... cose function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 * in [-pi/4 , +pi/4], and let n = k mod 4. * We have * * n sin(x) cos(x) tan(x) * ---------------------------------------------------------- * 0 S C T * 1 C -S -1/T * 2 -S -C T * 3 -C S -1/T * ---------------------------------------------------------- * * Special cases: * Let trig be any of sin, cos, or tan. * trig(+-INF) is NaN, with signals; * trig(NaN) is that NaN; * * Accuracy: * TRIG(x) returns trig(x) nearly rounded */ #include "math.h" #include "math_private.h" double sin(double x) { double y[2],z=0.0; int32_t n, ix; /* High word of x. */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) return __kernel_sin(x,z,0); /* sin(Inf or NaN) is NaN */ else if (ix>=0x7ff00000) return x-x; /* argument reduction needed */ else { n = __ieee754_rem_pio2(x,y); switch(n&3) { case 0: return __kernel_sin(y[0],y[1],1); case 1: return __kernel_cos(y[0],y[1]); case 2: return -__kernel_sin(y[0],y[1],1); default: return -__kernel_cos(y[0],y[1]); } } } --- NEW FILE: s_sinf.c --- /* s_sinf.c -- float version of s_sin.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_sinf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float sinf(float x) { float y[2],z=0.0; int32_t n, ix; GET_FLOAT_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3f490fd8) return __kernel_sinf(x,z,0); /* sin(Inf or NaN) is NaN */ else if (ix>=0x7f800000) return x-x; /* argument reduction needed */ else { n = __ieee754_rem_pio2f(x,y); switch(n&3) { case 0: return __kernel_sinf(y[0],y[1],1); case 1: return __kernel_cosf(y[0],y[1]); case 2: return -__kernel_sinf(y[0],y[1],1); default: return -__kernel_cosf(y[0],y[1]); } } } --- NEW FILE: s_tan.c --- /* @(#)s_tan.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_tan.c,v 1.9 2003/07/23 04:53:47 peter Exp $"; #endif /* tan(x) * Return tangent function of x. * * kernel function: * __kernel_tan ... tangent function on [-pi/4,pi/4] * __ieee754_rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 * in [-pi/4 , +pi/4], and let n = k mod 4. * We have * * n sin(x) cos(x) tan(x) * ---------------------------------------------------------- * 0 S C T * 1 C -S -1/T * 2 -S -C T * 3 -C S -1/T * ---------------------------------------------------------- * * Special cases: * Let trig be any of sin, cos, or tan. * trig(+-INF) is NaN, with signals; * trig(NaN) is that NaN; * * Accuracy: * TRIG(x) returns trig(x) nearly rounded */ #include "math.h" #include "math_private.h" double tan(double x) { double y[2],z=0.0; int32_t n, ix; /* High word of x. */ GET_HIGH_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3fe921fb) return __kernel_tan(x,z,1); /* tan(Inf or NaN) is NaN */ else if (ix>=0x7ff00000) return x-x; /* NaN */ /* argument reduction needed */ else { n = __ieee754_rem_pio2(x,y); return __kernel_tan(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even -1 -- n odd */ } } --- NEW FILE: s_tanf.c --- /* s_tanf.c -- float version of s_tan.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_tanf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float tanf(float x) { float y[2],z=0.0; int32_t n, ix; GET_FLOAT_WORD(ix,x); /* |x| ~< pi/4 */ ix &= 0x7fffffff; if(ix <= 0x3f490fda) return __kernel_tanf(x,z,1); /* tan(Inf or NaN) is NaN */ else if (ix>=0x7f800000) return x-x; /* NaN */ /* argument reduction needed */ else { n = __ieee754_rem_pio2f(x,y); return __kernel_tanf(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even -1 -- n odd */ } } --- NEW FILE: s_tanh.c --- /* @(#)s_tanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_tanh.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* Tanh(x) * Return the Hyperbolic Tangent of x * * Method : * x -x * e - e * 0. tanh(x) is defined to be ----------- * x -x * e + e * 1. reduce x to non-negative by tanh(-x) = -tanh(x). * 2. 0 <= x <= 2**-55 : tanh(x) := x*(one+x) * -t * 2**-55 < x <= 1 : tanh(x) := -----; t = expm1(-2x) * t + 2 * 2 * 1 <= x <= 22.0 : tanh(x) := 1- ----- ; t=expm1(2x) * t + 2 * 22.0 < x <= INF : tanh(x) := 1. * * Special cases: * tanh(NaN) is NaN; * only tanh(0)=0 is exact for finite argument. */ #include "math.h" #include "math_private.h" static const double one=1.0, two=2.0, tiny = 1.0e-300; double tanh(double x) { double t,z; int32_t jx,ix; /* High word of |x|. */ GET_HIGH_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7ff00000) { if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ else return one/x-one; /* tanh(NaN) = NaN */ } /* |x| < 22 */ if (ix < 0x40360000) { /* |x|<22 */ if (ix<0x3c800000) /* |x|<2**-55 */ return x*(one+x); /* tanh(small) = small */ if (ix>=0x3ff00000) { /* |x|>=1 */ t = expm1(two*fabs(x)); z = one - two/(t+two); } else { t = expm1(-two*fabs(x)); z= -t/(t+two); } /* |x| > 22, return +-1 */ } else { z = one - tiny; /* raised inexact flag */ } return (jx>=0)? z: -z; } --- NEW FILE: s_tanhf.c --- /* s_tanhf.c -- float version of s_tanh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/s_tanhf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" static const float one=1.0, two=2.0, tiny = 1.0e-30; float tanhf(float x) { float t,z; int32_t jx,ix; GET_FLOAT_WORD(jx,x); ix = jx&0x7fffffff; /* x is INF or NaN */ if(ix>=0x7f800000) { if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ else return one/x-one; /* tanh(NaN) = NaN */ } /* |x| < 22 */ if (ix < 0x41b00000) { /* |x|<22 */ if (ix<0x24000000) /* |x|<2**-55 */ return x*(one+x); /* tanh(small) = small */ if (ix>=0x3f800000) { /* |x|>=1 */ t = expm1f(two*fabsf(x)); z = one - two/(t+two); } else { t = expm1f(-two*fabsf(x)); z= -t/(t+two); } /* |x| > 22, return +-1 */ } else { z = one - tiny; /* raised inexact flag */ } return (jx>=0)? z: -z; } --- NEW FILE: w_acos.c --- /* @(#)w_acos.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_acos.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrap_acos(x) */ #include "math.h" #include "math_private.h" double acos(double x) /* wrapper acos */ { #ifdef _IEEE_LIBM return __ieee754_acos(x); #else double z; z = __ieee754_acos(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(fabs(x)>1.0) { return __kernel_standard(x,x,1); /* acos(|x|>1) */ } else return z; #endif } --- NEW FILE: w_acosf.c --- /* w_acosf.c -- float version of w_acos.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_acosf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrap_acosf(x) */ #include "math.h" #include "math_private.h" float acosf(float x) /* wrapper acosf */ { #ifdef _IEEE_LIBM return __ieee754_acosf(x); #else float z; z = __ieee754_acosf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(fabsf(x)>(float)1.0) { /* acosf(|x|>1) */ return (float)__kernel_standard((double)x,(double)x,101); } else return z; #endif } --- NEW FILE: w_acosh.c --- /* @(#)w_acosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_acosh.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper acosh(x) */ #include "math.h" #include "math_private.h" double acosh(double x) /* wrapper acosh */ { #ifdef _IEEE_LIBM return __ieee754_acosh(x); #else double z; z = __ieee754_acosh(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(x<1.0) { return __kernel_standard(x,x,29); /* acosh(x<1) */ } else return z; #endif } --- NEW FILE: w_acoshf.c --- /* w_acoshf.c -- float version of w_acosh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_acoshf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper acoshf(x) */ #include "math.h" #include "math_private.h" float acoshf(float x) /* wrapper acoshf */ { #ifdef _IEEE_LIBM return __ieee754_acoshf(x); #else float z; z = __ieee754_acoshf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(x<(float)1.0) { /* acosh(x<1) */ return (float)__kernel_standard((double)x,(double)x,129); } else return z; #endif } --- NEW FILE: w_asin.c --- /* @(#)w_asin.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_asin.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper asin(x) */ #include "math.h" #include "math_private.h" double asin(double x) /* wrapper asin */ { #ifdef _IEEE_LIBM return __ieee754_asin(x); #else double z; z = __ieee754_asin(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(fabs(x)>1.0) { return __kernel_standard(x,x,2); /* asin(|x|>1) */ } else return z; #endif } --- NEW FILE: w_asinf.c --- /* w_asinf.c -- float version of w_asin.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_asinf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper asinf(x) */ #include "math.h" #include "math_private.h" float asinf(float x) /* wrapper asinf */ { #ifdef _IEEE_LIBM return __ieee754_asinf(x); #else float z; z = __ieee754_asinf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(fabsf(x)>(float)1.0) { /* asinf(|x|>1) */ return (float)__kernel_standard((double)x,(double)x,102); } else return z; #endif } --- NEW FILE: w_atan2.c --- /* @(#)w_atan2.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_atan2.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper atan2(y,x) */ #include "math.h" #include "math_private.h" double atan2(double y, double x) /* wrapper atan2 */ { #ifdef _IEEE_LIBM return __ieee754_atan2(y,x); #else double z; z = __ieee754_atan2(y,x); if(_LIB_VERSION == _IEEE_||isnan(x)||isnan(y)) return z; if(x==0.0&&y==0.0) { return __kernel_standard(y,x,3); /* atan2(+-0,+-0) */ } else return z; #endif } --- NEW FILE: w_atan2f.c --- /* w_atan2f.c -- float version of w_atan2.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_atan2f.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper atan2f(y,x) */ #include "math.h" #include "math_private.h" float atan2f(float y, float x) /* wrapper atan2f */ { #ifdef _IEEE_LIBM return __ieee754_atan2f(y,x); #else float z; z = __ieee754_atan2f(y,x); if(_LIB_VERSION == _IEEE_||isnanf(x)||isnanf(y)) return z; if(x==(float)0.0&&y==(float)0.0) { /* atan2f(+-0,+-0) */ return (float)__kernel_standard((double)y,(double)x,103); } else return z; #endif } --- NEW FILE: w_atanh.c --- /* @(#)w_atanh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_atanh.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper atanh(x) */ #include "math.h" #include "math_private.h" double atanh(double x) /* wrapper atanh */ { #ifdef _IEEE_LIBM return __ieee754_atanh(x); #else double z,y; z = __ieee754_atanh(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; y = fabs(x); if(y>=1.0) { if(y>1.0) return __kernel_standard(x,x,30); /* atanh(|x|>1) */ else return __kernel_standard(x,x,31); /* atanh(|x|==1) */ } else return z; #endif } --- NEW FILE: w_atanhf.c --- /* w_atanhf.c -- float version of w_atanh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_atanhf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper atanhf(x) */ #include "math.h" #include "math_private.h" float atanhf(float x) /* wrapper atanhf */ { #ifdef _IEEE_LIBM return __ieee754_atanhf(x); #else float z,y; z = __ieee754_atanhf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; y = fabsf(x); if(y>=(float)1.0) { if(y>(float)1.0) /* atanhf(|x|>1) */ return (float)__kernel_standard((double)x,(double)x,130); else /* atanhf(|x|==1) */ return (float)__kernel_standard((double)x,(double)x,131); } else return z; #endif } --- NEW FILE: w_atanhf.o --- ELFÿ --- NEW FILE: w_cabs.c --- /* * cabs() wrapper for hypot(). * * Written by J.T. Conklin, <[email protected]> * Placed into the Public Domain, 1994. */ #ifndef lint static const char rcsid[] = "$FreeBSD: src/lib/msun/src/w_cabs.c,v 1.4 2001/06/13 15:16:30 ru Exp $"; #endif /* not lint */ #include <complex.h> #include <math.h> double cabs(z) double complex z; { return hypot(creal(z), cimag(z)); } double z_abs(z) double complex *z; { return hypot(creal(*z), cimag(*z)); } --- NEW FILE: w_cabsf.c --- /* * cabsf() wrapper for hypotf(). * * Written by J.T. Conklin, <[email protected]> * Placed into the Public Domain, 1994. */ #ifndef lint static const char rcsid[] = "$FreeBSD: src/lib/msun/src/w_cabsf.c,v 1.3 2001/06/13 15:16:30 ru Exp $"; #endif /* not lint */ #include <complex.h> #include <math.h> #include "math_private.h" float cabsf(z) float complex z; { return hypotf(crealf(z), cimagf(z)); } --- NEW FILE: w_cosh.c --- /* @(#)w_cosh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_cosh.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper cosh(x) */ #include "math.h" #include "math_private.h" double cosh(double x) /* wrapper cosh */ { #ifdef _IEEE_LIBM return __ieee754_cosh(x); #else double z; z = __ieee754_cosh(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(fabs(x)>7.10475860073943863426e+02) { return __kernel_standard(x,x,5); /* cosh overflow */ } else return z; #endif } --- NEW FILE: w_coshf.c --- /* w_coshf.c -- float version of w_cosh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_coshf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper coshf(x) */ #include "math.h" #include "math_private.h" float coshf(float x) /* wrapper coshf */ { #ifdef _IEEE_LIBM return __ieee754_coshf(x); #else float z; z = __ieee754_coshf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(fabsf(x)>(float)8.9415985107e+01) { /* cosh overflow */ return (float)__kernel_standard((double)x,(double)x,105); } else return z; #endif } --- NEW FILE: w_drem.c --- /* * drem() wrapper for remainder(). * * Written by J.T. Conklin, <[email protected]> * Placed into the Public Domain, 1994. */ #include <math.h> double drem(x, y) double x, y; { return remainder(x, y); } --- NEW FILE: w_dremf.c --- /* * dremf() wrapper for remainderf(). * * Written by J.T. Conklin, <[email protected]> * Placed into the Public Domain, 1994. */ #include "math.h" #include "math_private.h" float dremf(x, y) float x, y; { return remainderf(x, y); } --- NEW FILE: w_exp.c --- /* @(#)w_exp.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_exp.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper exp(x) */ #include "math.h" #include "math_private.h" static const double o_threshold= 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */ u_threshold= -7.45133219101941108420e+02; /* 0xc0874910, 0xD52D3051 */ double exp(double x) /* wrapper exp */ { #ifdef _IEEE_LIBM return __ieee754_exp(x); #else double z; z = __ieee754_exp(x); if(_LIB_VERSION == _IEEE_) return z; if(finite(x)) { if(x>o_threshold) return __kernel_standard(x,x,6); /* exp overflow */ else if(x<u_threshold) return __kernel_standard(x,x,7); /* exp underflow */ } return z; #endif } --- NEW FILE: w_expf.c --- /* w_expf.c -- float version of w_exp.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_expf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper expf(x) */ #include "math.h" #include "math_private.h" static const float o_threshold= 8.8721679688e+01, /* 0x42b17180 */ u_threshold= -1.0397208405e+02; /* 0xc2cff1b5 */ float expf(float x) /* wrapper expf */ { #ifdef _IEEE_LIBM return __ieee754_expf(x); #else float z; z = __ieee754_expf(x); if(_LIB_VERSION == _IEEE_) return z; if(finitef(x)) { if(x>o_threshold) /* exp overflow */ return (float)__kernel_standard((double)x,(double)x,106); else if(x<u_threshold) /* exp underflow */ return (float)__kernel_standard((double)x,(double)x,107); } return z; #endif } --- NEW FILE: w_fmod.c --- /* @(#)w_fmod.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_fmod.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper fmod(x,y) */ #include "math.h" #include "math_private.h" double fmod(double x, double y) /* wrapper fmod */ { #ifdef _IEEE_LIBM return __ieee754_fmod(x,y); #else double z; z = __ieee754_fmod(x,y); if(_LIB_VERSION == _IEEE_ ||isnan(y)||isnan(x)) return z; if(y==0.0) { return __kernel_standard(x,y,27); /* fmod(x,0) */ } else return z; #endif } --- NEW FILE: w_fmodf.c --- /* w_fmodf.c -- float version of w_fmod.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_fmodf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper fmodf(x,y) */ #include "math.h" #include "math_private.h" float fmodf(float x, float y) /* wrapper fmodf */ { #ifdef _IEEE_LIBM return __ieee754_fmodf(x,y); #else float z; z = __ieee754_fmodf(x,y); if(_LIB_VERSION == _IEEE_ ||isnanf(y)||isnanf(x)) return z; if(y==(float)0.0) { /* fmodf(x,0) */ return (float)__kernel_standard((double)x,(double)y,127); } else return z; #endif } --- NEW FILE: w_gamma.c --- /* @(#)w_gamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_gamma.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* double gamma(double x) * Return the logarithm of the Gamma function of x. * * Method: call gamma_r */ #include "math.h" #include "math_private.h" extern int signgam; double gamma(double x) { #ifdef _IEEE_LIBM return __ieee754_gamma_r(x,&signgam); #else double y; y = __ieee754_gamma_r(x,&signgam); if(_LIB_VERSION == _IEEE_) return y; if(!finite(y)&&finite(x)) { if(floor(x)==x&&x<=0.0) return __kernel_standard(x,x,41); /* gamma pole */ else return __kernel_standard(x,x,40); /* gamma overflow */ } else return y; #endif } --- NEW FILE: w_gamma_r.c --- /* @(#)wr_gamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_gamma_r.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper double gamma_r(double x, int *signgamp) */ #include "math.h" #include "math_private.h" double gamma_r(double x, int *signgamp) /* wrapper lgamma_r */ { #ifdef _IEEE_LIBM return __ieee754_gamma_r(x,signgamp); #else double y; y = __ieee754_gamma_r(x,signgamp); if(_LIB_VERSION == _IEEE_) return y; if(!finite(y)&&finite(x)) { if(floor(x)==x&&x<=0.0) return __kernel_standard(x,x,41); /* gamma pole */ else return __kernel_standard(x,x,40); /* gamma overflow */ } else return y; #endif } --- NEW FILE: w_gammaf.c --- /* w_gammaf.c -- float version of w_gamma.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_gammaf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" extern int signgam; float gammaf(float x) { #ifdef _IEEE_LIBM return __ieee754_gammaf_r(x,&signgam); #else float y; y = __ieee754_gammaf_r(x,&signgam); if(_LIB_VERSION == _IEEE_) return y; if(!finitef(y)&&finitef(x)) { if(floorf(x)==x&&x<=(float)0.0) /* gammaf pole */ return (float)__kernel_standard((double)x,(double)x,141); else /* gammaf overflow */ return (float)__kernel_standard((double)x,(double)x,140); } else return y; #endif } --- NEW FILE: w_gammaf_r.c --- /* w_gammaf_r.c -- float version of w_gamma_r.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_gammaf_r.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper float gammaf_r(float x, int *signgamp) */ #include "math.h" #include "math_private.h" float gammaf_r(float x, int *signgamp) /* wrapper lgammaf_r */ { #ifdef _IEEE_LIBM return __ieee754_gammaf_r(x,signgamp); #else float y; y = __ieee754_gammaf_r(x,signgamp); if(_LIB_VERSION == _IEEE_) return y; if(!finitef(y)&&finitef(x)) { if(floorf(x)==x&&x<=(float)0.0) /* gammaf pole */ return (float)__kernel_standard((double)x,(double)x,141); else /* gamma overflow */ return (float)__kernel_standard((double)x,(double)x,140); } else return y; #endif } --- NEW FILE: w_hypot.c --- /* @(#)w_hypot.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_hypot.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper hypot(x,y) */ #include "math.h" #include "math_private.h" double hypot(double x, double y)/* wrapper hypot */ { #ifdef _IEEE_LIBM return __ieee754_hypot(x,y); #else double z; z = __ieee754_hypot(x,y); if(_LIB_VERSION == _IEEE_) return z; if((!finite(z))&&finite(x)&&finite(y)) return __kernel_standard(x,y,4); /* hypot overflow */ else return z; #endif } --- NEW FILE: w_hypotf.c --- /* w_hypotf.c -- float version of w_hypot.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_hypotf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper hypotf(x,y) */ #include "math.h" #include "math_private.h" float hypotf(float x, float y) /* wrapper hypotf */ { #ifdef _IEEE_LIBM return __ieee754_hypotf(x,y); #else float z; z = __ieee754_hypotf(x,y); if(_LIB_VERSION == _IEEE_) return z; if((!finitef(z))&&finitef(x)&&finitef(y)) /* hypot overflow */ return (float)__kernel_standard((double)x,(double)y,104); else return z; #endif } --- NEW FILE: w_j0.c --- /* @(#)w_j0.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_j0.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper j0(double x) */ #include "math.h" #include "math_private.h" double j0(double x) /* wrapper j0 */ { #ifdef _IEEE_LIBM return __ieee754_j0(x); #else double z = __ieee754_j0(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(fabs(x)>X_TLOSS) { return __kernel_standard(x,x,34); /* j0(|x|>X_TLOSS) */ } else return z; #endif } --- NEW FILE: w_j0f.c --- /* w_j0f.c -- float version of w_j0.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_j0f.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper j0f(float x) */ #include "math.h" #include "math_private.h" float j0f(float x) /* wrapper j0f */ { #ifdef _IEEE_LIBM return __ieee754_j0f(x); #else float z = __ieee754_j0f(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(fabsf(x)>(float)X_TLOSS) { /* j0f(|x|>X_TLOSS) */ return (float)__kernel_standard((double)x,(double)x,134); } else return z; #endif } --- NEW FILE: w_j1.c --- /* @(#)w_j1.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_j1.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper of j1 */ #include "math.h" #include "math_private.h" double j1(double x) /* wrapper j1 */ { #ifdef _IEEE_LIBM return __ieee754_j1(x); #else double z; z = __ieee754_j1(x); if(_LIB_VERSION == _IEEE_ || isnan(x) ) return z; if(fabs(x)>X_TLOSS) { return __kernel_standard(x,x,36); /* j1(|x|>X_TLOSS) */ } else return z; #endif } --- NEW FILE: w_j1f.c --- /* w_j1f.c -- float version of w_j1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_j1f.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper of j1f */ #include "math.h" #include "math_private.h" float j1f(float x) /* wrapper j1f */ { #ifdef _IEEE_LIBM return __ieee754_j1f(x); #else float z; z = __ieee754_j1f(x); if(_LIB_VERSION == _IEEE_ || isnanf(x) ) return z; if(fabsf(x)>(float)X_TLOSS) { /* j1(|x|>X_TLOSS) */ return (float)__kernel_standard((double)x,(double)x,136); } else return z; #endif } --- NEW FILE: w_jn.c --- /* @(#)w_jn.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_jn.c,v 1.9 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper jn(int n, double x) */ #include "math.h" #include "math_private.h" double jn(int n, double x) /* wrapper jn */ { #ifdef _IEEE_LIBM return __ieee754_jn(n,x); #else double z; z = __ieee754_jn(n,x); if(_LIB_VERSION == _IEEE_ || isnan(x) ) return z; if(fabs(x)>X_TLOSS) { return __kernel_standard((double)n,x,38); /* jn(|x|>X_TLOSS,n) */ } else return z; #endif } --- NEW FILE: w_jnf.c --- /* w_jnf.c -- float version of w_jn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_jnf.c,v 1.8 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float jnf(int n, float x) /* wrapper jnf */ { #ifdef _IEEE_LIBM return __ieee754_jnf(n,x); #else float z; z = __ieee754_jnf(n,x); if(_LIB_VERSION == _IEEE_ || isnanf(x) ) return z; if(fabsf(x)>(float)X_TLOSS) { /* jn(|x|>X_TLOSS,n) */ return (float)__kernel_standard((double)n,(double)x,138); } else return z; #endif } --- NEW FILE: w_lgamma.c --- /* @(#)w_lgamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_lgamma.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* double lgamma(double x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_lgamma_r */ #include "math.h" #include "math_private.h" extern int signgam; double lgamma(double x) { #ifdef _IEEE_LIBM return __ieee754_lgamma_r(x,&signgam); #else double y; y = __ieee754_lgamma_r(x,&signgam); if(_LIB_VERSION == _IEEE_) return y; if(!finite(y)&&finite(x)) { if(floor(x)==x&&x<=0.0) return __kernel_standard(x,x,15); /* lgamma pole */ else return __kernel_standard(x,x,14); /* lgamma overflow */ } else return y; #endif } --- NEW FILE: w_lgamma_r.c --- /* @(#)wr_lgamma.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_lgamma_r.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper double lgamma_r(double x, int *signgamp) */ #include "math.h" #include "math_private.h" double lgamma_r(double x, int *signgamp) /* wrapper lgamma_r */ { #ifdef _IEEE_LIBM return __ieee754_lgamma_r(x,signgamp); #else double y; y = __ieee754_lgamma_r(x,signgamp); if(_LIB_VERSION == _IEEE_) return y; if(!finite(y)&&finite(x)) { if(floor(x)==x&&x<=0.0) return __kernel_standard(x,x,15); /* lgamma pole */ else return __kernel_standard(x,x,14); /* lgamma overflow */ } else return y; #endif } --- NEW FILE: w_lgammaf.c --- /* w_lgammaf.c -- float version of w_lgamma.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_lgammaf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" extern int signgam; float lgammaf(float x) { #ifdef _IEEE_LIBM return __ieee754_lgammaf_r(x,&signgam); #else float y; y = __ieee754_lgammaf_r(x,&signgam); if(_LIB_VERSION == _IEEE_) return y; if(!finitef(y)&&finitef(x)) { if(floorf(x)==x&&x<=(float)0.0) /* lgamma pole */ return (float)__kernel_standard((double)x,(double)x,115); else /* lgamma overflow */ return (float)__kernel_standard((double)x,(double)x,114); } else return y; #endif } --- NEW FILE: w_lgammaf_r.c --- /* w_lgammaf_r.c -- float version of w_lgamma_r.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_lgammaf_r.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper float lgammaf_r(float x, int *signgamp) */ #include "math.h" #include "math_private.h" float lgammaf_r(float x, int *signgamp) /* wrapper lgammaf_r */ { #ifdef _IEEE_LIBM return __ieee754_lgammaf_r(x,signgamp); #else float y; y = __ieee754_lgammaf_r(x,signgamp); if(_LIB_VERSION == _IEEE_) return y; if(!finitef(y)&&finitef(x)) { if(floorf(x)==x&&x<=(float)0.0) /* lgamma pole */ return (float)__kernel_standard((double)x,(double)x,115); else /* lgamma overflow */ return (float)__kernel_standard((double)x,(double)x,114); } else return y; #endif } --- NEW FILE: w_log.c --- /* @(#)w_log.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_log.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper log(x) */ #include "math.h" #include "math_private.h" double log(double x) /* wrapper log */ { #ifdef _IEEE_LIBM return __ieee754_log(x); #else double z; z = __ieee754_log(x); if(_LIB_VERSION == _IEEE_ || isnan(x) || x > 0.0) return z; if(x==0.0) return __kernel_standard(x,x,16); /* log(0) */ else return __kernel_standard(x,x,17); /* log(x<0) */ #endif } --- NEW FILE: w_log10.c --- /* @(#)w_log10.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_log10.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper log10(X) */ #include "math.h" #include "math_private.h" double log10(double x) /* wrapper log10 */ { #ifdef _IEEE_LIBM return __ieee754_log10(x); #else double z; z = __ieee754_log10(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(x<=0.0) { if(x==0.0) return __kernel_standard(x,x,18); /* log10(0) */ else return __kernel_standard(x,x,19); /* log10(x<0) */ } else return z; #endif } --- NEW FILE: w_log10f.c --- /* w_log10f.c -- float version of w_log10.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_log10f.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper log10f(X) */ #include "math.h" #include "math_private.h" float log10f(float x) /* wrapper log10f */ { #ifdef _IEEE_LIBM return __ieee754_log10f(x); #else float z; z = __ieee754_log10f(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(x<=(float)0.0) { if(x==(float)0.0) /* log10(0) */ return (float)__kernel_standard((double)x,(double)x,118); else /* log10(x<0) */ return (float)__kernel_standard((double)x,(double)x,119); } else return z; #endif } --- NEW FILE: w_logf.c --- /* w_logf.c -- float version of w_log.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_logf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper logf(x) */ #include "math.h" #include "math_private.h" float logf(float x) /* wrapper logf */ { #ifdef _IEEE_LIBM return __ieee754_logf(x); #else float z; z = __ieee754_logf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x) || x > (float)0.0) return z; if(x==(float)0.0) /* logf(0) */ return (float)__kernel_standard((double)x,(double)x,116); else /* logf(x<0) */ return (float)__kernel_standard((double)x,(double)x,117); #endif } --- NEW FILE: w_pow.c --- /* @(#)w_pow.c 5.2 93/10/01 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ /* * wrapper pow(x,y) return x**y */ #include "math.h" #include "math_private.h" #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_pow.c,v 1.3 2002/05/28 17:51:46 alfred Exp $"; #endif double pow(double x, double y) /* wrapper pow */ { #ifdef _IEEE_LIBM return __ieee754_pow(x,y); #else double z; z=__ieee754_pow(x,y); if(_LIB_VERSION == _IEEE_|| isnan(y)) return z; if(isnan(x)) { if(y==0.0) return __kernel_standard(x,y,42); /* pow(NaN,0.0) */ else return z; } if(x==0.0){ if(y==0.0) return __kernel_standard(x,y,20); /* pow(0.0,0.0) */ if(finite(y)&&y<0.0) return __kernel_standard(x,y,23); /* pow(0.0,negative) */ return z; } if(!finite(z)) { if(finite(x)&&finite(y)) { if(isnan(z)) return __kernel_standard(x,y,24); /* pow neg**non-int */ else return __kernel_standard(x,y,21); /* pow overflow */ } } if(z==0.0&&finite(x)&&finite(y)) return __kernel_standard(x,y,22); /* pow underflow */ return z; #endif } --- NEW FILE: w_powf.c --- /* w_powf.c -- float version of w_pow.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_powf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper powf(x,y) return x**y */ #include "math.h" #include "math_private.h" float powf(float x, float y) /* wrapper powf */ { #ifdef _IEEE_LIBM return __ieee754_powf(x,y); #else float z; z=__ieee754_powf(x,y); if(_LIB_VERSION == _IEEE_|| isnanf(y)) return z; if(isnanf(x)) { if(y==(float)0.0) /* powf(NaN,0.0) */ return (float)__kernel_standard((double)x,(double)y,142); else return z; } if(x==(float)0.0){ if(y==(float)0.0) /* powf(0.0,0.0) */ return (float)__kernel_standard((double)x,(double)y,120); if(finitef(y)&&y<(float)0.0) /* powf(0.0,negative) */ return (float)__kernel_standard((double)x,(double)y,123); return z; } if(!finitef(z)) { if(finitef(x)&&finitef(y)) { if(isnanf(z)) /* powf neg**non-int */ return (float)__kernel_standard((double)x,(double)y,124); else /* powf overflow */ return (float)__kernel_standard((double)x,(double)y,121); } } if(z==(float)0.0&&finitef(x)&&finitef(y)) /* powf underflow */ return (float)__kernel_standard((double)x,(double)y,122); return z; #endif } --- NEW FILE: w_remainder.c --- /* @(#)w_remainder.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_remainder.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper remainder(x,p) */ #include "math.h" #include "math_private.h" double remainder(double x, double y) /* wrapper remainder */ { #ifdef _IEEE_LIBM return __ieee754_remainder(x,y); #else double z; z = __ieee754_remainder(x,y); if(_LIB_VERSION == _IEEE_ || isnan(y)) return z; if(y==0.0) return __kernel_standard(x,y,28); /* remainder(x,0) */ else return z; #endif } --- NEW FILE: w_remainderf.c --- /* w_remainderf.c -- float version of w_remainder.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_remainderf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper remainderf(x,p) */ #include "math.h" #include "math_private.h" float remainderf(float x, float y) /* wrapper remainder */ { #ifdef _IEEE_LIBM return __ieee754_remainderf(x,y); #else float z; z = __ieee754_remainderf(x,y); if(_LIB_VERSION == _IEEE_ || isnanf(y)) return z; if(y==(float)0.0) /* remainder(x,0) */ return (float)__kernel_standard((double)x,(double)y,128); else return z; #endif } --- NEW FILE: w_scalb.c --- /* @(#)w_scalb.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_scalb.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper scalb(double x, double fn) is provide for * passing various standard test suite. One * should use scalbn() instead. */ #include "math.h" #include "math_private.h" #include <errno.h> #ifdef _SCALB_INT double scalb(double x, int fn) /* wrapper scalb */ #else double scalb(double x, double fn) /* wrapper scalb */ #endif { #ifdef _IEEE_LIBM return __ieee754_scalb(x,fn); #else double z; z = __ieee754_scalb(x,fn); if(_LIB_VERSION == _IEEE_) return z; if(!(finite(z)||isnan(z))&&finite(x)) { return __kernel_standard(x,(double)fn,32); /* scalb overflow */ } if(z==0.0&&z!=x) { return __kernel_standard(x,(double)fn,33); /* scalb underflow */ } #ifndef _SCALB_INT if(!finite(fn)) errno = ERANGE; #endif return z; #endif } --- NEW FILE: w_scalbf.c --- /* w_scalbf.c -- float version of w_scalb.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_scalbf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper scalbf(float x, float fn) is provide for * passing various standard test suite. One * should use scalbn() instead. */ #include "math.h" #include "math_private.h" #include <errno.h> #ifdef _SCALB_INT float scalbf(float x, int fn) /* wrapper scalbf */ #else float scalbf(float x, float fn) /* wrapper scalbf */ #endif { #ifdef _IEEE_LIBM return __ieee754_scalbf(x,fn); #else float z; z = __ieee754_scalbf(x,fn); if(_LIB_VERSION == _IEEE_) return z; if(!(finitef(z)||isnanf(z))&&finitef(x)) { /* scalbf overflow */ return (float)__kernel_standard((double)x,(double)fn,132); } if(z==(float)0.0&&z!=x) { /* scalbf underflow */ return (float)__kernel_standard((double)x,(double)fn,133); } #ifndef _SCALB_INT if(!finitef(fn)) errno = ERANGE; #endif return z; #endif } --- NEW FILE: w_sinh.c --- /* @(#)w_sinh.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_sinh.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper sinh(x) */ #include "math.h" #include "math_private.h" double sinh(double x) /* wrapper sinh */ { #ifdef _IEEE_LIBM return __ieee754_sinh(x); #else double z; z = __ieee754_sinh(x); if(_LIB_VERSION == _IEEE_) return z; if(!finite(z)&&finite(x)) { return __kernel_standard(x,x,25); /* sinh overflow */ } else return z; #endif } --- NEW FILE: w_sinhf.c --- /* w_sinhf.c -- float version of w_sinh.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_sinhf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper sinhf(x) */ #include "math.h" #include "math_private.h" float sinhf(float x) /* wrapper sinhf */ { #ifdef _IEEE_LIBM return __ieee754_sinhf(x); #else float z; z = __ieee754_sinhf(x); if(_LIB_VERSION == _IEEE_) return z; if(!finitef(z)&&finitef(x)) { /* sinhf overflow */ return (float)__kernel_standard((double)x,(double)x,125); } else return z; #endif } --- NEW FILE: w_sqrt.c --- /* @(#)w_sqrt.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_sqrt.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper sqrt(x) */ #include "math.h" #include "math_private.h" double sqrt(double x) /* wrapper sqrt */ { #ifdef _IEEE_LIBM return __ieee754_sqrt(x); #else double z; z = __ieee754_sqrt(x); if(_LIB_VERSION == _IEEE_ || isnan(x)) return z; if(x<0.0) { return __kernel_standard(x,x,26); /* sqrt(negative) */ } else return z; #endif } --- NEW FILE: w_sqrtf.c --- /* w_sqrtf.c -- float version of w_sqrt.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_sqrtf.c,v 1.7 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper sqrtf(x) */ #include "math.h" #include "math_private.h" float sqrtf(float x) /* wrapper sqrtf */ { #ifdef _IEEE_LIBM return __ieee754_sqrtf(x); #else float z; z = __ieee754_sqrtf(x); if(_LIB_VERSION == _IEEE_ || isnanf(x)) return z; if(x<(float)0.0) { /* sqrtf(negative) */ return (float)__kernel_standard((double)x,(double)x,126); } else return z; #endif } --- NEW FILE: w_y0.c --- /* from: @(#)w_j0.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_y0.c,v 1.5 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper y0(double x) */ #include "math.h" #include "math_private.h" double y0(double x) /* wrapper y0 */ { #ifdef _IEEE_LIBM return __ieee754_y0(x); #else double z; z = __ieee754_y0(x); if(_LIB_VERSION == _IEEE_ || isnan(x) ) return z; if(x <= 0.0){ if(x==0.0) /* d= -one/(x-x); */ return __kernel_standard(x,x,8); else /* d = zero/(x-x); */ return __kernel_standard(x,x,9); } if(x>X_TLOSS) { return __kernel_standard(x,x,35); /* y0(x>X_TLOSS) */ } else return z; #endif } --- NEW FILE: w_y0f.c --- /* w_y0f.c -- float version of w_y0.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_y0f.c,v 1.5 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper y0f(float x) */ #include "math.h" #include "math_private.h" float y0f(float x) /* wrapper y0f */ { #ifdef _IEEE_LIBM return __ieee754_y0f(x); #else float z; z = __ieee754_y0f(x); if(_LIB_VERSION == _IEEE_ || isnanf(x) ) return z; if(x <= (float)0.0){ if(x==(float)0.0) /* d= -one/(x-x); */ return (float)__kernel_standard((double)x,(double)x,108); else /* d = zero/(x-x); */ return (float)__kernel_standard((double)x,(double)x,109); } if(x>(float)X_TLOSS) { /* y0(x>X_TLOSS) */ return (float)__kernel_standard((double)x,(double)x,135); } else return z; #endif } --- NEW FILE: w_y1.c --- /* from: @(#)w_j1.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_y1.c,v 1.5 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper of y1 */ #include "math.h" #include "math_private.h" double y1(double x) /* wrapper y1 */ { #ifdef _IEEE_LIBM return __ieee754_y1(x); #else double z; z = __ieee754_y1(x); if(_LIB_VERSION == _IEEE_ || isnan(x) ) return z; if(x <= 0.0){ if(x==0.0) /* d= -one/(x-x); */ return __kernel_standard(x,x,10); else /* d = zero/(x-x); */ return __kernel_standard(x,x,11); } if(x>X_TLOSS) { return __kernel_standard(x,x,37); /* y1(x>X_TLOSS) */ } else return z; #endif } --- NEW FILE: w_y1f.c --- /* w_y1f.c -- float version of w_y1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_y1f.c,v 1.5 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper of y1f */ #include "math.h" #include "math_private.h" float y1f(float x) /* wrapper y1f */ { #ifdef _IEEE_LIBM return __ieee754_y1f(x); #else float z; z = __ieee754_y1f(x); if(_LIB_VERSION == _IEEE_ || isnanf(x) ) return z; if(x <= (float)0.0){ if(x==(float)0.0) /* d= -one/(x-x); */ return (float)__kernel_standard((double)x,(double)x,110); else /* d = zero/(x-x); */ return (float)__kernel_standard((double)x,(double)x,111); } if(x>(float)X_TLOSS) { /* y1(x>X_TLOSS) */ return (float)__kernel_standard((double)x,(double)x,137); } else return z; #endif } --- NEW FILE: w_yn.c --- /* from: @(#)w_jn.c 5.1 93/09/24 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_yn.c,v 1.5 2002/05/28 18:15:04 alfred Exp $"; #endif /* * wrapper yn(int n, double x) */ #include "math.h" #include "math_private.h" double yn(int n, double x) /* wrapper yn */ { #ifdef _IEEE_LIBM return __ieee754_yn(n,x); #else double z; z = __ieee754_yn(n,x); if(_LIB_VERSION == _IEEE_ || isnan(x) ) return z; if(x <= 0.0){ if(x==0.0) /* d= -one/(x-x); */ return __kernel_standard((double)n,x,12); else /* d = zero/(x-x); */ return __kernel_standard((double)n,x,13); } if(x>X_TLOSS) { return __kernel_standard((double)n,x,39); /* yn(x>X_TLOSS,n) */ } else return z; #endif } --- NEW FILE: w_ynf.c --- /* w_ynf.c -- float version of w_yn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, [email protected]. */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunPro, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #ifndef lint static char rcsid[] = "$FreeBSD: src/lib/msun/src/w_ynf.c,v 1.5 2002/05/28 18:15:04 alfred Exp $"; #endif #include "math.h" #include "math_private.h" float ynf(int n, float x) /* wrapper ynf */ { #ifdef _IEEE_LIBM return __ieee754_ynf(n,x); #else float z; z = __ieee754_ynf(n,x); if(_LIB_VERSION == _IEEE_ || isnanf(x) ) return z; if(x <= (float)0.0){ if(x==(float)0.0) /* d= -one/(x-x); */ return (float)__kernel_standard((double)n,(double)x,112); else /* d = zero/(x-x); */ return (float)__kernel_standard((double)n,(double)x,113); } if(x>(float)X_TLOSS) { /* yn(x>X_TLOSS,n) */ return (float)__kernel_standard((double)n,(double)x,139); } else return z; #endif } ------------------------------------------------------- SF.Net email is Sponsored by the Better Software Conference & EXPO September 19-22, 2005 * San Francisco, CA * Development Lifecycle Practices Agile & Plan-Driven Development * Managing Projects & Teams * Testing & QA Security * Process Improvement & Measurement * http://www.sqe.com/bsce5sf