Index: stable/10/lib/msun/Makefile =================================================================== --- stable/10/lib/msun/Makefile (revision 284809) +++ stable/10/lib/msun/Makefile (revision 284810) @@ -1,226 +1,228 @@ # @(#)Makefile 5.1beta 93/09/24 # $FreeBSD$ # # ==================================================== # 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. # ==================================================== # # .if ${MACHINE_CPUARCH} == "i386" ARCH_SUBDIR= i387 .else ARCH_SUBDIR= ${MACHINE_CPUARCH} .endif .include "${ARCH_SUBDIR}/Makefile.inc" .PATH: ${.CURDIR}/${ARCH_SUBDIR} .if ${MACHINE_CPUARCH} == "i386" || ${MACHINE_CPUARCH} == "amd64" .PATH: ${.CURDIR}/x86 CFLAGS+= -I${.CURDIR}/x86 .endif # long double format .if ${LDBL_PREC} == 64 .PATH: ${.CURDIR}/ld80 CFLAGS+= -I${.CURDIR}/ld80 .elif ${LDBL_PREC} == 113 .PATH: ${.CURDIR}/ld128 CFLAGS+= -I${.CURDIR}/ld128 .endif .PATH: ${.CURDIR}/bsdsrc .PATH: ${.CURDIR}/src .PATH: ${.CURDIR}/man LIB= m SHLIBDIR?= /lib SHLIB_MAJOR= 5 WARNS?= 1 IGNORE_PRAGMA= COMMON_SRCS= b_exp.c b_log.c b_tgamma.c \ 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_log2.c e_log2f.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_sqrtf.c fenv.c \ imprecise.c \ k_cos.c k_cosf.c k_exp.c k_expf.c k_rem_pio2.c k_sin.c k_sinf.c \ k_tan.c k_tanf.c \ s_asinh.c s_asinhf.c s_atan.c s_atanf.c s_carg.c s_cargf.c s_cargl.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_csqrt.c s_csqrtf.c s_erf.c s_erff.c \ s_exp2.c s_exp2f.c s_expm1.c s_expm1f.c s_fabsf.c s_fdim.c \ s_finite.c s_finitef.c \ s_floor.c s_floorf.c s_fma.c s_fmaf.c \ s_fmax.c s_fmaxf.c s_fmaxl.c s_fmin.c \ s_fminf.c s_fminl.c s_frexp.c s_frexpf.c s_ilogb.c s_ilogbf.c \ s_ilogbl.c s_isfinite.c s_isnan.c s_isnormal.c \ s_llrint.c s_llrintf.c s_llround.c s_llroundf.c s_llroundl.c \ s_log1p.c s_log1pf.c s_logb.c s_logbf.c s_lrint.c s_lrintf.c \ s_lround.c s_lroundf.c s_lroundl.c s_modff.c \ s_nan.c s_nearbyint.c s_nextafter.c s_nextafterf.c \ s_nexttowardf.c s_remquo.c s_remquof.c \ s_rint.c s_rintf.c s_round.c s_roundf.c \ s_scalbln.c s_scalbn.c s_scalbnf.c s_signbit.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 s_tgammaf.c s_trunc.c s_truncf.c \ w_cabs.c w_cabsf.c w_drem.c w_dremf.c # Location of fpmath.h and _fpmath.h LIBCDIR= ${.CURDIR}/../libc .if exists(${LIBCDIR}/${MACHINE_ARCH}) LIBC_ARCH=${MACHINE_ARCH} .else LIBC_ARCH=${MACHINE_CPUARCH} .endif CFLAGS+= -I${.CURDIR}/src -I${LIBCDIR}/include \ -I${LIBCDIR}/${LIBC_ARCH} SYM_MAPS+= ${.CURDIR}/Symbol.map VERSION_DEF= ${LIBCDIR}/Versions.def SYMBOL_MAPS= ${SYM_MAPS} # C99 long double functions COMMON_SRCS+= s_copysignl.c s_fabsl.c s_llrintl.c s_lrintl.c s_modfl.c .if ${LDBL_PREC} != 53 # If long double != double use these; otherwise, we alias the double versions. COMMON_SRCS+= e_acoshl.c e_acosl.c e_asinl.c e_atan2l.c e_atanhl.c \ e_coshl.c e_fmodl.c e_hypotl.c \ + e_lgammal.c e_lgammal_r.c \ e_remainderl.c e_sinhl.c e_sqrtl.c \ invtrig.c k_cosl.c k_sinl.c k_tanl.c \ s_asinhl.c s_atanl.c s_cbrtl.c s_ceill.c s_cosl.c s_cprojl.c \ s_csqrtl.c s_erfl.c s_exp2l.c s_expl.c s_floorl.c s_fmal.c \ s_frexpl.c s_logbl.c s_logl.c s_nanl.c s_nextafterl.c \ s_nexttoward.c s_remquol.c s_rintl.c s_roundl.c s_scalbnl.c \ s_sinl.c s_tanhl.c s_tanl.c s_truncl.c w_cabsl.c .endif # C99 complex functions COMMON_SRCS+= catrig.c catrigf.c \ s_ccosh.c s_ccoshf.c s_cexp.c s_cexpf.c \ s_cimag.c s_cimagf.c s_cimagl.c \ s_conj.c s_conjf.c s_conjl.c \ s_cproj.c s_cprojf.c s_creal.c s_crealf.c s_creall.c \ s_csinh.c s_csinhf.c s_ctanh.c s_ctanhf.c # FreeBSD's C library supplies these functions: #COMMON_SRCS+= s_fabs.c s_frexp.c s_isnan.c s_ldexp.c s_modf.c # Exclude the generic versions of what we provide in the MD area. .if defined(ARCH_SRCS) .for i in ${ARCH_SRCS} COMMON_SRCS:= ${COMMON_SRCS:N${i:R}.c} .endfor .endif SRCS= ${COMMON_SRCS} ${ARCH_SRCS} INCS+= fenv.h math.h MAN= acos.3 acosh.3 asin.3 asinh.3 atan.3 atan2.3 atanh.3 \ ceil.3 cacos.3 ccos.3 ccosh.3 cexp.3 \ cimag.3 copysign.3 cos.3 cosh.3 csqrt.3 erf.3 exp.3 fabs.3 fdim.3 \ feclearexcept.3 feenableexcept.3 fegetenv.3 \ fegetround.3 fenv.3 floor.3 \ fma.3 fmax.3 fmod.3 hypot.3 ieee.3 ieee_test.3 ilogb.3 j0.3 \ lgamma.3 log.3 lrint.3 lround.3 math.3 nan.3 \ nextafter.3 remainder.3 rint.3 \ round.3 scalbn.3 signbit.3 sin.3 sinh.3 sqrt.3 tan.3 tanh.3 trunc.3 \ complex.3 MLINKS+=acos.3 acosf.3 acos.3 acosl.3 MLINKS+=acosh.3 acoshf.3 acosh.3 acoshl.3 MLINKS+=asin.3 asinf.3 asin.3 asinl.3 MLINKS+=asinh.3 asinhf.3 asinh.3 asinhl.3 MLINKS+=atan.3 atanf.3 atan.3 atanl.3 MLINKS+=atanh.3 atanhf.3 atanh.3 atanhl.3 MLINKS+=atan2.3 atan2f.3 atan2.3 atan2l.3 \ atan2.3 carg.3 atan2.3 cargf.3 atan2.3 cargl.3 MLINKS+=cacos.3 cacosf.3 cacos.3 cacosh.3 cacos.3 cacoshf.3 \ cacos.3 casin.3 cacos.3 casinf.3 cacos.3 casinh.3 cacos.3 casinhf.3 \ cacos.3 catan.3 cacos.3 catanf.3 cacos.3 catanh.3 cacos.3 catanhf.3 MLINKS+=ccos.3 ccosf.3 ccos.3 csin.3 ccos.3 csinf.3 ccos.3 ctan.3 ccos.3 ctanf.3 MLINKS+=ccosh.3 ccoshf.3 ccosh.3 csinh.3 ccosh.3 csinhf.3 \ ccosh.3 ctanh.3 ccosh.3 ctanhf.3 MLINKS+=ceil.3 ceilf.3 ceil.3 ceill.3 MLINKS+=cexp.3 cexpf.3 MLINKS+=cimag.3 cimagf.3 cimag.3 cimagl.3 \ cimag.3 conj.3 cimag.3 conjf.3 cimag.3 conjl.3 \ cimag.3 cproj.3 cimag.3 cprojf.3 cimag.3 cprojl.3 \ cimag.3 creal.3 cimag.3 crealf.3 cimag.3 creall.3 MLINKS+=copysign.3 copysignf.3 copysign.3 copysignl.3 MLINKS+=cos.3 cosf.3 cos.3 cosl.3 MLINKS+=cosh.3 coshf.3 cosh.3 coshl.3 MLINKS+=csqrt.3 csqrtf.3 csqrt.3 csqrtl.3 MLINKS+=erf.3 erfc.3 erf.3 erff.3 erf.3 erfcf.3 erf.3 erfl.3 erf.3 erfcl.3 MLINKS+=exp.3 expm1.3 exp.3 expm1f.3 exp.3 expm1l.3 exp.3 pow.3 exp.3 powf.3 \ exp.3 exp2.3 exp.3 exp2f.3 exp.3 exp2l.3 exp.3 expf.3 exp.3 expl.3 MLINKS+=fabs.3 fabsf.3 fabs.3 fabsl.3 MLINKS+=fdim.3 fdimf.3 fdim.3 fdiml.3 MLINKS+=feclearexcept.3 fegetexceptflag.3 feclearexcept.3 feraiseexcept.3 \ feclearexcept.3 fesetexceptflag.3 feclearexcept.3 fetestexcept.3 MLINKS+=feenableexcept.3 fedisableexcept.3 feenableexcept.3 fegetexcept.3 MLINKS+=fegetenv.3 feholdexcept.3 fegetenv.3 fesetenv.3 \ fegetenv.3 feupdateenv.3 MLINKS+=fegetround.3 fesetround.3 MLINKS+=floor.3 floorf.3 floor.3 floorl.3 MLINKS+=fma.3 fmaf.3 fma.3 fmal.3 MLINKS+=fmax.3 fmaxf.3 fmax.3 fmaxl.3 \ fmax.3 fmin.3 fmax.3 fminf.3 fmax.3 fminl.3 MLINKS+=fmod.3 fmodf.3 fmod.3 fmodl.3 MLINKS+=hypot.3 cabs.3 hypot.3 cabsf.3 hypot.3 cabsl.3 \ hypot.3 hypotf.3 hypot.3 hypotl.3 MLINKS+=ieee_test.3 scalb.3 ieee_test.3 scalbf.3 MLINKS+=ieee_test.3 significand.3 ieee_test.3 significandf.3 MLINKS+=ilogb.3 ilogbf.3 ilogb.3 ilogbl.3 \ ilogb.3 logb.3 ilogb.3 logbf.3 ilogb.3 logbl.3 MLINKS+=j0.3 j1.3 j0.3 jn.3 j0.3 y0.3 j0.3 y1.3 j0.3 y1f.3 j0.3 yn.3 MLINKS+=j0.3 j0f.3 j0.3 j1f.3 j0.3 jnf.3 j0.3 y0f.3 j0.3 ynf.3 -MLINKS+=lgamma.3 gamma.3 lgamma.3 gammaf.3 lgamma.3 lgammaf.3 \ +MLINKS+=lgamma.3 gamma.3 lgamma.3 gammaf.3 \ + lgamma.3 lgammaf.3 lgamma.3 lgammal.3 \ lgamma.3 tgamma.3 lgamma.3 tgammaf.3 MLINKS+=log.3 log10.3 log.3 log10f.3 log.3 log10l.3 \ log.3 log1p.3 log.3 log1pf.3 log.3 log1pl.3 \ log.3 logf.3 log.3 logl.3 \ log.3 log2.3 log.3 log2f.3 log.3 log2l.3 MLINKS+=lrint.3 llrint.3 lrint.3 llrintf.3 lrint.3 llrintl.3 \ lrint.3 lrintf.3 lrint.3 lrintl.3 MLINKS+=lround.3 llround.3 lround.3 llroundf.3 lround.3 llroundl.3 \ lround.3 lroundf.3 lround.3 lroundl.3 MLINKS+=nan.3 nanf.3 nan.3 nanl.3 MLINKS+=nextafter.3 nextafterf.3 nextafter.3 nextafterl.3 MLINKS+=nextafter.3 nexttoward.3 nextafter.3 nexttowardf.3 MLINKS+=nextafter.3 nexttowardl.3 MLINKS+=remainder.3 remainderf.3 remainder.3 remainderl.3 \ remainder.3 remquo.3 remainder.3 remquof.3 remainder.3 remquol.3 MLINKS+=rint.3 rintf.3 rint.3 rintl.3 \ rint.3 nearbyint.3 rint.3 nearbyintf.3 rint.3 nearbyintl.3 MLINKS+=round.3 roundf.3 round.3 roundl.3 MLINKS+=scalbn.3 scalbln.3 scalbn.3 scalblnf.3 scalbn.3 scalblnl.3 MLINKS+=scalbn.3 scalbnf.3 scalbn.3 scalbnl.3 MLINKS+=sin.3 sinf.3 sin.3 sinl.3 MLINKS+=sinh.3 sinhf.3 sinh.3 sinhl.3 MLINKS+=sqrt.3 cbrt.3 sqrt.3 cbrtf.3 sqrt.3 cbrtl.3 sqrt.3 sqrtf.3 \ sqrt.3 sqrtl.3 MLINKS+=tan.3 tanf.3 tan.3 tanl.3 MLINKS+=tanh.3 tanhf.3 tanh.3 tanhl.3 MLINKS+=trunc.3 truncf.3 trunc.3 truncl.3 .include .if ${MK_TESTS} != "no" SUBDIR+= tests .endif .include Index: stable/10/lib/msun/Symbol.map =================================================================== --- stable/10/lib/msun/Symbol.map (revision 284809) +++ stable/10/lib/msun/Symbol.map (revision 284810) @@ -1,282 +1,287 @@ /* * $FreeBSD$ */ /* 7.0-CURRENT */ FBSD_1.0 { __fe_dfl_env; tgamma; acos; acosf; acosh; acoshf; asin; asinf; atan2; atan2f; atanh; atanhf; cosh; coshf; exp; expf; fmod; fmodf; gamma; gamma_r; gammaf; gammaf_r; hypot; hypotf; j0; y0; j0f; y0f; j1; y1; j1f; y1f; jn; yn; jnf; ynf; lgamma; lgamma_r; lgammaf; lgammaf_r; log; log10; log10f; logf; pow; powf; remainder; remainderf; scalb; scalbf; sinh; sinhf; sqrt; sqrtf; asinh; asinhf; atan; atanf; cbrt; cbrtf; ceil; ceilf; ceill; cimag; cimagf; cimagl; conj; conjf; conjl; copysign; copysignf; copysignl; cos; cosf; creal; crealf; creall; erf; erfc; erff; erfcf; exp2; exp2f; expm1; expm1f; fabs; fabsf; fabsl; fdim; fdimf; fdiml; finite; finitef; floor; floorf; floorl; fma; fmaf; fmal; fmax; fmaxf; fmaxl; fmin; fminf; fminl; frexp; frexpf; frexpl; ilogb; ilogbf; ilogbl; __isfinite; __isfinitef; __isfinitel; isnanf; __isnanl; __isnormal; __isnormalf; __isnormall; llrint; llrintf; llround; llroundf; llroundl; log1p; log1pf; logb; logbf; lrint; lrintf; lround; lroundf; lroundl; modff; modfl; nearbyint; nearbyintf; nextafter; nexttoward; nexttowardl; nextafterl; nextafterf; nexttowardf; remquo; remquof; rint; rintf; round; roundf; roundl; scalbln; scalblnf; scalblnl; scalbn; scalbnl; scalbnf; ldexpf; ldexpl; __signbit; __signbitf; __signbitl; signgam; significand; significandf; sin; sinf; tan; tanf; tanh; tanhf; trunc; truncf; truncl; cabs; cabsf; drem; dremf; }; /* First added in 8.0-CURRENT */ FBSD_1.1 { carg; cargf; csqrt; csqrtf; logbl; nan; nanf; nanl; llrintl; lrintl; nearbyintl; rintl; exp2l; sinl; cosl; tanl; tgammaf; sqrtl; hypotl; cabsl; csqrtl; remquol; remainderl; fmodl; acosl; asinl; atan2l; atanl; cargl; cproj; cprojf; cprojl; }; /* First added in 9.0-CURRENT */ FBSD_1.2 { __isnanf; cbrtl; cexp; cexpf; log2; log2f; }; /* First added in 10.0-CURRENT */ FBSD_1.3 { feclearexcept; fegetexceptflag; fetestexcept; fegetround; fesetround; fesetenv; acoshl; asinhl; atanhl; cacos; cacosf; cacosh; cacoshf; casin; casinf; casinh; casinhf; catan; catanf; catanh; catanhf; csin; csinf; csinh; csinhf; ccos; ccosf; ccosh; ccoshf; coshl; ctan; ctanf; ctanh; ctanhf; erfcl; erfl; expl; expm1l; + lgammal; log10l; log1pl; log2l; logl; sinhl; tanhl; /* Implemented as weak aliases for imprecise versions */ - lgammal; powl; tgammal; +}; + +/* First added in 11.0-CURRENT */ +FBSD_1.4 { + lgammal_r; }; Index: stable/10/lib/msun/ld128/e_lgammal_r.c =================================================================== --- stable/10/lib/msun/ld128/e_lgammal_r.c (nonexistent) +++ stable/10/lib/msun/ld128/e_lgammal_r.c (revision 284810) @@ -0,0 +1,330 @@ +/* @(#)e_lgamma_r.c 1.3 95/01/18 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include +__FBSDID("$FreeBSD$"); + +/* + * See e_lgamma_r.c for complete comments. + * + * Converted to long double by Steven G. Kargl. + */ + +#include "fpmath.h" +#include "math.h" +#include "math_private.h" + +static const volatile double vzero = 0; + +static const double +zero= 0, +half= 0.5, +one = 1; + +static const long double +pi = 3.14159265358979323846264338327950288e+00L; +/* + * Domain y in [0x1p-119, 0.28], range ~[-1.4065e-36, 1.4065e-36]: + * |(lgamma(2 - y) + y / 2) / y - a(y)| < 2**-119.1 + */ +static const long double +a0 = 7.72156649015328606065120900824024296e-02L, +a1 = 3.22467033424113218236207583323018498e-01L, +a2 = 6.73523010531980951332460538330282217e-02L, +a3 = 2.05808084277845478790009252803463129e-02L, +a4 = 7.38555102867398526627292839296001626e-03L, +a5 = 2.89051033074152328576829509522483468e-03L, +a6 = 1.19275391170326097618357349881842913e-03L, +a7 = 5.09669524743042462515256340206203019e-04L, +a8 = 2.23154758453578096143609255559576017e-04L, +a9 = 9.94575127818397632126978731542755129e-05L, +a10 = 4.49262367375420471287545895027098145e-05L, +a11 = 2.05072127845117995426519671481628849e-05L, +a12 = 9.43948816959096748454087141447939513e-06L, +a13 = 4.37486780697359330303852050718287419e-06L, +a14 = 2.03920783892362558276037363847651809e-06L, +a15 = 9.55191070057967287877923073200324649e-07L, +a16 = 4.48993286185740853170657139487620560e-07L, +a17 = 2.13107543597620911675316728179563522e-07L, +a18 = 9.70745379855304499867546549551023473e-08L, +a19 = 5.61889970390290257926487734695402075e-08L, +a20 = 6.42739653024130071866684358960960951e-09L, +a21 = 3.34491062143649291746195612991870119e-08L, +a22 = -1.57068547394315223934653011440641472e-08L, +a23 = 1.30812825422415841213733487745200632e-08L; +/* + * Domain x in [tc-0.24, tc+0.28], range ~[-6.3201e-37, 6.3201e-37]: + * |(lgamma(x) - tf) - t(x - tc)| < 2**-120.3. + */ +static const long double +tc = 1.46163214496836234126265954232572133e+00L, +tf = -1.21486290535849608095514557177691584e-01L, +tt = 1.57061739945077675484237837992951704e-36L, +t0 = -1.99238329499314692728655623767019240e-36L, +t1 = -6.08453430711711404116887457663281416e-35L, +t2 = 4.83836122723810585213722380854828904e-01L, +t3 = -1.47587722994530702030955093950668275e-01L, +t4 = 6.46249402389127526561003464202671923e-02L, +t5 = -3.27885410884813055008502586863748063e-02L, +t6 = 1.79706751152103942928638276067164935e-02L, +t7 = -1.03142230366363872751602029672767978e-02L, +t8 = 6.10053602051788840313573150785080958e-03L, +t9 = -3.68456960831637325470641021892968954e-03L, +t10 = 2.25976482322181046611440855340968560e-03L, +t11 = -1.40225144590445082933490395950664961e-03L, +t12 = 8.78232634717681264035014878172485575e-04L, +t13 = -5.54194952796682301220684760591403899e-04L, +t14 = 3.51912956837848209220421213975000298e-04L, +t15 = -2.24653443695947456542669289367055542e-04L, +t16 = 1.44070395420840737695611929680511823e-04L, +t17 = -9.27609865550394140067059487518862512e-05L, +t18 = 5.99347334438437081412945428365433073e-05L, +t19 = -3.88458388854572825603964274134801009e-05L, +t20 = 2.52476631610328129217896436186551043e-05L, +t21 = -1.64508584981658692556994212457518536e-05L, +t22 = 1.07434583475987007495523340296173839e-05L, +t23 = -7.03070407519397260929482550448878399e-06L, +t24 = 4.60968590693753579648385629003100469e-06L, +t25 = -3.02765473778832036018438676945512661e-06L, +t26 = 1.99238771545503819972741288511303401e-06L, +t27 = -1.31281299822614084861868817951788579e-06L, +t28 = 8.60844432267399655055574642052370223e-07L, +t29 = -5.64535486432397413273248363550536374e-07L, +t30 = 3.99357783676275660934903139592727737e-07L, +t31 = -2.95849029193433121795495215869311610e-07L, +t32 = 1.37790144435073124976696250804940384e-07L; +/* + * Domain y in [-0.1, 0.232], range ~[-1.4046e-37, 1.4181e-37]: + * |(lgamma(1 + y) + 0.5 * y) / y - u(y) / v(y)| < 2**-122.8 + */ +static const long double +u0 = -7.72156649015328606065120900824024311e-02L, +u1 = 4.24082772271938167430983113242482656e-01L, +u2 = 2.96194003481457101058321977413332171e+00L, +u3 = 6.49503267711258043997790983071543710e+00L, +u4 = 7.40090051288150177152835698948644483e+00L, +u5 = 4.94698036296756044610805900340723464e+00L, +u6 = 2.00194224610796294762469550684947768e+00L, +u7 = 4.82073087750608895996915051568834949e-01L, +u8 = 6.46694052280506568192333848437585427e-02L, +u9 = 4.17685526755100259316625348933108810e-03L, +u10 = 9.06361003550314327144119307810053410e-05L, +v1 = 5.15937098592887275994320496999951947e+00L, +v2 = 1.14068418766251486777604403304717558e+01L, +v3 = 1.41164839437524744055723871839748489e+01L, +v4 = 1.07170702656179582805791063277960532e+01L, +v5 = 5.14448694179047879915042998453632434e+00L, +v6 = 1.55210088094585540637493826431170289e+00L, +v7 = 2.82975732849424562719893657416365673e-01L, +v8 = 2.86424622754753198010525786005443539e-02L, +v9 = 1.35364253570403771005922441442688978e-03L, +v10 = 1.91514173702398375346658943749580666e-05L, +v11 = -3.25364686890242327944584691466034268e-08L; +/* + * Domain x in (2, 3], range ~[-1.3341e-36, 1.3536e-36]: + * |(lgamma(y+2) - 0.5 * y) / y - s(y)/r(y)| < 2**-120.1 + * with y = x - 2. + */ +static const long double +s0 = -7.72156649015328606065120900824024297e-02L, +s1 = 1.23221687850916448903914170805852253e-01L, +s2 = 5.43673188699937239808255378293820020e-01L, +s3 = 6.31998137119005233383666791176301800e-01L, +s4 = 3.75885340179479850993811501596213763e-01L, +s5 = 1.31572908743275052623410195011261575e-01L, +s6 = 2.82528453299138685507186287149699749e-02L, +s7 = 3.70262021550340817867688714880797019e-03L, +s8 = 2.83374000312371199625774129290973648e-04L, +s9 = 1.15091830239148290758883505582343691e-05L, +s10 = 2.04203474281493971326506384646692446e-07L, +s11 = 9.79544198078992058548607407635645763e-10L, +r1 = 2.58037466655605285937112832039537492e+00L, +r2 = 2.86289413392776399262513849911531180e+00L, +r3 = 1.78691044735267497452847829579514367e+00L, +r4 = 6.89400381446725342846854215600008055e-01L, +r5 = 1.70135865462567955867134197595365343e-01L, +r6 = 2.68794816183964420375498986152766763e-02L, +r7 = 2.64617234244861832870088893332006679e-03L, +r8 = 1.52881761239180800640068128681725702e-04L, +r9 = 4.63264813762296029824851351257638558e-06L, +r10 = 5.89461519146957343083848967333671142e-08L, +r11 = 1.79027678176582527798327441636552968e-10L; +/* + * Domain z in [8, 0x1p70], range ~[-9.8214e-35, 9.8214e-35]: + * |lgamma(x) - (x - 0.5) * (log(x) - 1) - w(1/x)| < 2**-113.0 + */ +static const long double +w0 = 4.18938533204672741780329736405617738e-01L, +w1 = 8.33333333333333333333333333332852026e-02L, +w2 = -2.77777777777777777777777727810123528e-03L, +w3 = 7.93650793650793650791708939493907380e-04L, +w4 = -5.95238095238095234390450004444370959e-04L, +w5 = 8.41750841750837633887817658848845695e-04L, +w6 = -1.91752691752396849943172337347259743e-03L, +w7 = 6.41025640880333069429106541459015557e-03L, +w8 = -2.95506530801732133437990433080327074e-02L, +w9 = 1.79644237328444101596766586979576927e-01L, +w10 = -1.39240539108367641920172649259736394e+00L, +w11 = 1.33987701479007233325288857758641761e+01L, +w12 = -1.56363596431084279780966590116006255e+02L, +w13 = 2.14830978044410267201172332952040777e+03L, +w14 = -3.28636067474227378352761516589092334e+04L, +w15 = 5.06201257747865138432663574251462485e+05L, +w16 = -6.79720123352023636706247599728048344e+06L, +w17 = 6.57556601705472106989497289465949255e+07L, +w18 = -3.26229058141181783534257632389415580e+08L; + +static long double +sin_pil(long double x) +{ + volatile long double vz; + long double y,z; + uint64_t lx, n; + uint16_t hx; + + y = -x; + + vz = y+0x1.p112; + z = vz-0x1.p112; + if (z == y) + return zero; + + vz = y+0x1.p110; + EXTRACT_LDBL128_WORDS(hx,lx,n,vz); + z = vz-0x1.p110; + if (z > y) { + z -= 0.25; + n--; + } + n &= 7; + y = y - z + n * 0.25; + + switch (n) { + case 0: y = __kernel_sinl(pi*y,zero,0); break; + case 1: + case 2: y = __kernel_cosl(pi*(0.5-y),zero); break; + case 3: + case 4: y = __kernel_sinl(pi*(one-y),zero,0); break; + case 5: + case 6: y = -__kernel_cosl(pi*(y-1.5),zero); break; + default: y = __kernel_sinl(pi*(y-2.0),zero,0); break; + } + return -y; +} + +long double +lgammal_r(long double x, int *signgamp) +{ + long double nadj,p,p1,p2,p3,q,r,t,w,y,z; + uint64_t llx,lx; + int i; + uint16_t hx,ix; + + EXTRACT_LDBL128_WORDS(hx,lx,llx,x); + + /* purge +-Inf and NaNs */ + *signgamp = 1; + ix = hx&0x7fff; + if(ix==0x7fff) return x*x; + + /* purge +-0 and tiny arguments */ + *signgamp = 1-2*(hx>>15); + if(ix<0x3fff-116) { /* |x|<2**-(p+3), return -log(|x|) */ + if((ix|lx|llx)==0) + return one/vzero; + return -logl(fabsl(x)); + } + + /* purge negative integers and start evaluation for other x < 0 */ + if(hx&0x8000) { + *signgamp = 1; + if(ix>=0x3fff+112) /* |x|>=2**(p-1), must be -integer */ + return one/vzero; + t = sin_pil(x); + if(t==zero) return one/vzero; + nadj = logl(pi/fabsl(t*x)); + if(t=7.3159980773925781e-01) {y = 1-x; i= 0;} + else if(x>=2.3163998126983643e-01) {y= x-(tc-1); i=1;} + else {y = x; i=2;} + } else { + r = 0; + if(x>=1.7316312789916992e+00) {y=2-x;i=0;} + else if(x>=1.2316322326660156e+00) {y=x-tc;i=1;} + else {y=x-1;i=2;} + } + switch(i) { + case 0: + z = y*y; + p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*(a10+z*(a12+z*(a14+z*(a16+ + z*(a18+z*(a20+z*a22)))))))))); + p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*(a11+z*(a13+z*(a15+ + z*(a17+z*(a19+z*(a21+z*a23))))))))))); + p = y*p1+p2; + r += p-y/2; break; + case 1: + p = t0+y*t1+tt+y*y*(t2+y*(t3+y*(t4+y*(t5+y*(t6+y*(t7+y*(t8+ + y*(t9+y*(t10+y*(t11+y*(t12+y*(t13+y*(t14+y*(t15+y*(t16+ + y*(t17+y*(t18+y*(t19+y*(t20+y*(t21+y*(t22+y*(t23+ + y*(t24+y*(t25+y*(t26+y*(t27+y*(t28+y*(t29+y*(t30+ + y*(t31+y*t32)))))))))))))))))))))))))))))); + r += tf + p; break; + case 2: + p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*(u5+y*(u6+y*(u7+ + y*(u8+y*(u9+y*u10)))))))))); + p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*(v5+y*(v6+y*(v7+ + y*(v8+y*(v9+y*(v10+y*v11)))))))))); + r += p1/p2-y/2; + } + } + /* x < 8.0 */ + else if(ix<0x4002) { + i = x; + y = x-i; + p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*(s6+y*(s7+y*(s8+ + y*(s9+y*(s10+y*s11))))))))))); + q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*(r6+y*(r7+y*(r8+ + y*(r9+y*(r10+y*r11)))))))))); + r = y/2+p/q; + z = 1; /* lgamma(1+s) = log(s) + lgamma(s) */ + switch(i) { + case 7: z *= (y+6); /* FALLTHRU */ + case 6: z *= (y+5); /* FALLTHRU */ + case 5: z *= (y+4); /* FALLTHRU */ + case 4: z *= (y+3); /* FALLTHRU */ + case 3: z *= (y+2); /* FALLTHRU */ + r += logl(z); break; + } + /* 8.0 <= x < 2**(p+3) */ + } else if (ix<0x3fff+116) { + t = logl(x); + z = one/x; + y = z*z; + w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*(w6+y*(w7+y*(w8+ + y*(w9+y*(w10+y*(w11+y*(w12+y*(w13+y*(w14+y*(w15+y*(w16+ + y*(w17+y*w18))))))))))))))))); + r = (x-half)*(t-one)+w; + /* 2**(p+3) <= x <= inf */ + } else + r = x*(logl(x)-1); + if(hx&0x8000) r = nadj - r; + return r; +} Property changes on: stable/10/lib/msun/ld128/e_lgammal_r.c ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: svn:keywords ## -0,0 +1 ## +FreeBSD=%H \ No newline at end of property Added: svn:mime-type ## -0,0 +1 ## +text/plain \ No newline at end of property Index: stable/10/lib/msun/ld128/k_expl.h =================================================================== --- stable/10/lib/msun/ld128/k_expl.h (revision 284809) +++ stable/10/lib/msun/ld128/k_expl.h (revision 284810) @@ -1,328 +1,328 @@ /* from: FreeBSD: head/lib/msun/ld128/s_expl.c 251345 2013-06-03 20:09:22Z kargl */ /*- * Copyright (c) 2009-2013 Steven G. Kargl * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. * * Optimized by Bruce D. Evans. */ #include __FBSDID("$FreeBSD$"); /* * ld128 version of k_expl.h. See ../ld80/s_expl.c for most comments. * * See ../src/e_exp.c and ../src/k_exp.h for precision-independent comments * about the secondary kernels. */ #define INTERVALS 128 #define LOG2_INTERVALS 7 #define BIAS (LDBL_MAX_EXP - 1) static const double /* * ln2/INTERVALS = L1+L2 (hi+lo decomposition for multiplication). L1 must * have at least 22 (= log2(|LDBL_MIN_EXP-extras|) + log2(INTERVALS)) lowest * bits zero so that multiplication of it by n is exact. */ INV_L = 1.8466496523378731e+2, /* 0x171547652b82fe.0p-45 */ L2 = -1.0253670638894731e-29; /* -0x1.9ff0342542fc3p-97 */ static const long double /* 0x1.62e42fefa39ef35793c768000000p-8 */ L1 = 5.41521234812457272982212595914567508e-3L; /* * XXX values in hex in comments have been lost (or were never present) * from here. */ static const long double /* * Domain [-0.002708, 0.002708], range ~[-2.4021e-38, 2.4234e-38]: * |exp(x) - p(x)| < 2**-124.9 * (0.002708 is ln2/(2*INTERVALS) rounded up a little). * * XXX the coeffs aren't very carefully rounded, and I get 3.6 more bits. */ A2 = 0.5, A3 = 1.66666666666666666666666666651085500e-1L, A4 = 4.16666666666666666666666666425885320e-2L, A5 = 8.33333333333333333334522877160175842e-3L, A6 = 1.38888888888888888889971139751596836e-3L; static const double A7 = 1.9841269841269470e-4, /* 0x1.a01a01a019f91p-13 */ A8 = 2.4801587301585286e-5, /* 0x1.71de3ec75a967p-19 */ A9 = 2.7557324277411235e-6, /* 0x1.71de3ec75a967p-19 */ A10 = 2.7557333722375069e-7; /* 0x1.27e505ab56259p-22 */ static const struct { /* * hi must be rounded to at most 106 bits so that multiplication * by r1 in expm1l() is exact, but it is rounded to 88 bits due to * historical accidents. * * XXX it is wasteful to use long double for both hi and lo. ld128 * exp2l() uses only float for lo (in a very differently organized * table; ld80 exp2l() is different again. It uses 2 doubles in a * table organized like this one. 1 double and 1 float would * suffice). There are different packing/locality/alignment/caching * problems with these methods. * * XXX C's bad %a format makes the bits unreadable. They happen * to all line up for the hi values 1 before the point and 88 * in 22 nybbles, but for the low values the nybbles are shifted * randomly. */ long double hi; long double lo; } tbl[INTERVALS] = { 0x1p0L, 0x0p0L, 0x1.0163da9fb33356d84a66aep0L, 0x3.36dcdfa4003ec04c360be2404078p-92L, 0x1.02c9a3e778060ee6f7cacap0L, 0x4.f7a29bde93d70a2cabc5cb89ba10p-92L, 0x1.04315e86e7f84bd738f9a2p0L, 0xd.a47e6ed040bb4bfc05af6455e9b8p-96L, 0x1.059b0d31585743ae7c548ep0L, 0xb.68ca417fe53e3495f7df4baf84a0p-92L, 0x1.0706b29ddf6ddc6dc403a8p0L, 0x1.d87b27ed07cb8b092ac75e311753p-88L, 0x1.0874518759bc808c35f25cp0L, 0x1.9427fa2b041b2d6829d8993a0d01p-88L, 0x1.09e3ecac6f3834521e060cp0L, 0x5.84d6b74ba2e023da730e7fccb758p-92L, 0x1.0b5586cf9890f6298b92b6p0L, 0x1.1842a98364291408b3ceb0a2a2bbp-88L, 0x1.0cc922b7247f7407b705b8p0L, 0x9.3dc5e8aac564e6fe2ef1d431fd98p-92L, 0x1.0e3ec32d3d1a2020742e4ep0L, 0x1.8af6a552ac4b358b1129e9f966a4p-88L, 0x1.0fb66affed31af232091dcp0L, 0x1.8a1426514e0b627bda694a400a27p-88L, 0x1.11301d0125b50a4ebbf1aep0L, 0xd.9318ceac5cc47ab166ee57427178p-92L, 0x1.12abdc06c31cbfb92bad32p0L, 0x4.d68e2f7270bdf7cedf94eb1cb818p-92L, 0x1.1429aaea92ddfb34101942p0L, 0x1.b2586d01844b389bea7aedd221d4p-88L, 0x1.15a98c8a58e512480d573cp0L, 0x1.d5613bf92a2b618ee31b376c2689p-88L, 0x1.172b83c7d517adcdf7c8c4p0L, 0x1.0eb14a792035509ff7d758693f24p-88L, 0x1.18af9388c8de9bbbf70b9ap0L, 0x3.c2505c97c0102e5f1211941d2840p-92L, 0x1.1a35beb6fcb753cb698f68p0L, 0x1.2d1c835a6c30724d5cfae31b84e5p-88L, 0x1.1bbe084045cd39ab1e72b4p0L, 0x4.27e35f9acb57e473915519a1b448p-92L, 0x1.1d4873168b9aa7805b8028p0L, 0x9.90f07a98b42206e46166cf051d70p-92L, 0x1.1ed5022fcd91cb8819ff60p0L, 0x1.121d1e504d36c47474c9b7de6067p-88L, 0x1.2063b88628cd63b8eeb028p0L, 0x1.50929d0fc487d21c2b84004264dep-88L, 0x1.21f49917ddc962552fd292p0L, 0x9.4bdb4b61ea62477caa1dce823ba0p-92L, 0x1.2387a6e75623866c1fadb0p0L, 0x1.c15cb593b0328566902df69e4de2p-88L, 0x1.251ce4fb2a63f3582ab7dep0L, 0x9.e94811a9c8afdcf796934bc652d0p-92L, 0x1.26b4565e27cdd257a67328p0L, 0x1.d3b249dce4e9186ddd5ff44e6b08p-92L, 0x1.284dfe1f5638096cf15cf0p0L, 0x3.ca0967fdaa2e52d7c8106f2e262cp-92L, 0x1.29e9df51fdee12c25d15f4p0L, 0x1.a24aa3bca890ac08d203fed80a07p-88L, 0x1.2b87fd0dad98ffddea4652p0L, 0x1.8fcab88442fdc3cb6de4519165edp-88L, 0x1.2d285a6e4030b40091d536p0L, 0xd.075384589c1cd1b3e4018a6b1348p-92L, 0x1.2ecafa93e2f5611ca0f45cp0L, 0x1.523833af611bdcda253c554cf278p-88L, 0x1.306fe0a31b7152de8d5a46p0L, 0x3.05c85edecbc27343629f502f1af2p-92L, 0x1.32170fc4cd8313539cf1c2p0L, 0x1.008f86dde3220ae17a005b6412bep-88L, 0x1.33c08b26416ff4c9c8610cp0L, 0x1.96696bf95d1593039539d94d662bp-88L, 0x1.356c55f929ff0c94623476p0L, 0x3.73af38d6d8d6f9506c9bbc93cbc0p-92L, 0x1.371a7373aa9caa7145502ep0L, 0x1.4547987e3e12516bf9c699be432fp-88L, 0x1.38cae6d05d86585a9cb0d8p0L, 0x1.bed0c853bd30a02790931eb2e8f0p-88L, 0x1.3a7db34e59ff6ea1bc9298p0L, 0x1.e0a1d336163fe2f852ceeb134067p-88L, 0x1.3c32dc313a8e484001f228p0L, 0xb.58f3775e06ab66353001fae9fca0p-92L, 0x1.3dea64c12342235b41223ep0L, 0x1.3d773fba2cb82b8244267c54443fp-92L, 0x1.3fa4504ac801ba0bf701aap0L, 0x4.1832fb8c1c8dbdff2c49909e6c60p-92L, 0x1.4160a21f72e29f84325b8ep0L, 0x1.3db61fb352f0540e6ba05634413ep-88L, 0x1.431f5d950a896dc7044394p0L, 0x1.0ccec81e24b0caff7581ef4127f7p-92L, 0x1.44e086061892d03136f408p0L, 0x1.df019fbd4f3b48709b78591d5cb5p-88L, 0x1.46a41ed1d005772512f458p0L, 0x1.229d97df404ff21f39c1b594d3a8p-88L, 0x1.486a2b5c13cd013c1a3b68p0L, 0x1.062f03c3dd75ce8757f780e6ec99p-88L, 0x1.4a32af0d7d3de672d8bcf4p0L, 0x6.f9586461db1d878b1d148bd3ccb8p-92L, 0x1.4bfdad5362a271d4397afep0L, 0xc.42e20e0363ba2e159c579f82e4b0p-92L, 0x1.4dcb299fddd0d63b36ef1ap0L, 0x9.e0cc484b25a5566d0bd5f58ad238p-92L, 0x1.4f9b2769d2ca6ad33d8b68p0L, 0x1.aa073ee55e028497a329a7333dbap-88L, 0x1.516daa2cf6641c112f52c8p0L, 0x4.d822190e718226177d7608d20038p-92L, 0x1.5342b569d4f81df0a83c48p0L, 0x1.d86a63f4e672a3e429805b049465p-88L, 0x1.551a4ca5d920ec52ec6202p0L, 0x4.34ca672645dc6c124d6619a87574p-92L, 0x1.56f4736b527da66ecb0046p0L, 0x1.64eb3c00f2f5ab3d801d7cc7272dp-88L, 0x1.58d12d497c7fd252bc2b72p0L, 0x1.43bcf2ec936a970d9cc266f0072fp-88L, 0x1.5ab07dd48542958c930150p0L, 0x1.91eb345d88d7c81280e069fbdb63p-88L, 0x1.5c9268a5946b701c4b1b80p0L, 0x1.6986a203d84e6a4a92f179e71889p-88L, 0x1.5e76f15ad21486e9be4c20p0L, 0x3.99766a06548a05829e853bdb2b52p-92L, 0x1.605e1b976dc08b076f592ap0L, 0x4.86e3b34ead1b4769df867b9c89ccp-92L, 0x1.6247eb03a5584b1f0fa06ep0L, 0x1.d2da42bb1ceaf9f732275b8aef30p-88L, 0x1.6434634ccc31fc76f8714cp0L, 0x4.ed9a4e41000307103a18cf7a6e08p-92L, 0x1.66238825522249127d9e28p0L, 0x1.b8f314a337f4dc0a3adf1787ff74p-88L, 0x1.68155d44ca973081c57226p0L, 0x1.b9f32706bfe4e627d809a85dcc66p-88L, 0x1.6a09e667f3bcc908b2fb12p0L, 0x1.66ea957d3e3adec17512775099dap-88L, 0x1.6c012750bdabeed76a9980p0L, 0xf.4f33fdeb8b0ecd831106f57b3d00p-96L, 0x1.6dfb23c651a2ef220e2cbep0L, 0x1.bbaa834b3f11577ceefbe6c1c411p-92L, 0x1.6ff7df9519483cf87e1b4ep0L, 0x1.3e213bff9b702d5aa477c12523cep-88L, 0x1.71f75e8ec5f73dd2370f2ep0L, 0xf.0acd6cb434b562d9e8a20adda648p-92L, 0x1.73f9a48a58173bd5c9a4e6p0L, 0x8.ab1182ae217f3a7681759553e840p-92L, 0x1.75feb564267c8bf6e9aa32p0L, 0x1.a48b27071805e61a17b954a2dad8p-88L, 0x1.780694fde5d3f619ae0280p0L, 0x8.58b2bb2bdcf86cd08e35fb04c0f0p-92L, 0x1.7a11473eb0186d7d51023ep0L, 0x1.6cda1f5ef42b66977960531e821bp-88L, 0x1.7c1ed0130c1327c4933444p0L, 0x1.937562b2dc933d44fc828efd4c9cp-88L, 0x1.7e2f336cf4e62105d02ba0p0L, 0x1.5797e170a1427f8fcdf5f3906108p-88L, 0x1.80427543e1a11b60de6764p0L, 0x9.a354ea706b8e4d8b718a672bf7c8p-92L, 0x1.82589994cce128acf88afap0L, 0xb.34a010f6ad65cbbac0f532d39be0p-92L, 0x1.8471a4623c7acce52f6b96p0L, 0x1.c64095370f51f48817914dd78665p-88L, 0x1.868d99b4492ec80e41d90ap0L, 0xc.251707484d73f136fb5779656b70p-92L, 0x1.88ac7d98a669966530bcdep0L, 0x1.2d4e9d61283ef385de170ab20f96p-88L, 0x1.8ace5422aa0db5ba7c55a0p0L, 0x1.92c9bb3e6ed61f2733304a346d8fp-88L, 0x1.8cf3216b5448bef2aa1cd0p0L, 0x1.61c55d84a9848f8c453b3ca8c946p-88L, 0x1.8f1ae991577362b982745cp0L, 0x7.2ed804efc9b4ae1458ae946099d4p-92L, 0x1.9145b0b91ffc588a61b468p0L, 0x1.f6b70e01c2a90229a4c4309ea719p-88L, 0x1.93737b0cdc5e4f4501c3f2p0L, 0x5.40a22d2fc4af581b63e8326efe9cp-92L, 0x1.95a44cbc8520ee9b483694p0L, 0x1.a0fc6f7c7d61b2b3a22a0eab2cadp-88L, 0x1.97d829fde4e4f8b9e920f8p0L, 0x1.1e8bd7edb9d7144b6f6818084cc7p-88L, 0x1.9a0f170ca07b9ba3109b8cp0L, 0x4.6737beb19e1eada6825d3c557428p-92L, 0x1.9c49182a3f0901c7c46b06p0L, 0x1.1f2be58ddade50c217186c90b457p-88L, 0x1.9e86319e323231824ca78ep0L, 0x6.4c6e010f92c082bbadfaf605cfd4p-92L, 0x1.a0c667b5de564b29ada8b8p0L, 0xc.ab349aa0422a8da7d4512edac548p-92L, 0x1.a309bec4a2d3358c171f76p0L, 0x1.0daad547fa22c26d168ea762d854p-88L, 0x1.a5503b23e255c8b424491cp0L, 0xa.f87bc8050a405381703ef7caff50p-92L, 0x1.a799e1330b3586f2dfb2b0p0L, 0x1.58f1a98796ce8908ae852236ca94p-88L, 0x1.a9e6b5579fdbf43eb243bcp0L, 0x1.ff4c4c58b571cf465caf07b4b9f5p-88L, 0x1.ac36bbfd3f379c0db966a2p0L, 0x1.1265fc73e480712d20f8597a8e7bp-88L, 0x1.ae89f995ad3ad5e8734d16p0L, 0x1.73205a7fbc3ae675ea440b162d6cp-88L, 0x1.b0e07298db66590842acdep0L, 0x1.c6f6ca0e5dcae2aafffa7a0554cbp-88L, 0x1.b33a2b84f15faf6bfd0e7ap0L, 0x1.d947c2575781dbb49b1237c87b6ep-88L, 0x1.b59728de559398e3881110p0L, 0x1.64873c7171fefc410416be0a6525p-88L, 0x1.b7f76f2fb5e46eaa7b081ap0L, 0xb.53c5354c8903c356e4b625aacc28p-92L, 0x1.ba5b030a10649840cb3c6ap0L, 0xf.5b47f297203757e1cc6eadc8bad0p-92L, 0x1.bcc1e904bc1d2247ba0f44p0L, 0x1.b3d08cd0b20287092bd59be4ad98p-88L, 0x1.bf2c25bd71e088408d7024p0L, 0x1.18e3449fa073b356766dfb568ff4p-88L, 0x1.c199bdd85529c2220cb12ap0L, 0x9.1ba6679444964a36661240043970p-96L, 0x1.c40ab5fffd07a6d14df820p0L, 0xf.1828a5366fd387a7bdd54cdf7300p-92L, 0x1.c67f12e57d14b4a2137fd2p0L, 0xf.2b301dd9e6b151a6d1f9d5d5f520p-96L, 0x1.c8f6d9406e7b511acbc488p0L, 0x5.c442ddb55820171f319d9e5076a8p-96L, 0x1.cb720dcef90691503cbd1ep0L, 0x9.49db761d9559ac0cb6dd3ed599e0p-92L, 0x1.cdf0b555dc3f9c44f8958ep0L, 0x1.ac51be515f8c58bdfb6f5740a3a4p-88L, 0x1.d072d4a07897b8d0f22f20p0L, 0x1.a158e18fbbfc625f09f4cca40874p-88L, 0x1.d2f87080d89f18ade12398p0L, 0x9.ea2025b4c56553f5cdee4c924728p-92L, 0x1.d5818dcfba48725da05aeap0L, 0x1.66e0dca9f589f559c0876ff23830p-88L, 0x1.d80e316c98397bb84f9d04p0L, 0x8.805f84bec614de269900ddf98d28p-92L, 0x1.da9e603db3285708c01a5ap0L, 0x1.6d4c97f6246f0ec614ec95c99392p-88L, 0x1.dd321f301b4604b695de3cp0L, 0x6.30a393215299e30d4fb73503c348p-96L, 0x1.dfc97337b9b5eb968cac38p0L, 0x1.ed291b7225a944efd5bb5524b927p-88L, 0x1.e264614f5a128a12761fa0p0L, 0x1.7ada6467e77f73bf65e04c95e29dp-88L, 0x1.e502ee78b3ff6273d13014p0L, 0x1.3991e8f49659e1693be17ae1d2f9p-88L, 0x1.e7a51fbc74c834b548b282p0L, 0x1.23786758a84f4956354634a416cep-88L, 0x1.ea4afa2a490d9858f73a18p0L, 0xf.5db301f86dea20610ceee13eb7b8p-92L, 0x1.ecf482d8e67f08db0312fap0L, 0x1.949cef462010bb4bc4ce72a900dfp-88L, 0x1.efa1bee615a27771fd21a8p0L, 0x1.2dac1f6dd5d229ff68e46f27e3dfp-88L, 0x1.f252b376bba974e8696fc2p0L, 0x1.6390d4c6ad5476b5162f40e1d9a9p-88L, 0x1.f50765b6e4540674f84b76p0L, 0x2.862baff99000dfc4352ba29b8908p-92L, 0x1.f7bfdad9cbe138913b4bfep0L, 0x7.2bd95c5ce7280fa4d2344a3f5618p-92L, 0x1.fa7c1819e90d82e90a7e74p0L, 0xb.263c1dc060c36f7650b4c0f233a8p-92L, 0x1.fd3c22b8f71f10975ba4b2p0L, 0x1.2bcf3a5e12d269d8ad7c1a4a8875p-88L }; /* * Kernel for expl(x). x must be finite and not tiny or huge. * "tiny" is anything that would make us underflow (|A6*x^6| < ~LDBL_MIN). * "huge" is anything that would make fn*L1 inexact (|x| > ~2**17*ln2). */ static inline void __k_expl(long double x, long double *hip, long double *lop, int *kp) { long double q, r, r1, t; double dr, fn, r2; int n, n2; /* Reduce x to (k*ln2 + endpoint[n2] + r1 + r2). */ /* Use a specialized rint() to get fn. Assume round-to-nearest. */ /* XXX assume no extra precision for the additions, as for trig fns. */ /* XXX this set of comments is now quadruplicated. */ /* XXX but see ../src/e_exp.c for a fix using double_t. */ fn = (double)x * INV_L + 0x1.8p52 - 0x1.8p52; #if defined(HAVE_EFFICIENT_IRINT) n = irint(fn); #else n = (int)fn; #endif n2 = (unsigned)n % INTERVALS; /* Depend on the sign bit being propagated: */ *kp = n >> LOG2_INTERVALS; r1 = x - fn * L1; r2 = fn * -L2; r = r1 + r2; /* Evaluate expl(endpoint[n2] + r1 + r2) = tbl[n2] * expl(r1 + r2). */ dr = r; q = r2 + r * r * (A2 + r * (A3 + r * (A4 + r * (A5 + r * (A6 + dr * (A7 + dr * (A8 + dr * (A9 + dr * A10)))))))); t = tbl[n2].lo + tbl[n2].hi; *hip = tbl[n2].hi; *lop = tbl[n2].lo + t * (q + r1); } /* * XXX: the rest of the functions are identical for ld80 and ld128. * However, we should use scalbnl() for ld128, since long double * multiplication is very slow on the only supported ld128 arch (sparc64). */ static inline void k_hexpl(long double x, long double *hip, long double *lop) { float twopkm1; int k; __k_expl(x, hip, lop, &k); SET_FLOAT_WORD(twopkm1, 0x3f800000 + ((k - 1) << 23)); *hip *= twopkm1; *lop *= twopkm1; } static inline long double hexpl(long double x) { long double hi, lo, twopkm2; int k; twopkm2 = 1; __k_expl(x, &hi, &lo, &k); SET_LDBL_EXPSIGN(twopkm2, BIAS + k - 2); return (lo + hi) * 2 * twopkm2; } #ifdef _COMPLEX_H /* * See ../src/k_exp.c for details. */ static inline long double complex __ldexp_cexpl(long double complex z, int expt) { long double exp_x, hi, lo; long double x, y, scale1, scale2; int half_expt, k; x = creall(z); y = cimagl(z); __k_expl(x, &hi, &lo, &k); exp_x = (lo + hi) * 0x1p16382; expt += k - 16382; scale1 = 1; half_expt = expt / 2; SET_LDBL_EXPSIGN(scale1, BIAS + half_expt); scale2 = 1; SET_LDBL_EXPSIGN(scale1, BIAS + expt - half_expt); - return (cpackl(cos(y) * exp_x * scale1 * scale2, + return (CMPLXL(cos(y) * exp_x * scale1 * scale2, sinl(y) * exp_x * scale1 * scale2)); } #endif /* _COMPLEX_H */ Index: stable/10/lib/msun/ld80/e_lgammal_r.c =================================================================== --- stable/10/lib/msun/ld80/e_lgammal_r.c (nonexistent) +++ stable/10/lib/msun/ld80/e_lgammal_r.c (revision 284810) @@ -0,0 +1,358 @@ +/* @(#)e_lgamma_r.c 1.3 95/01/18 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include +__FBSDID("$FreeBSD$"); + +/* + * See e_lgamma_r.c for complete comments. + * + * Converted to long double by Steven G. Kargl. + */ + +#ifdef __i386__ +#include +#endif + +#include "fpmath.h" +#include "math.h" +#include "math_private.h" + +static const volatile double vzero = 0; + +static const double +zero= 0, +half= 0.5, +one = 1; + +static const union IEEEl2bits +piu = LD80C(0xc90fdaa22168c235, 1, 3.14159265358979323851e+00L); +#define pi (piu.e) +/* + * Domain y in [0x1p-70, 0.27], range ~[-4.5264e-22, 4.5264e-22]: + * |(lgamma(2 - y) + y / 2) / y - a(y)| < 2**-70.9 + */ +static const union IEEEl2bits +a0u = LD80C(0x9e233f1bed863d26, -4, 7.72156649015328606028e-02L), +a1u = LD80C(0xa51a6625307d3249, -2, 3.22467033424113218889e-01L), +a2u = LD80C(0x89f000d2abafda8c, -4, 6.73523010531979398946e-02L), +a3u = LD80C(0xa8991563eca75f26, -6, 2.05808084277991211934e-02L), +a4u = LD80C(0xf2027e10634ce6b6, -8, 7.38555102796070454026e-03L), +a5u = LD80C(0xbd6eb76dd22187f4, -9, 2.89051035162703932972e-03L), +a6u = LD80C(0x9c562ab05e0458ed, -10, 1.19275351624639999297e-03L), +a7u = LD80C(0x859baed93ee48e46, -11, 5.09674593842117925320e-04L), +a8u = LD80C(0xe9f28a4432949af2, -13, 2.23109648015769155122e-04L), +a9u = LD80C(0xd12ad0d9b93c6bb0, -14, 9.97387167479808509830e-05L), +a10u= LD80C(0xb7522643c78a219b, -15, 4.37071076331030136818e-05L), +a11u= LD80C(0xca024dcdece2cb79, -16, 2.40813493372040143061e-05L), +a12u= LD80C(0xbb90fb6968ebdbf9, -19, 2.79495621083634031729e-06L), +a13u= LD80C(0xba1c9ffeeae07b37, -17, 1.10931287015513924136e-05L); +#define a0 (a0u.e) +#define a1 (a1u.e) +#define a2 (a2u.e) +#define a3 (a3u.e) +#define a4 (a4u.e) +#define a5 (a5u.e) +#define a6 (a6u.e) +#define a7 (a7u.e) +#define a8 (a8u.e) +#define a9 (a9u.e) +#define a10 (a10u.e) +#define a11 (a11u.e) +#define a12 (a12u.e) +#define a13 (a13u.e) +/* + * Domain x in [tc-0.24, tc+0.28], range ~[-6.1205e-22, 6.1205e-22]: + * |(lgamma(x) - tf) - t(x - tc)| < 2**-70.5 + */ +static const union IEEEl2bits +tcu = LD80C(0xbb16c31ab5f1fb71, 0, 1.46163214496836234128e+00L), +tfu = LD80C(0xf8cdcde61c520e0f, -4, -1.21486290535849608093e-01L), +ttu = LD80C(0xd46ee54b27d4de99, -69, -2.81152980996018785880e-21L), +t0u = LD80C(0x80b9406556a62a6b, -68, 3.40728634996055147231e-21L), +t1u = LD80C(0xc7e9c6f6df3f8c39, -67, -1.05833162742737073665e-20L), +t2u = LD80C(0xf7b95e4771c55d51, -2, 4.83836122723810583532e-01L), +t3u = LD80C(0x97213c6e35e119ff, -3, -1.47587722994530691476e-01L), +t4u = LD80C(0x845a14a6a81dc94b, -4, 6.46249402389135358063e-02L), +t5u = LD80C(0x864d46fa89997796, -5, -3.27885410884846056084e-02L), +t6u = LD80C(0x93373cbd00297438, -6, 1.79706751150707171293e-02L), +t7u = LD80C(0xa8fcfca7eddc8d1d, -7, -1.03142230361450732547e-02L), +t8u = LD80C(0xc7e7015ff4bc45af, -8, 6.10053603296546099193e-03L), +t9u = LD80C(0xf178d2247adc5093, -9, -3.68456964904901200152e-03L), +t10u = LD80C(0x94188d58f12e5e9f, -9, 2.25976420273774583089e-03L), +t11u = LD80C(0xb7cbaef14e1406f1, -10, -1.40224943666225639823e-03L), +t12u = LD80C(0xe63a671e6704ea4d, -11, 8.78250640744776944887e-04L), +t13u = LD80C(0x914b6c9cae61783e, -11, -5.54255012657716808811e-04L), +t14u = LD80C(0xb858f5bdb79276fe, -12, 3.51614951536825927370e-04L), +t15u = LD80C(0xea73e744c34b9591, -13, -2.23591563824520112236e-04L), +t16u = LD80C(0x99aeabb0d67ba835, -13, 1.46562869351659194136e-04L), +t17u = LD80C(0xd7c6938325db2024, -14, -1.02889866046435680588e-04L), +t18u = LD80C(0xe24cb1e3b0474775, -15, 5.39540265505221957652e-05L); +#define tc (tcu.e) +#define tf (tfu.e) +#define tt (ttu.e) +#define t0 (t0u.e) +#define t1 (t1u.e) +#define t2 (t2u.e) +#define t3 (t3u.e) +#define t4 (t4u.e) +#define t5 (t5u.e) +#define t6 (t6u.e) +#define t7 (t7u.e) +#define t8 (t8u.e) +#define t9 (t9u.e) +#define t10 (t10u.e) +#define t11 (t11u.e) +#define t12 (t12u.e) +#define t13 (t13u.e) +#define t14 (t14u.e) +#define t15 (t15u.e) +#define t16 (t16u.e) +#define t17 (t17u.e) +#define t18 (t18u.e) +/* + * Domain y in [-0.1, 0.232], range ~[-8.1938e-22, 8.3815e-22]: + * |(lgamma(1 + y) + 0.5 * y) / y - u(y) / v(y)| < 2**-71.2 + */ +static const union IEEEl2bits +u0u = LD80C(0x9e233f1bed863d27, -4, -7.72156649015328606095e-02L), +u1u = LD80C(0x98280ee45e4ddd3d, -1, 5.94361239198682739769e-01L), +u2u = LD80C(0xe330c8ead4130733, 0, 1.77492629495841234275e+00L), +u3u = LD80C(0xd4a213f1a002ec52, 0, 1.66119622514818078064e+00L), +u4u = LD80C(0xa5a9ca6f5bc62163, -1, 6.47122051417476492989e-01L), +u5u = LD80C(0xc980e49cd5b019e6, -4, 9.83903751718671509455e-02L), +u6u = LD80C(0xff636a8bdce7025b, -9, 3.89691687802305743450e-03L), +v1u = LD80C(0xbd109c533a19fbf5, 1, 2.95413883330948556544e+00L), +v2u = LD80C(0xd295cbf96f31f099, 1, 3.29039286955665403176e+00L), +v3u = LD80C(0xdab8bcfee40496cb, 0, 1.70876276441416471410e+00L), +v4u = LD80C(0xd2f2dc3638567e9f, -2, 4.12009126299534668571e-01L), +v5u = LD80C(0xa07d9b0851070f41, -5, 3.91822868305682491442e-02L), +v6u = LD80C(0xe3cd8318f7adb2c4, -11, 8.68998648222144351114e-04L); +#define u0 (u0u.e) +#define u1 (u1u.e) +#define u2 (u2u.e) +#define u3 (u3u.e) +#define u4 (u4u.e) +#define u5 (u5u.e) +#define u6 (u6u.e) +#define v1 (v1u.e) +#define v2 (v2u.e) +#define v3 (v3u.e) +#define v4 (v4u.e) +#define v5 (v5u.e) +#define v6 (v6u.e) +/* + * Domain x in (2, 3], range ~[-3.3648e-22, 3.4416e-22]: + * |(lgamma(y+2) - 0.5 * y) / y - s(y)/r(y)| < 2**-72.3 + * with y = x - 2. + */ +static const union IEEEl2bits +s0u = LD80C(0x9e233f1bed863d27, -4, -7.72156649015328606095e-02L), +s1u = LD80C(0xd3ff0dcc7fa91f94, -3, 2.07027640921219389860e-01L), +s2u = LD80C(0xb2bb62782478ef31, -2, 3.49085881391362090549e-01L), +s3u = LD80C(0xb49f7438c4611a74, -3, 1.76389518704213357954e-01L), +s4u = LD80C(0x9a957008fa27ecf9, -5, 3.77401710862930008071e-02L), +s5u = LD80C(0xda9b389a6ca7a7ac, -9, 3.33566791452943399399e-03L), +s6u = LD80C(0xbc7a2263faf59c14, -14, 8.98728786745638844395e-05L), +r1u = LD80C(0xbf5cff5b11477d4d, 0, 1.49502555796294337722e+00L), +r2u = LD80C(0xd9aec89de08e3da6, -1, 8.50323236984473285866e-01L), +r3u = LD80C(0xeab7ae5057c443f9, -3, 2.29216312078225806131e-01L), +r4u = LD80C(0xf29707d9bd2b1e37, -6, 2.96130326586640089145e-02L), +r5u = LD80C(0xd376c2f09736c5a3, -10, 1.61334161411590662495e-03L), +r6u = LD80C(0xc985983d0cd34e3d, -16, 2.40232770710953450636e-05L), +r7u = LD80C(0xe5c7a4f7fc2ef13d, -25, -5.34997929289167573510e-08L); +#define s0 (s0u.e) +#define s1 (s1u.e) +#define s2 (s2u.e) +#define s3 (s3u.e) +#define s4 (s4u.e) +#define s5 (s5u.e) +#define s6 (s6u.e) +#define r1 (r1u.e) +#define r2 (r2u.e) +#define r3 (r3u.e) +#define r4 (r4u.e) +#define r5 (r5u.e) +#define r6 (r6u.e) +#define r7 (r7u.e) +/* + * Domain z in [8, 0x1p70], range ~[-3.0235e-22, 3.0563e-22]: + * |lgamma(x) - (x - 0.5) * (log(x) - 1) - w(1/x)| < 2**-71.7 + */ +static const union IEEEl2bits +w0u = LD80C(0xd67f1c864beb4a69, -2, 4.18938533204672741776e-01L), +w1u = LD80C(0xaaaaaaaaaaaaaaa1, -4, 8.33333333333333332678e-02L), +w2u = LD80C(0xb60b60b60b5491c9, -9, -2.77777777777760927870e-03L), +w3u = LD80C(0xd00d00cf58aede4c, -11, 7.93650793490637233668e-04L), +w4u = LD80C(0x9c09bf626783d4a5, -11, -5.95238023926039051268e-04L), +w5u = LD80C(0xdca7cadc5baa517b, -11, 8.41733700408000822962e-04L), +w6u = LD80C(0xfb060e361e1ffd07, -10, -1.91515849570245136604e-03L), +w7u = LD80C(0xcbd5101bb58d1f2b, -8, 6.22046743903262649294e-03L), +w8u = LD80C(0xad27a668d32c821b, -6, -2.11370706734662081843e-02L); +#define w0 (w0u.e) +#define w1 (w1u.e) +#define w2 (w2u.e) +#define w3 (w3u.e) +#define w4 (w4u.e) +#define w5 (w5u.e) +#define w6 (w6u.e) +#define w7 (w7u.e) +#define w8 (w8u.e) + +static long double +sin_pil(long double x) +{ + volatile long double vz; + long double y,z; + uint64_t n; + uint16_t hx; + + y = -x; + + vz = y+0x1p63; + z = vz-0x1p63; + if (z == y) + return zero; + + vz = y+0x1p61; + EXTRACT_LDBL80_WORDS(hx,n,vz); + z = vz-0x1p61; + if (z > y) { + z -= 0.25; /* adjust to round down */ + n--; + } + n &= 7; /* octant of y mod 2 */ + y = y - z + n * 0.25; /* y mod 2 */ + + switch (n) { + case 0: y = __kernel_sinl(pi*y,zero,0); break; + case 1: + case 2: y = __kernel_cosl(pi*(0.5-y),zero); break; + case 3: + case 4: y = __kernel_sinl(pi*(one-y),zero,0); break; + case 5: + case 6: y = -__kernel_cosl(pi*(y-1.5),zero); break; + default: y = __kernel_sinl(pi*(y-2.0),zero,0); break; + } + return -y; +} + +long double +lgammal_r(long double x, int *signgamp) +{ + long double nadj,p,p1,p2,p3,q,r,t,w,y,z; + uint64_t lx; + int i; + uint16_t hx,ix; + + EXTRACT_LDBL80_WORDS(hx,lx,x); + + /* purge +-Inf and NaNs */ + *signgamp = 1; + ix = hx&0x7fff; + if(ix==0x7fff) return x*x; + + ENTERI(); + + /* purge +-0 and tiny arguments */ + *signgamp = 1-2*(hx>>15); + if(ix<0x3fff-67) { /* |x|<2**-(p+3), return -log(|x|) */ + if((ix|lx)==0) + RETURNI(one/vzero); + RETURNI(-logl(fabsl(x))); + } + + /* purge negative integers and start evaluation for other x < 0 */ + if(hx&0x8000) { + *signgamp = 1; + if(ix>=0x3fff+63) /* |x|>=2**(p-1), must be -integer */ + RETURNI(one/vzero); + t = sin_pil(x); + if(t==zero) RETURNI(one/vzero); /* -integer */ + nadj = logl(pi/fabsl(t*x)); + if(t=7.3159980773925781e-01) {y = 1-x; i= 0;} + else if(x>=2.3163998126983643e-01) {y= x-(tc-1); i=1;} + else {y = x; i=2;} + } else { + r = 0; + if(x>=1.7316312789916992e+00) {y=2-x;i=0;} + else if(x>=1.2316322326660156e+00) {y=x-tc;i=1;} + else {y=x-1;i=2;} + } + switch(i) { + case 0: + z = y*y; + p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*(a10+z*a12))))); + p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*(a11+z*a13)))))); + p = y*p1+p2; + r += p-y/2; break; + case 1: + p = t0+y*t1+tt+y*y*(t2+y*(t3+y*(t4+y*(t5+y*(t6+y*(t7+y*(t8+ + y*(t9+y*(t10+y*(t11+y*(t12+y*(t13+y*(t14+y*(t15+y*(t16+ + y*(t17+y*t18)))))))))))))))); + r += tf + p; break; + case 2: + p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*(u5+y*u6)))))); + p2 = 1+y*(v1+y*(v2+y*(v3+y*(v4+y*(v5+y*v6))))); + r += p1/p2-y/2; + } + } + /* x < 8.0 */ + else if(ix<0x4002) { + i = x; + y = x-i; + p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); + q = 1+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*(r6+y*r7)))))); + r = y/2+p/q; + z = 1; /* lgamma(1+s) = log(s) + lgamma(s) */ + switch(i) { + case 7: z *= (y+6); /* FALLTHRU */ + case 6: z *= (y+5); /* FALLTHRU */ + case 5: z *= (y+4); /* FALLTHRU */ + case 4: z *= (y+3); /* FALLTHRU */ + case 3: z *= (y+2); /* FALLTHRU */ + r += logl(z); break; + } + /* 8.0 <= x < 2**(p+3) */ + } else if (ix<0x3fff+67) { + t = logl(x); + z = one/x; + y = z*z; + w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*(w6+y*(w7+y*w8))))))); + r = (x-half)*(t-one)+w; + /* 2**(p+3) <= x <= inf */ + } else + r = x*(logl(x)-1); + if(hx&0x8000) r = nadj - r; + RETURNI(r); +} Property changes on: stable/10/lib/msun/ld80/e_lgammal_r.c ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: svn:keywords ## -0,0 +1 ## +FreeBSD=%H \ No newline at end of property Added: svn:mime-type ## -0,0 +1 ## +text/plain \ No newline at end of property Index: stable/10/lib/msun/ld80/k_expl.h =================================================================== --- stable/10/lib/msun/ld80/k_expl.h (revision 284809) +++ stable/10/lib/msun/ld80/k_expl.h (revision 284810) @@ -1,305 +1,305 @@ /* from: FreeBSD: head/lib/msun/ld80/s_expl.c 251343 2013-06-03 19:51:32Z kargl */ /*- * Copyright (c) 2009-2013 Steven G. Kargl * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. * * Optimized by Bruce D. Evans. */ #include __FBSDID("$FreeBSD$"); /* * See s_expl.c for more comments about __k_expl(). * * See ../src/e_exp.c and ../src/k_exp.h for precision-independent comments * about the secondary kernels. */ #define INTERVALS 128 #define LOG2_INTERVALS 7 #define BIAS (LDBL_MAX_EXP - 1) static const double /* * ln2/INTERVALS = L1+L2 (hi+lo decomposition for multiplication). L1 must * have at least 22 (= log2(|LDBL_MIN_EXP-extras|) + log2(INTERVALS)) lowest * bits zero so that multiplication of it by n is exact. */ INV_L = 1.8466496523378731e+2, /* 0x171547652b82fe.0p-45 */ L1 = 5.4152123484527692e-3, /* 0x162e42ff000000.0p-60 */ L2 = -3.2819649005320973e-13, /* -0x1718432a1b0e26.0p-94 */ /* * Domain [-0.002708, 0.002708], range ~[-5.7136e-24, 5.7110e-24]: * |exp(x) - p(x)| < 2**-77.2 * (0.002708 is ln2/(2*INTERVALS) rounded up a little). */ A2 = 0.5, A3 = 1.6666666666666119e-1, /* 0x15555555555490.0p-55 */ A4 = 4.1666666666665887e-2, /* 0x155555555554e5.0p-57 */ A5 = 8.3333354987869413e-3, /* 0x1111115b789919.0p-59 */ A6 = 1.3888891738560272e-3; /* 0x16c16c651633ae.0p-62 */ /* * 2^(i/INTERVALS) for i in [0,INTERVALS] is represented by two values where * the first 53 bits of the significand are stored in hi and the next 53 * bits are in lo. Tang's paper states that the trailing 6 bits of hi must * be zero for his algorithm in both single and double precision, because * the table is re-used in the implementation of expm1() where a floating * point addition involving hi must be exact. Here hi is double, so * converting it to long double gives 11 trailing zero bits. */ static const struct { double hi; double lo; } tbl[INTERVALS] = { 0x1p+0, 0x0p+0, /* * XXX hi is rounded down, and the formatting is not quite normal. * But I rather like both. The 0x1.*p format is good for 4N+1 * mantissa bits. Rounding down makes the lo terms positive, * so that the columnar formatting can be simpler. */ 0x1.0163da9fb3335p+0, 0x1.b61299ab8cdb7p-54, 0x1.02c9a3e778060p+0, 0x1.dcdef95949ef4p-53, 0x1.04315e86e7f84p+0, 0x1.7ae71f3441b49p-53, 0x1.059b0d3158574p+0, 0x1.d73e2a475b465p-55, 0x1.0706b29ddf6ddp+0, 0x1.8db880753b0f6p-53, 0x1.0874518759bc8p+0, 0x1.186be4bb284ffp-57, 0x1.09e3ecac6f383p+0, 0x1.1487818316136p-54, 0x1.0b5586cf9890fp+0, 0x1.8a62e4adc610bp-54, 0x1.0cc922b7247f7p+0, 0x1.01edc16e24f71p-54, 0x1.0e3ec32d3d1a2p+0, 0x1.03a1727c57b53p-59, 0x1.0fb66affed31ap+0, 0x1.e464123bb1428p-53, 0x1.11301d0125b50p+0, 0x1.49d77e35db263p-53, 0x1.12abdc06c31cbp+0, 0x1.f72575a649ad2p-53, 0x1.1429aaea92ddfp+0, 0x1.66820328764b1p-53, 0x1.15a98c8a58e51p+0, 0x1.2406ab9eeab0ap-55, 0x1.172b83c7d517ap+0, 0x1.b9bef918a1d63p-53, 0x1.18af9388c8de9p+0, 0x1.777ee1734784ap-53, 0x1.1a35beb6fcb75p+0, 0x1.e5b4c7b4968e4p-55, 0x1.1bbe084045cd3p+0, 0x1.3563ce56884fcp-53, 0x1.1d4873168b9aap+0, 0x1.e016e00a2643cp-54, 0x1.1ed5022fcd91cp+0, 0x1.71033fec2243ap-53, 0x1.2063b88628cd6p+0, 0x1.dc775814a8495p-55, 0x1.21f49917ddc96p+0, 0x1.2a97e9494a5eep-55, 0x1.2387a6e756238p+0, 0x1.9b07eb6c70573p-54, 0x1.251ce4fb2a63fp+0, 0x1.ac155bef4f4a4p-55, 0x1.26b4565e27cddp+0, 0x1.2bd339940e9d9p-55, 0x1.284dfe1f56380p+0, 0x1.2d9e2b9e07941p-53, 0x1.29e9df51fdee1p+0, 0x1.612e8afad1255p-55, 0x1.2b87fd0dad98fp+0, 0x1.fbbd48ca71f95p-53, 0x1.2d285a6e4030bp+0, 0x1.0024754db41d5p-54, 0x1.2ecafa93e2f56p+0, 0x1.1ca0f45d52383p-56, 0x1.306fe0a31b715p+0, 0x1.6f46ad23182e4p-55, 0x1.32170fc4cd831p+0, 0x1.a9ce78e18047cp-55, 0x1.33c08b26416ffp+0, 0x1.32721843659a6p-54, 0x1.356c55f929ff0p+0, 0x1.928c468ec6e76p-53, 0x1.371a7373aa9cap+0, 0x1.4e28aa05e8a8fp-53, 0x1.38cae6d05d865p+0, 0x1.0b53961b37da2p-53, 0x1.3a7db34e59ff6p+0, 0x1.d43792533c144p-53, 0x1.3c32dc313a8e4p+0, 0x1.08003e4516b1ep-53, 0x1.3dea64c123422p+0, 0x1.ada0911f09ebcp-55, 0x1.3fa4504ac801bp+0, 0x1.417ee03548306p-53, 0x1.4160a21f72e29p+0, 0x1.f0864b71e7b6cp-53, 0x1.431f5d950a896p+0, 0x1.b8e088728219ap-53, 0x1.44e086061892dp+0, 0x1.89b7a04ef80d0p-59, 0x1.46a41ed1d0057p+0, 0x1.c944bd1648a76p-54, 0x1.486a2b5c13cd0p+0, 0x1.3c1a3b69062f0p-56, 0x1.4a32af0d7d3dep+0, 0x1.9cb62f3d1be56p-54, 0x1.4bfdad5362a27p+0, 0x1.d4397afec42e2p-56, 0x1.4dcb299fddd0dp+0, 0x1.8ecdbbc6a7833p-54, 0x1.4f9b2769d2ca6p+0, 0x1.5a67b16d3540ep-53, 0x1.516daa2cf6641p+0, 0x1.8225ea5909b04p-53, 0x1.5342b569d4f81p+0, 0x1.be1507893b0d5p-53, 0x1.551a4ca5d920ep+0, 0x1.8a5d8c4048699p-53, 0x1.56f4736b527dap+0, 0x1.9bb2c011d93adp-54, 0x1.58d12d497c7fdp+0, 0x1.295e15b9a1de8p-55, 0x1.5ab07dd485429p+0, 0x1.6324c054647adp-54, 0x1.5c9268a5946b7p+0, 0x1.c4b1b816986a2p-60, 0x1.5e76f15ad2148p+0, 0x1.ba6f93080e65ep-54, 0x1.605e1b976dc08p+0, 0x1.60edeb25490dcp-53, 0x1.6247eb03a5584p+0, 0x1.63e1f40dfa5b5p-53, 0x1.6434634ccc31fp+0, 0x1.8edf0e2989db3p-53, 0x1.6623882552224p+0, 0x1.224fb3c5371e6p-53, 0x1.68155d44ca973p+0, 0x1.038ae44f73e65p-57, 0x1.6a09e667f3bccp+0, 0x1.21165f626cdd5p-53, 0x1.6c012750bdabep+0, 0x1.daed533001e9ep-53, 0x1.6dfb23c651a2ep+0, 0x1.e441c597c3775p-53, 0x1.6ff7df9519483p+0, 0x1.9f0fc369e7c42p-53, 0x1.71f75e8ec5f73p+0, 0x1.ba46e1e5de15ap-53, 0x1.73f9a48a58173p+0, 0x1.7ab9349cd1562p-53, 0x1.75feb564267c8p+0, 0x1.7edd354674916p-53, 0x1.780694fde5d3fp+0, 0x1.866b80a02162dp-54, 0x1.7a11473eb0186p+0, 0x1.afaa2047ed9b4p-53, 0x1.7c1ed0130c132p+0, 0x1.f124cd1164dd6p-54, 0x1.7e2f336cf4e62p+0, 0x1.05d02ba15797ep-56, 0x1.80427543e1a11p+0, 0x1.6c1bccec9346bp-53, 0x1.82589994cce12p+0, 0x1.159f115f56694p-53, 0x1.8471a4623c7acp+0, 0x1.9ca5ed72f8c81p-53, 0x1.868d99b4492ecp+0, 0x1.01c83b21584a3p-53, 0x1.88ac7d98a6699p+0, 0x1.994c2f37cb53ap-54, 0x1.8ace5422aa0dbp+0, 0x1.6e9f156864b27p-54, 0x1.8cf3216b5448bp+0, 0x1.de55439a2c38bp-53, 0x1.8f1ae99157736p+0, 0x1.5cc13a2e3976cp-55, 0x1.9145b0b91ffc5p+0, 0x1.114c368d3ed6ep-53, 0x1.93737b0cdc5e4p+0, 0x1.e8a0387e4a814p-53, 0x1.95a44cbc8520ep+0, 0x1.d36906d2b41f9p-53, 0x1.97d829fde4e4fp+0, 0x1.173d241f23d18p-53, 0x1.9a0f170ca07b9p+0, 0x1.7462137188ce7p-53, 0x1.9c49182a3f090p+0, 0x1.c7c46b071f2bep-56, 0x1.9e86319e32323p+0, 0x1.824ca78e64c6ep-56, 0x1.a0c667b5de564p+0, 0x1.6535b51719567p-53, 0x1.a309bec4a2d33p+0, 0x1.6305c7ddc36abp-54, 0x1.a5503b23e255cp+0, 0x1.1684892395f0fp-53, 0x1.a799e1330b358p+0, 0x1.bcb7ecac563c7p-54, 0x1.a9e6b5579fdbfp+0, 0x1.0fac90ef7fd31p-54, 0x1.ac36bbfd3f379p+0, 0x1.81b72cd4624ccp-53, 0x1.ae89f995ad3adp+0, 0x1.7a1cd345dcc81p-54, 0x1.b0e07298db665p+0, 0x1.2108559bf8deep-53, 0x1.b33a2b84f15fap+0, 0x1.ed7fa1cf7b290p-53, 0x1.b59728de55939p+0, 0x1.1c7102222c90ep-53, 0x1.b7f76f2fb5e46p+0, 0x1.d54f610356a79p-53, 0x1.ba5b030a10649p+0, 0x1.0819678d5eb69p-53, 0x1.bcc1e904bc1d2p+0, 0x1.23dd07a2d9e84p-55, 0x1.bf2c25bd71e08p+0, 0x1.0811ae04a31c7p-53, 0x1.c199bdd85529cp+0, 0x1.11065895048ddp-55, 0x1.c40ab5fffd07ap+0, 0x1.b4537e083c60ap-54, 0x1.c67f12e57d14bp+0, 0x1.2884dff483cadp-54, 0x1.c8f6d9406e7b5p+0, 0x1.1acbc48805c44p-56, 0x1.cb720dcef9069p+0, 0x1.503cbd1e949dbp-56, 0x1.cdf0b555dc3f9p+0, 0x1.889f12b1f58a3p-53, 0x1.d072d4a07897bp+0, 0x1.1a1e45e4342b2p-53, 0x1.d2f87080d89f1p+0, 0x1.15bc247313d44p-53, 0x1.d5818dcfba487p+0, 0x1.2ed02d75b3707p-55, 0x1.d80e316c98397p+0, 0x1.7709f3a09100cp-53, 0x1.da9e603db3285p+0, 0x1.c2300696db532p-54, 0x1.dd321f301b460p+0, 0x1.2da5778f018c3p-54, 0x1.dfc97337b9b5ep+0, 0x1.72d195873da52p-53, 0x1.e264614f5a128p+0, 0x1.424ec3f42f5b5p-53, 0x1.e502ee78b3ff6p+0, 0x1.39e8980a9cc8fp-55, 0x1.e7a51fbc74c83p+0, 0x1.2d522ca0c8de2p-54, 0x1.ea4afa2a490d9p+0, 0x1.0b1ee7431ebb6p-53, 0x1.ecf482d8e67f0p+0, 0x1.1b60625f7293ap-53, 0x1.efa1bee615a27p+0, 0x1.dc7f486a4b6b0p-54, 0x1.f252b376bba97p+0, 0x1.3a1a5bf0d8e43p-54, 0x1.f50765b6e4540p+0, 0x1.9d3e12dd8a18bp-54, 0x1.f7bfdad9cbe13p+0, 0x1.1227697fce57bp-53, 0x1.fa7c1819e90d8p+0, 0x1.74853f3a5931ep-55, 0x1.fd3c22b8f71f1p+0, 0x1.2eb74966579e7p-57 }; /* * Kernel for expl(x). x must be finite and not tiny or huge. * "tiny" is anything that would make us underflow (|A6*x^6| < ~LDBL_MIN). * "huge" is anything that would make fn*L1 inexact (|x| > ~2**17*ln2). */ static inline void __k_expl(long double x, long double *hip, long double *lop, int *kp) { long double fn, q, r, r1, r2, t, z; int n, n2; /* Reduce x to (k*ln2 + endpoint[n2] + r1 + r2). */ /* Use a specialized rint() to get fn. Assume round-to-nearest. */ fn = x * INV_L + 0x1.8p63 - 0x1.8p63; r = x - fn * L1 - fn * L2; /* r = r1 + r2 done independently. */ #if defined(HAVE_EFFICIENT_IRINTL) n = irintl(fn); #elif defined(HAVE_EFFICIENT_IRINT) n = irint(fn); #else n = (int)fn; #endif n2 = (unsigned)n % INTERVALS; /* Depend on the sign bit being propagated: */ *kp = n >> LOG2_INTERVALS; r1 = x - fn * L1; r2 = fn * -L2; /* Evaluate expl(endpoint[n2] + r1 + r2) = tbl[n2] * expl(r1 + r2). */ z = r * r; #if 0 q = r2 + z * (A2 + r * A3) + z * z * (A4 + r * A5) + z * z * z * A6; #else q = r2 + z * A2 + z * r * (A3 + r * A4 + z * (A5 + r * A6)); #endif t = (long double)tbl[n2].lo + tbl[n2].hi; *hip = tbl[n2].hi; *lop = tbl[n2].lo + t * (q + r1); } static inline void k_hexpl(long double x, long double *hip, long double *lop) { float twopkm1; int k; __k_expl(x, hip, lop, &k); SET_FLOAT_WORD(twopkm1, 0x3f800000 + ((k - 1) << 23)); *hip *= twopkm1; *lop *= twopkm1; } static inline long double hexpl(long double x) { long double hi, lo, twopkm2; int k; twopkm2 = 1; __k_expl(x, &hi, &lo, &k); SET_LDBL_EXPSIGN(twopkm2, BIAS + k - 2); return (lo + hi) * 2 * twopkm2; } #ifdef _COMPLEX_H /* * See ../src/k_exp.c for details. */ static inline long double complex __ldexp_cexpl(long double complex z, int expt) { long double exp_x, hi, lo; long double x, y, scale1, scale2; int half_expt, k; x = creall(z); y = cimagl(z); __k_expl(x, &hi, &lo, &k); exp_x = (lo + hi) * 0x1p16382; expt += k - 16382; scale1 = 1; half_expt = expt / 2; SET_LDBL_EXPSIGN(scale1, BIAS + half_expt); scale2 = 1; SET_LDBL_EXPSIGN(scale1, BIAS + expt - half_expt); - return (cpackl(cos(y) * exp_x * scale1 * scale2, + return (CMPLXL(cos(y) * exp_x * scale1 * scale2, sinl(y) * exp_x * scale1 * scale2)); } #endif /* _COMPLEX_H */ Index: stable/10/lib/msun/man/j0.3 =================================================================== --- stable/10/lib/msun/man/j0.3 (revision 284809) +++ stable/10/lib/msun/man/j0.3 (revision 284810) @@ -1,169 +1,164 @@ .\" Copyright (c) 1985, 1991 Regents of the University of California. .\" 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. .\" 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. .\" 4. Neither the name of the University nor the names of its contributors .\" may be used to endorse or promote products derived from this software .\" without specific prior written permission. .\" .\" THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``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 REGENTS OR CONTRIBUTORS 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. .\" .\" from: @(#)j0.3 6.7 (Berkeley) 4/19/91 .\" $FreeBSD$ .\" -.Dd February 18, 2008 +.Dd March 10, 2015 .Dt J0 3 .Os .Sh NAME .Nm j0 , .Nm j0f , .Nm j1 , .Nm j1f , .Nm jn , .Nm jnf , .Nm y0 , .Nm y0f , .Nm y1 , .Nm y1f , .Nm yn , .Nm ynf .Nd Bessel functions of first and second kind .Sh LIBRARY .Lb libm .Sh SYNOPSIS .In math.h .Ft double .Fn j0 "double x" .Ft float .Fn j0f "float x" .Ft double .Fn j1 "double x" .Ft float .Fn j1f "float x" .Ft double .Fn jn "int n" "double x" .Ft float .Fn jnf "int n" "float x" .Ft double .Fn y0 "double x" .Ft float .Fn y0f "float x" .Ft double .Fn y1 "double x" .Ft float .Fn y1f "float x" .Ft double .Fn yn "int n" "double x" .Ft float .Fn ynf "int n" "float x" .Sh DESCRIPTION The functions .Fn j0 , .Fn j0f , -.Fn j1 +.Fn j1 , and .Fn j1f -compute the -.Em Bessel function of the first kind of the order -0 and the -.Em order -1, respectively, -for the -real value +compute the Bessel function of the first kind of orders +0 and 1 for the real value .Fa x ; the functions .Fn jn and .Fn jnf -compute the -.Em Bessel function of the first kind of the integer -.Em order +compute the Bessel function of the first kind of the integer order .Fa n for the real value .Fa x . .Pp The functions .Fn y0 , .Fn y0f , .Fn y1 , and .Fn y1f -compute the linearly independent -.Em Bessel function of the second kind of the order -0 and the -.Em order -1, respectively, -for the -positive +compute the linearly independent Bessel function of the second kind +of orders 0 and 1 for the positive .Em real value .Fa x ; the functions .Fn yn and .Fn ynf -compute the -.Em Bessel function of the second kind for the integer -.Em order +compute the Bessel function of the second kind for the integer order .Fa n for the positive .Em real value .Fa x . .Sh RETURN VALUES These routines return values of their respective Bessel functions. For large positive inputs, they may underflow and return \*(Pm0. .Pp The following applies to .Fn y0 , .Fn y0f , .Fn y1 , .Fn y1f , .Fn yn , and .Fn ynf . If .Fa x -is negative, these routines will generate an invalid exception and -return \*(Na. +is negative, including -\*(If, these routines will generate an invalid +exception and return \*(Na. If .Fa x -is 0 or a sufficiently small positive number, these routines +is \*(Pm0, these routines +will generate a divide-by-zero exception and return -\*(If. +If +.Fa x +is a sufficiently small positive number, then +.Fn y1 , +.Fn y1f , +.Fn yn , +and +.Fn ynf will generate an overflow exception and return -\*(If. .Sh SEE ALSO .Xr math 3 .Sh STANDARDS The .Fn j0 , .Fn j1 , .Fn jn , .Fn y0 , .Fn y1 , and .Fn yn functions conform to .St -p1003.1-2001 . The .Ft float versions are extensions. .Sh HISTORY This set of functions appeared in .At v7 . Index: stable/10/lib/msun/man/lgamma.3 =================================================================== --- stable/10/lib/msun/man/lgamma.3 (revision 284809) +++ stable/10/lib/msun/man/lgamma.3 (revision 284810) @@ -1,189 +1,204 @@ .\" Copyright (c) 1985, 1991 Regents of the University of California. .\" 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. .\" 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. .\" 4. Neither the name of the University nor the names of its contributors .\" may be used to endorse or promote products derived from this software .\" without specific prior written permission. .\" .\" THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``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 REGENTS OR CONTRIBUTORS 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. .\" .\" from: @(#)lgamma.3 6.6 (Berkeley) 12/3/92 .\" $FreeBSD$ .\" -.Dd January 14, 2005 +.Dd September 12, 2014 .Dt LGAMMA 3 .Os .Sh NAME .Nm lgamma , .Nm lgamma_r , .Nm lgammaf , .Nm lgammaf_r , +.Nm lgammal , +.Nm lgammal_r , .Nm gamma , .Nm gamma_r , .Nm gammaf , .Nm gammaf_r , .Nm tgamma , .Nm tgammaf .Nd log gamma functions, gamma function .Sh LIBRARY .Lb libm .Sh SYNOPSIS .In math.h .Ft extern int .Fa signgam ; .sp .Ft double .Fn lgamma "double x" .Ft double .Fn lgamma_r "double x" "int *signgamp" .Ft float .Fn lgammaf "float x" .Ft float .Fn lgammaf_r "float x" "int *signgamp" +.Ft "long double" +.Fn lgammal "long double x" +.Ft "long double" +.Fn lgammal_r "long double x" "int *signgamp" .Ft double .Fn gamma "double x" .Ft double .Fn gamma_r "double x" "int *signgamp" .Ft float .Fn gammaf "float x" .Ft float .Fn gammaf_r "float x" "int *signgamp" -.Ft double +.Ft "long double" .Fn tgamma "double x" .Ft float .Fn tgammaf "float x" .Sh DESCRIPTION -.Fn lgamma x +.Fn lgamma x , +.Fn lgammaf x , and -.Fn lgammaf x +.Fn lgammal x .if t \{\ return ln\||\(*G(x)| where .Bd -unfilled -offset indent \(*G(x) = \(is\d\s8\z0\s10\u\u\s8\(if\s10\d t\u\s8x\-1\s10\d e\u\s8\-t\s10\d dt for x > 0 and \(*G(x) = \(*p/(\(*G(1\-x)\|sin(\(*px)) for x < 1. .Ed .\} .if n \ return ln\||\(*G(x)|. The external integer .Fa signgam returns the sign of \(*G(x). .Pp -.Fn lgamma_r x signgamp +.Fn lgamma_r x signgamp , +.Fn lgammaf_r x signgamp , and -.Fn lgammaf_r x signgamp +.Fn lgammal_r x signgamp provide the same functionality as -.Fn lgamma x +.Fn lgamma x , +.Fn lgammaf x , and -.Fn lgammaf x +.Fn lgammal x , but the caller must provide an integer to store the sign of \(*G(x). .Pp The .Fn tgamma x and .Fn tgammaf x functions return \(*G(x), with no effect on .Fa signgam . .Pp .Fn gamma , .Fn gammaf , .Fn gamma_r , and .Fn gammaf_r are deprecated aliases for .Fn lgamma , .Fn lgammaf , .Fn lgamma_r , and .Fn lgammaf_r , respectively. + .Sh IDIOSYNCRASIES Do not use the expression .Dq Li signgam\(**exp(lgamma(x)) to compute g := \(*G(x). Instead use a program like this (in C): .Bd -literal -offset indent lg = lgamma(x); g = signgam\(**exp(lg); .Ed .Pp Only after .Fn lgamma or .Fn lgammaf has returned can signgam be correct. .Pp For arguments in its range, .Fn tgamma is preferred, as for positive arguments it is accurate to within one unit in the last place. Exponentiation of .Fn lgamma will lose up to 10 significant bits. .Sh RETURN VALUES .Fn gamma , -.Fn gamma_r , .Fn gammaf , +.Fn gammal , +.Fn gamma_r , .Fn gammaf_r , +.Fn gammal_r , .Fn lgamma , -.Fn lgamma_r , .Fn lgammaf , +.Fn lgammal , +.Fn lgamma_r , +.Fn lgammaf_r , and -.Fn lgammaf_r +.Fn lgammal_r return appropriate values unless an argument is out of range. Overflow will occur for sufficiently large positive values, and non-positive integers. For large non-integer negative values, .Fn tgamma will underflow. .Sh SEE ALSO .Xr math 3 .Sh STANDARDS The .Fn lgamma , .Fn lgammaf , +.Fn lgammal , .Fn tgamma , and .Fn tgammaf functions are expected to conform to .St -isoC-99 . .Sh HISTORY The .Fn lgamma function appeared in .Bx 4.3 . The .Fn gamma function appeared in .Bx 4.4 as a function which computed \(*G(x). This version was used in .Fx 1.1 . The name .Fn gamma was originally dedicated to the .Fn lgamma function, and that usage was restored by switching to Sun's fdlibm in .Fx 1.1.5 . The .Fn tgamma function appeared in .Fx 5.0 . Index: stable/10/lib/msun/src/catrig.c =================================================================== --- stable/10/lib/msun/src/catrig.c (revision 284809) +++ stable/10/lib/msun/src/catrig.c (revision 284810) @@ -1,639 +1,639 @@ /*- * Copyright (c) 2012 Stephen Montgomery-Smith * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math.h" #include "math_private.h" #undef isinf #define isinf(x) (fabs(x) == INFINITY) #undef isnan #define isnan(x) ((x) != (x)) #define raise_inexact() do { volatile float junk = 1 + tiny; } while(0) #undef signbit #define signbit(x) (__builtin_signbit(x)) /* We need that DBL_EPSILON^2/128 is larger than FOUR_SQRT_MIN. */ static const double A_crossover = 10, /* Hull et al suggest 1.5, but 10 works better */ B_crossover = 0.6417, /* suggested by Hull et al */ FOUR_SQRT_MIN = 0x1p-509, /* >= 4 * sqrt(DBL_MIN) */ QUARTER_SQRT_MAX = 0x1p509, /* <= sqrt(DBL_MAX) / 4 */ m_e = 2.7182818284590452e0, /* 0x15bf0a8b145769.0p-51 */ m_ln2 = 6.9314718055994531e-1, /* 0x162e42fefa39ef.0p-53 */ pio2_hi = 1.5707963267948966e0, /* 0x1921fb54442d18.0p-52 */ RECIP_EPSILON = 1 / DBL_EPSILON, SQRT_3_EPSILON = 2.5809568279517849e-8, /* 0x1bb67ae8584caa.0p-78 */ SQRT_6_EPSILON = 3.6500241499888571e-8, /* 0x13988e1409212e.0p-77 */ SQRT_MIN = 0x1p-511; /* >= sqrt(DBL_MIN) */ static const volatile double pio2_lo = 6.1232339957367659e-17; /* 0x11a62633145c07.0p-106 */ static const volatile float tiny = 0x1p-100; static double complex clog_for_large_values(double complex z); /* * Testing indicates that all these functions are accurate up to 4 ULP. * The functions casin(h) and cacos(h) are about 2.5 times slower than asinh. * The functions catan(h) are a little under 2 times slower than atanh. * * The code for casinh, casin, cacos, and cacosh comes first. The code is * rather complicated, and the four functions are highly interdependent. * * The code for catanh and catan comes at the end. It is much simpler than * the other functions, and the code for these can be disconnected from the * rest of the code. */ /* * ================================ * | casinh, casin, cacos, cacosh | * ================================ */ /* * The algorithm is very close to that in "Implementing the complex arcsine * and arccosine functions using exception handling" by T. E. Hull, Thomas F. * Fairgrieve, and Ping Tak Peter Tang, published in ACM Transactions on * Mathematical Software, Volume 23 Issue 3, 1997, Pages 299-335, * http://dl.acm.org/citation.cfm?id=275324. * * Throughout we use the convention z = x + I*y. * * casinh(z) = sign(x)*log(A+sqrt(A*A-1)) + I*asin(B) * where * A = (|z+I| + |z-I|) / 2 * B = (|z+I| - |z-I|) / 2 = y/A * * These formulas become numerically unstable: * (a) for Re(casinh(z)) when z is close to the line segment [-I, I] (that * is, Re(casinh(z)) is close to 0); * (b) for Im(casinh(z)) when z is close to either of the intervals * [I, I*infinity) or (-I*infinity, -I] (that is, |Im(casinh(z))| is * close to PI/2). * * These numerical problems are overcome by defining * f(a, b) = (hypot(a, b) - b) / 2 = a*a / (hypot(a, b) + b) / 2 * Then if A < A_crossover, we use * log(A + sqrt(A*A-1)) = log1p((A-1) + sqrt((A-1)*(A+1))) * A-1 = f(x, 1+y) + f(x, 1-y) * and if B > B_crossover, we use * asin(B) = atan2(y, sqrt(A*A - y*y)) = atan2(y, sqrt((A+y)*(A-y))) * A-y = f(x, y+1) + f(x, y-1) * where without loss of generality we have assumed that x and y are * non-negative. * * Much of the difficulty comes because the intermediate computations may * produce overflows or underflows. This is dealt with in the paper by Hull * et al by using exception handling. We do this by detecting when * computations risk underflow or overflow. The hardest part is handling the * underflows when computing f(a, b). * * Note that the function f(a, b) does not appear explicitly in the paper by * Hull et al, but the idea may be found on pages 308 and 309. Introducing the * function f(a, b) allows us to concentrate many of the clever tricks in this * paper into one function. */ /* * Function f(a, b, hypot_a_b) = (hypot(a, b) - b) / 2. * Pass hypot(a, b) as the third argument. */ static inline double f(double a, double b, double hypot_a_b) { if (b < 0) return ((hypot_a_b - b) / 2); if (b == 0) return (a / 2); return (a * a / (hypot_a_b + b) / 2); } /* * All the hard work is contained in this function. * x and y are assumed positive or zero, and less than RECIP_EPSILON. * Upon return: * rx = Re(casinh(z)) = -Im(cacos(y + I*x)). * B_is_usable is set to 1 if the value of B is usable. * If B_is_usable is set to 0, sqrt_A2my2 = sqrt(A*A - y*y), and new_y = y. * If returning sqrt_A2my2 has potential to result in an underflow, it is * rescaled, and new_y is similarly rescaled. */ static inline void do_hard_work(double x, double y, double *rx, int *B_is_usable, double *B, double *sqrt_A2my2, double *new_y) { double R, S, A; /* A, B, R, and S are as in Hull et al. */ double Am1, Amy; /* A-1, A-y. */ R = hypot(x, y + 1); /* |z+I| */ S = hypot(x, y - 1); /* |z-I| */ /* A = (|z+I| + |z-I|) / 2 */ A = (R + S) / 2; /* * Mathematically A >= 1. There is a small chance that this will not * be so because of rounding errors. So we will make certain it is * so. */ if (A < 1) A = 1; if (A < A_crossover) { /* * Am1 = fp + fm, where fp = f(x, 1+y), and fm = f(x, 1-y). * rx = log1p(Am1 + sqrt(Am1*(A+1))) */ if (y == 1 && x < DBL_EPSILON * DBL_EPSILON / 128) { /* * fp is of order x^2, and fm = x/2. * A = 1 (inexactly). */ *rx = sqrt(x); } else if (x >= DBL_EPSILON * fabs(y - 1)) { /* * Underflow will not occur because * x >= DBL_EPSILON^2/128 >= FOUR_SQRT_MIN */ Am1 = f(x, 1 + y, R) + f(x, 1 - y, S); *rx = log1p(Am1 + sqrt(Am1 * (A + 1))); } else if (y < 1) { /* * fp = x*x/(1+y)/4, fm = x*x/(1-y)/4, and * A = 1 (inexactly). */ *rx = x / sqrt((1 - y) * (1 + y)); } else { /* if (y > 1) */ /* * A-1 = y-1 (inexactly). */ *rx = log1p((y - 1) + sqrt((y - 1) * (y + 1))); } } else { *rx = log(A + sqrt(A * A - 1)); } *new_y = y; if (y < FOUR_SQRT_MIN) { /* * Avoid a possible underflow caused by y/A. For casinh this * would be legitimate, but will be picked up by invoking atan2 * later on. For cacos this would not be legitimate. */ *B_is_usable = 0; *sqrt_A2my2 = A * (2 / DBL_EPSILON); *new_y = y * (2 / DBL_EPSILON); return; } /* B = (|z+I| - |z-I|) / 2 = y/A */ *B = y / A; *B_is_usable = 1; if (*B > B_crossover) { *B_is_usable = 0; /* * Amy = fp + fm, where fp = f(x, y+1), and fm = f(x, y-1). * sqrt_A2my2 = sqrt(Amy*(A+y)) */ if (y == 1 && x < DBL_EPSILON / 128) { /* * fp is of order x^2, and fm = x/2. * A = 1 (inexactly). */ *sqrt_A2my2 = sqrt(x) * sqrt((A + y) / 2); } else if (x >= DBL_EPSILON * fabs(y - 1)) { /* * Underflow will not occur because * x >= DBL_EPSILON/128 >= FOUR_SQRT_MIN * and * x >= DBL_EPSILON^2 >= FOUR_SQRT_MIN */ Amy = f(x, y + 1, R) + f(x, y - 1, S); *sqrt_A2my2 = sqrt(Amy * (A + y)); } else if (y > 1) { /* * fp = x*x/(y+1)/4, fm = x*x/(y-1)/4, and * A = y (inexactly). * * y < RECIP_EPSILON. So the following * scaling should avoid any underflow problems. */ *sqrt_A2my2 = x * (4 / DBL_EPSILON / DBL_EPSILON) * y / sqrt((y + 1) * (y - 1)); *new_y = y * (4 / DBL_EPSILON / DBL_EPSILON); } else { /* if (y < 1) */ /* * fm = 1-y >= DBL_EPSILON, fp is of order x^2, and * A = 1 (inexactly). */ *sqrt_A2my2 = sqrt((1 - y) * (1 + y)); } } } /* * casinh(z) = z + O(z^3) as z -> 0 * * casinh(z) = sign(x)*clog(sign(x)*z) + O(1/z^2) as z -> infinity * The above formula works for the imaginary part as well, because * Im(casinh(z)) = sign(x)*atan2(sign(x)*y, fabs(x)) + O(y/z^3) * as z -> infinity, uniformly in y */ double complex casinh(double complex z) { double x, y, ax, ay, rx, ry, B, sqrt_A2my2, new_y; int B_is_usable; double complex w; x = creal(z); y = cimag(z); ax = fabs(x); ay = fabs(y); if (isnan(x) || isnan(y)) { /* casinh(+-Inf + I*NaN) = +-Inf + I*NaN */ if (isinf(x)) - return (cpack(x, y + y)); + return (CMPLX(x, y + y)); /* casinh(NaN + I*+-Inf) = opt(+-)Inf + I*NaN */ if (isinf(y)) - return (cpack(y, x + x)); + return (CMPLX(y, x + x)); /* casinh(NaN + I*0) = NaN + I*0 */ if (y == 0) - return (cpack(x + x, y)); + return (CMPLX(x + x, y)); /* * All other cases involving NaN return NaN + I*NaN. * C99 leaves it optional whether to raise invalid if one of * the arguments is not NaN, so we opt not to raise it. */ - return (cpack(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); + return (CMPLX(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); } if (ax > RECIP_EPSILON || ay > RECIP_EPSILON) { /* clog...() will raise inexact unless x or y is infinite. */ if (signbit(x) == 0) w = clog_for_large_values(z) + m_ln2; else w = clog_for_large_values(-z) + m_ln2; - return (cpack(copysign(creal(w), x), copysign(cimag(w), y))); + return (CMPLX(copysign(creal(w), x), copysign(cimag(w), y))); } /* Avoid spuriously raising inexact for z = 0. */ if (x == 0 && y == 0) return (z); /* All remaining cases are inexact. */ raise_inexact(); if (ax < SQRT_6_EPSILON / 4 && ay < SQRT_6_EPSILON / 4) return (z); do_hard_work(ax, ay, &rx, &B_is_usable, &B, &sqrt_A2my2, &new_y); if (B_is_usable) ry = asin(B); else ry = atan2(new_y, sqrt_A2my2); - return (cpack(copysign(rx, x), copysign(ry, y))); + return (CMPLX(copysign(rx, x), copysign(ry, y))); } /* * casin(z) = reverse(casinh(reverse(z))) * where reverse(x + I*y) = y + I*x = I*conj(z). */ double complex casin(double complex z) { - double complex w = casinh(cpack(cimag(z), creal(z))); + double complex w = casinh(CMPLX(cimag(z), creal(z))); - return (cpack(cimag(w), creal(w))); + return (CMPLX(cimag(w), creal(w))); } /* * cacos(z) = PI/2 - casin(z) * but do the computation carefully so cacos(z) is accurate when z is * close to 1. * * cacos(z) = PI/2 - z + O(z^3) as z -> 0 * * cacos(z) = -sign(y)*I*clog(z) + O(1/z^2) as z -> infinity * The above formula works for the real part as well, because * Re(cacos(z)) = atan2(fabs(y), x) + O(y/z^3) * as z -> infinity, uniformly in y */ double complex cacos(double complex z) { double x, y, ax, ay, rx, ry, B, sqrt_A2mx2, new_x; int sx, sy; int B_is_usable; double complex w; x = creal(z); y = cimag(z); sx = signbit(x); sy = signbit(y); ax = fabs(x); ay = fabs(y); if (isnan(x) || isnan(y)) { /* cacos(+-Inf + I*NaN) = NaN + I*opt(-)Inf */ if (isinf(x)) - return (cpack(y + y, -INFINITY)); + return (CMPLX(y + y, -INFINITY)); /* cacos(NaN + I*+-Inf) = NaN + I*-+Inf */ if (isinf(y)) - return (cpack(x + x, -y)); + return (CMPLX(x + x, -y)); /* cacos(0 + I*NaN) = PI/2 + I*NaN with inexact */ if (x == 0) - return (cpack(pio2_hi + pio2_lo, y + y)); + return (CMPLX(pio2_hi + pio2_lo, y + y)); /* * All other cases involving NaN return NaN + I*NaN. * C99 leaves it optional whether to raise invalid if one of * the arguments is not NaN, so we opt not to raise it. */ - return (cpack(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); + return (CMPLX(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); } if (ax > RECIP_EPSILON || ay > RECIP_EPSILON) { /* clog...() will raise inexact unless x or y is infinite. */ w = clog_for_large_values(z); rx = fabs(cimag(w)); ry = creal(w) + m_ln2; if (sy == 0) ry = -ry; - return (cpack(rx, ry)); + return (CMPLX(rx, ry)); } /* Avoid spuriously raising inexact for z = 1. */ if (x == 1 && y == 0) - return (cpack(0, -y)); + return (CMPLX(0, -y)); /* All remaining cases are inexact. */ raise_inexact(); if (ax < SQRT_6_EPSILON / 4 && ay < SQRT_6_EPSILON / 4) - return (cpack(pio2_hi - (x - pio2_lo), -y)); + return (CMPLX(pio2_hi - (x - pio2_lo), -y)); do_hard_work(ay, ax, &ry, &B_is_usable, &B, &sqrt_A2mx2, &new_x); if (B_is_usable) { if (sx == 0) rx = acos(B); else rx = acos(-B); } else { if (sx == 0) rx = atan2(sqrt_A2mx2, new_x); else rx = atan2(sqrt_A2mx2, -new_x); } if (sy == 0) ry = -ry; - return (cpack(rx, ry)); + return (CMPLX(rx, ry)); } /* * cacosh(z) = I*cacos(z) or -I*cacos(z) * where the sign is chosen so Re(cacosh(z)) >= 0. */ double complex cacosh(double complex z) { double complex w; double rx, ry; w = cacos(z); rx = creal(w); ry = cimag(w); /* cacosh(NaN + I*NaN) = NaN + I*NaN */ if (isnan(rx) && isnan(ry)) - return (cpack(ry, rx)); + return (CMPLX(ry, rx)); /* cacosh(NaN + I*+-Inf) = +Inf + I*NaN */ /* cacosh(+-Inf + I*NaN) = +Inf + I*NaN */ if (isnan(rx)) - return (cpack(fabs(ry), rx)); + return (CMPLX(fabs(ry), rx)); /* cacosh(0 + I*NaN) = NaN + I*NaN */ if (isnan(ry)) - return (cpack(ry, ry)); - return (cpack(fabs(ry), copysign(rx, cimag(z)))); + return (CMPLX(ry, ry)); + return (CMPLX(fabs(ry), copysign(rx, cimag(z)))); } /* * Optimized version of clog() for |z| finite and larger than ~RECIP_EPSILON. */ static double complex clog_for_large_values(double complex z) { double x, y; double ax, ay, t; x = creal(z); y = cimag(z); ax = fabs(x); ay = fabs(y); if (ax < ay) { t = ax; ax = ay; ay = t; } /* * Avoid overflow in hypot() when x and y are both very large. * Divide x and y by E, and then add 1 to the logarithm. This depends * on E being larger than sqrt(2). * Dividing by E causes an insignificant loss of accuracy; however * this method is still poor since it is uneccessarily slow. */ if (ax > DBL_MAX / 2) - return (cpack(log(hypot(x / m_e, y / m_e)) + 1, atan2(y, x))); + return (CMPLX(log(hypot(x / m_e, y / m_e)) + 1, atan2(y, x))); /* * Avoid overflow when x or y is large. Avoid underflow when x or * y is small. */ if (ax > QUARTER_SQRT_MAX || ay < SQRT_MIN) - return (cpack(log(hypot(x, y)), atan2(y, x))); + return (CMPLX(log(hypot(x, y)), atan2(y, x))); - return (cpack(log(ax * ax + ay * ay) / 2, atan2(y, x))); + return (CMPLX(log(ax * ax + ay * ay) / 2, atan2(y, x))); } /* * ================= * | catanh, catan | * ================= */ /* * sum_squares(x,y) = x*x + y*y (or just x*x if y*y would underflow). * Assumes x*x and y*y will not overflow. * Assumes x and y are finite. * Assumes y is non-negative. * Assumes fabs(x) >= DBL_EPSILON. */ static inline double sum_squares(double x, double y) { /* Avoid underflow when y is small. */ if (y < SQRT_MIN) return (x * x); return (x * x + y * y); } /* * real_part_reciprocal(x, y) = Re(1/(x+I*y)) = x/(x*x + y*y). * Assumes x and y are not NaN, and one of x and y is larger than * RECIP_EPSILON. We avoid unwarranted underflow. It is important to not use * the code creal(1/z), because the imaginary part may produce an unwanted * underflow. * This is only called in a context where inexact is always raised before * the call, so no effort is made to avoid or force inexact. */ static inline double real_part_reciprocal(double x, double y) { double scale; uint32_t hx, hy; int32_t ix, iy; /* * This code is inspired by the C99 document n1124.pdf, Section G.5.1, * example 2. */ GET_HIGH_WORD(hx, x); ix = hx & 0x7ff00000; GET_HIGH_WORD(hy, y); iy = hy & 0x7ff00000; #define BIAS (DBL_MAX_EXP - 1) /* XXX more guard digits are useful iff there is extra precision. */ #define CUTOFF (DBL_MANT_DIG / 2 + 1) /* just half or 1 guard digit */ if (ix - iy >= CUTOFF << 20 || isinf(x)) return (1 / x); /* +-Inf -> +-0 is special */ if (iy - ix >= CUTOFF << 20) return (x / y / y); /* should avoid double div, but hard */ if (ix <= (BIAS + DBL_MAX_EXP / 2 - CUTOFF) << 20) return (x / (x * x + y * y)); scale = 1; SET_HIGH_WORD(scale, 0x7ff00000 - ix); /* 2**(1-ilogb(x)) */ x *= scale; y *= scale; return (x / (x * x + y * y) * scale); } /* * catanh(z) = log((1+z)/(1-z)) / 2 * = log1p(4*x / |z-1|^2) / 4 * + I * atan2(2*y, (1-x)*(1+x)-y*y) / 2 * * catanh(z) = z + O(z^3) as z -> 0 * * catanh(z) = 1/z + sign(y)*I*PI/2 + O(1/z^3) as z -> infinity * The above formula works for the real part as well, because * Re(catanh(z)) = x/|z|^2 + O(x/z^4) * as z -> infinity, uniformly in x */ double complex catanh(double complex z) { double x, y, ax, ay, rx, ry; x = creal(z); y = cimag(z); ax = fabs(x); ay = fabs(y); /* This helps handle many cases. */ if (y == 0 && ax <= 1) - return (cpack(atanh(x), y)); + return (CMPLX(atanh(x), y)); /* To ensure the same accuracy as atan(), and to filter out z = 0. */ if (x == 0) - return (cpack(x, atan(y))); + return (CMPLX(x, atan(y))); if (isnan(x) || isnan(y)) { /* catanh(+-Inf + I*NaN) = +-0 + I*NaN */ if (isinf(x)) - return (cpack(copysign(0, x), y + y)); + return (CMPLX(copysign(0, x), y + y)); /* catanh(NaN + I*+-Inf) = sign(NaN)0 + I*+-PI/2 */ if (isinf(y)) - return (cpack(copysign(0, x), + return (CMPLX(copysign(0, x), copysign(pio2_hi + pio2_lo, y))); /* * All other cases involving NaN return NaN + I*NaN. * C99 leaves it optional whether to raise invalid if one of * the arguments is not NaN, so we opt not to raise it. */ - return (cpack(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); + return (CMPLX(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); } if (ax > RECIP_EPSILON || ay > RECIP_EPSILON) - return (cpack(real_part_reciprocal(x, y), + return (CMPLX(real_part_reciprocal(x, y), copysign(pio2_hi + pio2_lo, y))); if (ax < SQRT_3_EPSILON / 2 && ay < SQRT_3_EPSILON / 2) { /* * z = 0 was filtered out above. All other cases must raise * inexact, but this is the only only that needs to do it * explicitly. */ raise_inexact(); return (z); } if (ax == 1 && ay < DBL_EPSILON) rx = (m_ln2 - log(ay)) / 2; else rx = log1p(4 * ax / sum_squares(ax - 1, ay)) / 4; if (ax == 1) ry = atan2(2, -ay) / 2; else if (ay < DBL_EPSILON) ry = atan2(2 * ay, (1 - ax) * (1 + ax)) / 2; else ry = atan2(2 * ay, (1 - ax) * (1 + ax) - ay * ay) / 2; - return (cpack(copysign(rx, x), copysign(ry, y))); + return (CMPLX(copysign(rx, x), copysign(ry, y))); } /* * catan(z) = reverse(catanh(reverse(z))) * where reverse(x + I*y) = y + I*x = I*conj(z). */ double complex catan(double complex z) { - double complex w = catanh(cpack(cimag(z), creal(z))); + double complex w = catanh(CMPLX(cimag(z), creal(z))); - return (cpack(cimag(w), creal(w))); + return (CMPLX(cimag(w), creal(w))); } Index: stable/10/lib/msun/src/catrigf.c =================================================================== --- stable/10/lib/msun/src/catrigf.c (revision 284809) +++ stable/10/lib/msun/src/catrigf.c (revision 284810) @@ -1,393 +1,393 @@ /*- * Copyright (c) 2012 Stephen Montgomery-Smith * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ /* * The algorithm is very close to that in "Implementing the complex arcsine * and arccosine functions using exception handling" by T. E. Hull, Thomas F. * Fairgrieve, and Ping Tak Peter Tang, published in ACM Transactions on * Mathematical Software, Volume 23 Issue 3, 1997, Pages 299-335, * http://dl.acm.org/citation.cfm?id=275324. * * See catrig.c for complete comments. * * XXX comments were removed automatically, and even short ones on the right * of statements were removed (all of them), contrary to normal style. Only * a few comments on the right of declarations remain. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math.h" #include "math_private.h" #undef isinf #define isinf(x) (fabsf(x) == INFINITY) #undef isnan #define isnan(x) ((x) != (x)) #define raise_inexact() do { volatile float junk = 1 + tiny; } while(0) #undef signbit #define signbit(x) (__builtin_signbitf(x)) static const float A_crossover = 10, B_crossover = 0.6417, FOUR_SQRT_MIN = 0x1p-61, QUARTER_SQRT_MAX = 0x1p61, m_e = 2.7182818285e0, /* 0xadf854.0p-22 */ m_ln2 = 6.9314718056e-1, /* 0xb17218.0p-24 */ pio2_hi = 1.5707962513e0, /* 0xc90fda.0p-23 */ RECIP_EPSILON = 1 / FLT_EPSILON, SQRT_3_EPSILON = 5.9801995673e-4, /* 0x9cc471.0p-34 */ SQRT_6_EPSILON = 8.4572793338e-4, /* 0xddb3d7.0p-34 */ SQRT_MIN = 0x1p-63; static const volatile float pio2_lo = 7.5497899549e-8, /* 0xa22169.0p-47 */ tiny = 0x1p-100; static float complex clog_for_large_values(float complex z); static inline float f(float a, float b, float hypot_a_b) { if (b < 0) return ((hypot_a_b - b) / 2); if (b == 0) return (a / 2); return (a * a / (hypot_a_b + b) / 2); } static inline void do_hard_work(float x, float y, float *rx, int *B_is_usable, float *B, float *sqrt_A2my2, float *new_y) { float R, S, A; float Am1, Amy; R = hypotf(x, y + 1); S = hypotf(x, y - 1); A = (R + S) / 2; if (A < 1) A = 1; if (A < A_crossover) { if (y == 1 && x < FLT_EPSILON * FLT_EPSILON / 128) { *rx = sqrtf(x); } else if (x >= FLT_EPSILON * fabsf(y - 1)) { Am1 = f(x, 1 + y, R) + f(x, 1 - y, S); *rx = log1pf(Am1 + sqrtf(Am1 * (A + 1))); } else if (y < 1) { *rx = x / sqrtf((1 - y) * (1 + y)); } else { *rx = log1pf((y - 1) + sqrtf((y - 1) * (y + 1))); } } else { *rx = logf(A + sqrtf(A * A - 1)); } *new_y = y; if (y < FOUR_SQRT_MIN) { *B_is_usable = 0; *sqrt_A2my2 = A * (2 / FLT_EPSILON); *new_y = y * (2 / FLT_EPSILON); return; } *B = y / A; *B_is_usable = 1; if (*B > B_crossover) { *B_is_usable = 0; if (y == 1 && x < FLT_EPSILON / 128) { *sqrt_A2my2 = sqrtf(x) * sqrtf((A + y) / 2); } else if (x >= FLT_EPSILON * fabsf(y - 1)) { Amy = f(x, y + 1, R) + f(x, y - 1, S); *sqrt_A2my2 = sqrtf(Amy * (A + y)); } else if (y > 1) { *sqrt_A2my2 = x * (4 / FLT_EPSILON / FLT_EPSILON) * y / sqrtf((y + 1) * (y - 1)); *new_y = y * (4 / FLT_EPSILON / FLT_EPSILON); } else { *sqrt_A2my2 = sqrtf((1 - y) * (1 + y)); } } } float complex casinhf(float complex z) { float x, y, ax, ay, rx, ry, B, sqrt_A2my2, new_y; int B_is_usable; float complex w; x = crealf(z); y = cimagf(z); ax = fabsf(x); ay = fabsf(y); if (isnan(x) || isnan(y)) { if (isinf(x)) - return (cpackf(x, y + y)); + return (CMPLXF(x, y + y)); if (isinf(y)) - return (cpackf(y, x + x)); + return (CMPLXF(y, x + x)); if (y == 0) - return (cpackf(x + x, y)); - return (cpackf(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); + return (CMPLXF(x + x, y)); + return (CMPLXF(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); } if (ax > RECIP_EPSILON || ay > RECIP_EPSILON) { if (signbit(x) == 0) w = clog_for_large_values(z) + m_ln2; else w = clog_for_large_values(-z) + m_ln2; - return (cpackf(copysignf(crealf(w), x), + return (CMPLXF(copysignf(crealf(w), x), copysignf(cimagf(w), y))); } if (x == 0 && y == 0) return (z); raise_inexact(); if (ax < SQRT_6_EPSILON / 4 && ay < SQRT_6_EPSILON / 4) return (z); do_hard_work(ax, ay, &rx, &B_is_usable, &B, &sqrt_A2my2, &new_y); if (B_is_usable) ry = asinf(B); else ry = atan2f(new_y, sqrt_A2my2); - return (cpackf(copysignf(rx, x), copysignf(ry, y))); + return (CMPLXF(copysignf(rx, x), copysignf(ry, y))); } float complex casinf(float complex z) { - float complex w = casinhf(cpackf(cimagf(z), crealf(z))); + float complex w = casinhf(CMPLXF(cimagf(z), crealf(z))); - return (cpackf(cimagf(w), crealf(w))); + return (CMPLXF(cimagf(w), crealf(w))); } float complex cacosf(float complex z) { float x, y, ax, ay, rx, ry, B, sqrt_A2mx2, new_x; int sx, sy; int B_is_usable; float complex w; x = crealf(z); y = cimagf(z); sx = signbit(x); sy = signbit(y); ax = fabsf(x); ay = fabsf(y); if (isnan(x) || isnan(y)) { if (isinf(x)) - return (cpackf(y + y, -INFINITY)); + return (CMPLXF(y + y, -INFINITY)); if (isinf(y)) - return (cpackf(x + x, -y)); + return (CMPLXF(x + x, -y)); if (x == 0) - return (cpackf(pio2_hi + pio2_lo, y + y)); - return (cpackf(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); + return (CMPLXF(pio2_hi + pio2_lo, y + y)); + return (CMPLXF(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); } if (ax > RECIP_EPSILON || ay > RECIP_EPSILON) { w = clog_for_large_values(z); rx = fabsf(cimagf(w)); ry = crealf(w) + m_ln2; if (sy == 0) ry = -ry; - return (cpackf(rx, ry)); + return (CMPLXF(rx, ry)); } if (x == 1 && y == 0) - return (cpackf(0, -y)); + return (CMPLXF(0, -y)); raise_inexact(); if (ax < SQRT_6_EPSILON / 4 && ay < SQRT_6_EPSILON / 4) - return (cpackf(pio2_hi - (x - pio2_lo), -y)); + return (CMPLXF(pio2_hi - (x - pio2_lo), -y)); do_hard_work(ay, ax, &ry, &B_is_usable, &B, &sqrt_A2mx2, &new_x); if (B_is_usable) { if (sx == 0) rx = acosf(B); else rx = acosf(-B); } else { if (sx == 0) rx = atan2f(sqrt_A2mx2, new_x); else rx = atan2f(sqrt_A2mx2, -new_x); } if (sy == 0) ry = -ry; - return (cpackf(rx, ry)); + return (CMPLXF(rx, ry)); } float complex cacoshf(float complex z) { float complex w; float rx, ry; w = cacosf(z); rx = crealf(w); ry = cimagf(w); if (isnan(rx) && isnan(ry)) - return (cpackf(ry, rx)); + return (CMPLXF(ry, rx)); if (isnan(rx)) - return (cpackf(fabsf(ry), rx)); + return (CMPLXF(fabsf(ry), rx)); if (isnan(ry)) - return (cpackf(ry, ry)); - return (cpackf(fabsf(ry), copysignf(rx, cimagf(z)))); + return (CMPLXF(ry, ry)); + return (CMPLXF(fabsf(ry), copysignf(rx, cimagf(z)))); } static float complex clog_for_large_values(float complex z) { float x, y; float ax, ay, t; x = crealf(z); y = cimagf(z); ax = fabsf(x); ay = fabsf(y); if (ax < ay) { t = ax; ax = ay; ay = t; } if (ax > FLT_MAX / 2) - return (cpackf(logf(hypotf(x / m_e, y / m_e)) + 1, + return (CMPLXF(logf(hypotf(x / m_e, y / m_e)) + 1, atan2f(y, x))); if (ax > QUARTER_SQRT_MAX || ay < SQRT_MIN) - return (cpackf(logf(hypotf(x, y)), atan2f(y, x))); + return (CMPLXF(logf(hypotf(x, y)), atan2f(y, x))); - return (cpackf(logf(ax * ax + ay * ay) / 2, atan2f(y, x))); + return (CMPLXF(logf(ax * ax + ay * ay) / 2, atan2f(y, x))); } static inline float sum_squares(float x, float y) { if (y < SQRT_MIN) return (x * x); return (x * x + y * y); } static inline float real_part_reciprocal(float x, float y) { float scale; uint32_t hx, hy; int32_t ix, iy; GET_FLOAT_WORD(hx, x); ix = hx & 0x7f800000; GET_FLOAT_WORD(hy, y); iy = hy & 0x7f800000; #define BIAS (FLT_MAX_EXP - 1) #define CUTOFF (FLT_MANT_DIG / 2 + 1) if (ix - iy >= CUTOFF << 23 || isinf(x)) return (1 / x); if (iy - ix >= CUTOFF << 23) return (x / y / y); if (ix <= (BIAS + FLT_MAX_EXP / 2 - CUTOFF) << 23) return (x / (x * x + y * y)); SET_FLOAT_WORD(scale, 0x7f800000 - ix); x *= scale; y *= scale; return (x / (x * x + y * y) * scale); } float complex catanhf(float complex z) { float x, y, ax, ay, rx, ry; x = crealf(z); y = cimagf(z); ax = fabsf(x); ay = fabsf(y); if (y == 0 && ax <= 1) - return (cpackf(atanhf(x), y)); + return (CMPLXF(atanhf(x), y)); if (x == 0) - return (cpackf(x, atanf(y))); + return (CMPLXF(x, atanf(y))); if (isnan(x) || isnan(y)) { if (isinf(x)) - return (cpackf(copysignf(0, x), y + y)); + return (CMPLXF(copysignf(0, x), y + y)); if (isinf(y)) - return (cpackf(copysignf(0, x), + return (CMPLXF(copysignf(0, x), copysignf(pio2_hi + pio2_lo, y))); - return (cpackf(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); + return (CMPLXF(x + 0.0L + (y + 0), x + 0.0L + (y + 0))); } if (ax > RECIP_EPSILON || ay > RECIP_EPSILON) - return (cpackf(real_part_reciprocal(x, y), + return (CMPLXF(real_part_reciprocal(x, y), copysignf(pio2_hi + pio2_lo, y))); if (ax < SQRT_3_EPSILON / 2 && ay < SQRT_3_EPSILON / 2) { raise_inexact(); return (z); } if (ax == 1 && ay < FLT_EPSILON) rx = (m_ln2 - logf(ay)) / 2; else rx = log1pf(4 * ax / sum_squares(ax - 1, ay)) / 4; if (ax == 1) ry = atan2f(2, -ay) / 2; else if (ay < FLT_EPSILON) ry = atan2f(2 * ay, (1 - ax) * (1 + ax)) / 2; else ry = atan2f(2 * ay, (1 - ax) * (1 + ax) - ay * ay) / 2; - return (cpackf(copysignf(rx, x), copysignf(ry, y))); + return (CMPLXF(copysignf(rx, x), copysignf(ry, y))); } float complex catanf(float complex z) { - float complex w = catanhf(cpackf(cimagf(z), crealf(z))); + float complex w = catanhf(CMPLXF(cimagf(z), crealf(z))); - return (cpackf(cimagf(w), crealf(w))); + return (CMPLXF(cimagf(w), crealf(w))); } Index: stable/10/lib/msun/src/e_j0.c =================================================================== --- stable/10/lib/msun/src/e_j0.c (revision 284809) +++ stable/10/lib/msun/src/e_j0.c (revision 284810) @@ -1,381 +1,391 @@ /* @(#)e_j0.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include __FBSDID("$FreeBSD$"); /* __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 __inline double pzero(double), qzero(double); +static const volatile double vone = 1, vzero = 0; + 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)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; + else return one - x*x/4; } } 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; + /* + * y0(NaN) = NaN. + * y0(Inf) = 0. + * y0(-Inf) = NaN and raise invalid exception. + */ + if(ix>=0x7ff00000) return vone/(x+x*x); + /* y0(+-0) = -inf and raise divide-by-zero exception. */ + if((ix|lx)==0) return -one/vzero; + /* y0(x<0) = NaN and raise invalid exception. */ + if(hx<0) return vzero/vzero; 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)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) +static __inline 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;} + else {p = pR2; q= pS2;} /* ix>=0x40000000 */ 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) +static __inline 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;} + else {p = qR2; q= qS2;} /* ix>=0x40000000 */ 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; } Index: stable/10/lib/msun/src/e_j0f.c =================================================================== --- stable/10/lib/msun/src/e_j0f.c (revision 284809) +++ stable/10/lib/msun/src/e_j0f.c (revision 284810) @@ -1,337 +1,344 @@ /* e_j0f.c -- float version of e_j0.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * 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. * ==================================================== */ #include __FBSDID("$FreeBSD$"); +/* + * See e_j0.c for complete comments. + */ + #include "math.h" #include "math_private.h" -static float pzerof(float), qzerof(float); +static __inline float pzerof(float), qzerof(float); +static const volatile float vone = 1, vzero = 0; + 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)0x80000000) z = (invsqrtpi*cc)/sqrtf(x); + if(ix>0x58000000) z = (invsqrtpi*cc)/sqrtf(x); /* |x|>2**49 */ else { u = pzerof(x); v = qzerof(x); z = invsqrtpi*(u*cc-v*ss)/sqrtf(x); } return z; } - if(ix<0x39000000) { /* |x| < 2**-13 */ + if(ix<0x3b000000) { /* |x| < 2**-9 */ 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; + if(ix<0x39800000) return one; /* |x|<2**-12 */ + else return one - x*x/4; } } 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>=0x7f800000) return vone/(x+x*x); + if(ix==0) return -one/vzero; + if(hx<0) return vzero/vzero; 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)0x80000000) z = (invsqrtpi*ss)/sqrtf(x); + if(ix>0x58000000) z = (invsqrtpi*ss)/sqrtf(x); /* |x|>2**49 */ else { u = pzerof(x); v = qzerof(x); z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); } return z; } - if(ix<=0x32000000) { /* x < 2**-27 */ + if(ix<=0x39000000) { /* x < 2**-13 */ 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) +static __inline 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;} + else if(ix>=0x409173eb){p = pR5; q= pS5;} + else if(ix>=0x4036d917){p = pR3; q= pS3;} + else {p = pR2; q= pS2;} /* ix>=0x40000000 */ 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) +static __inline 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;} + else if(ix>=0x409173eb){p = qR5; q= qS5;} + else if(ix>=0x4036d917){p = qR3; q= qS3;} + else {p = qR2; q= qS2;} /* ix>=0x40000000 */ 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; } Index: stable/10/lib/msun/src/e_j1.c =================================================================== --- stable/10/lib/msun/src/e_j1.c (revision 284809) +++ stable/10/lib/msun/src/e_j1.c (revision 284810) @@ -1,376 +1,386 @@ /* @(#)e_j1.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include __FBSDID("$FreeBSD$"); /* __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 __inline double pone(double), qone(double); +static const volatile double vone = 1, vzero = 0; + 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; + /* + * y1(NaN) = NaN. + * y1(Inf) = 0. + * y1(-Inf) = NaN and raise invalid exception. + */ + if(ix>=0x7ff00000) return vone/(x+x*x); + /* y1(+-0) = -inf and raise divide-by-zero exception. */ + if((ix|lx)==0) return -one/vzero; + /* y1(x<0) = NaN and raise invalid exception. */ + if(hx<0) return vzero/vzero; 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) +static __inline 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;} + else {p = pr2; q= ps2;} /* ix>=0x40000000 */ 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) +static __inline 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;} + else {p = qr2; q= qs2;} /* ix>=0x40000000 */ 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; } Index: stable/10/lib/msun/src/e_j1f.c =================================================================== --- stable/10/lib/msun/src/e_j1f.c (revision 284809) +++ stable/10/lib/msun/src/e_j1f.c (revision 284810) @@ -1,333 +1,340 @@ /* e_j1f.c -- float version of e_j1.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * 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. * ==================================================== */ #include __FBSDID("$FreeBSD$"); +/* + * See e_j1.c for complete comments. + */ + #include "math.h" #include "math_private.h" -static float ponef(float), qonef(float); +static __inline float ponef(float), qonef(float); +static const volatile float vone = 1, vzero = 0; + 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); + if(ix>0x58000000) z = (invsqrtpi*cc)/sqrtf(y); /* |x|>2**49 */ 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(ix<0x39000000) { /* |x|<2**-13 */ 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>=0x7f800000) return vone/(x+x*x); + if(ix==0) return -one/vzero; + if(hx<0) return vzero/vzero; 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); + if(ix>0x58000000) z = (invsqrtpi*ss)/sqrtf(x); /* |x|>2**49 */ else { u = ponef(x); v = qonef(x); z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); } return z; } - if(ix<=0x24800000) { /* x < 2**-54 */ + if(ix<=0x33000000) { /* x < 2**-25 */ 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) +static __inline 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;} + else if(ix>=0x409173eb){p = pr5; q= ps5;} + else if(ix>=0x4036d917){p = pr3; q= ps3;} + else {p = pr2; q= ps2;} /* ix>=0x40000000 */ 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) +static __inline 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;} + if(ix>=0x41000000) {p = qr8; q= qs8;} + else if(ix>=0x409173eb){p = qr5; q= qs5;} + else if(ix>=0x4036d917){p = qr3; q= qs3;} + else {p = qr2; q= qs2;} /* ix>=0x40000000 */ 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; } Index: stable/10/lib/msun/src/e_jn.c =================================================================== --- stable/10/lib/msun/src/e_jn.c (revision 284809) +++ stable/10/lib/msun/src/e_jn.c (revision 284810) @@ -1,270 +1,274 @@ /* @(#)e_jn.c 1.4 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== */ #include __FBSDID("$FreeBSD$"); /* * __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 nx, 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 volatile double vone = 1, vzero = 0; + 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;i33) /* 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; } } } z = __ieee754_j0(x); w = __ieee754_j1(x); if (fabs(z) >= fabs(w)) b = (t*z/b); else b = (t*w/a); } } 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 */ + /* yn(n,NaN) = 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; + /* yn(n,+-0) = -inf and raise divide-by-zero exception. */ + if((ix|lx)==0) return -one/vzero; + /* yn(n,x<0) = NaN and raise invalid exception. */ + if(hx<0) return vzero/vzero; 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;i0) return b; else return -b; } Index: stable/10/lib/msun/src/e_jnf.c =================================================================== --- stable/10/lib/msun/src/e_jnf.c (revision 284809) +++ stable/10/lib/msun/src/e_jnf.c (revision 284810) @@ -1,199 +1,204 @@ /* e_jnf.c -- float version of e_jn.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ /* * ==================================================== * 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. * ==================================================== */ #include __FBSDID("$FreeBSD$"); +/* + * See e_jn.c for complete comments. + */ + #include "math.h" #include "math_private.h" +static const volatile float vone = 1, vzero = 0; + static const float 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;i33) /* 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; } } } z = __ieee754_j0f(x); w = __ieee754_j1f(x); if (fabsf(z) >= fabsf(w)) b = (t*z/b); else b = (t*w/a); } } 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; + if(ix==0) return -one/vzero; + if(hx<0) return vzero/vzero; 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;i0) return b; else return -b; } Index: stable/10/lib/msun/src/e_lgamma.c =================================================================== --- stable/10/lib/msun/src/e_lgamma.c (revision 284809) +++ stable/10/lib/msun/src/e_lgamma.c (revision 284810) @@ -1,33 +1,39 @@ /* @(#)e_lgamma.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ #include __FBSDID("$FreeBSD$"); /* __ieee754_lgamma(x) * Return the logarithm of the Gamma function of x. * * Method: call __ieee754_lgamma_r */ +#include + #include "math.h" #include "math_private.h" extern int signgam; double __ieee754_lgamma(double x) { return __ieee754_lgamma_r(x,&signgam); } + +#if (LDBL_MANT_DIG == 53) +__weak_reference(lgamma, lgammal); +#endif Index: stable/10/lib/msun/src/e_lgamma_r.c =================================================================== --- stable/10/lib/msun/src/e_lgamma_r.c (revision 284809) +++ stable/10/lib/msun/src/e_lgamma_r.c (revision 284810) @@ -1,295 +1,303 @@ - /* @(#)e_lgamma_r.c 1.3 95/01/18 */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. * * Developed at SunSoft, a Sun Microsystems, Inc. business. * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice + * software is freely granted, provided that this notice * is preserved. * ==================================================== - * */ #include __FBSDID("$FreeBSD$"); /* __ieee754_lgamma_r(x, signgamp) - * Reentrant version of the logarithm of the Gamma function - * with user provide pointer for the sign of Gamma(x). + * 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 + * 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 + * 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 + * 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 + * 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(neg.integer) = inf and raise divide-by-zero * lgamma(inf) = inf * lgamma(-inf) = inf (bug for bug compatible with C99!?) - * */ +#include + #include "math.h" #include "math_private.h" static const volatile double vzero = 0; static const double zero= 0.00000000000000000000e+00, 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 */ /* * Compute sin(pi*x) without actually doing the pi*x multiplication. * sin_pi(x) is only called for x < 0 and |x| < 2**(p-1) where p is * the precision of x. */ static double sin_pi(double x) { volatile double vz; double y,z; int n; y = -x; vz = y+0x1p52; /* depend on 0 <= y < 0x1p52 */ z = vz-0x1p52; /* rint(y) for the above range */ if (z == y) return zero; vz = y+0x1p50; GET_LOW_WORD(n,vz); /* bits for rounded y (units 0.25) */ z = vz-0x1p50; /* y rounded to a multiple of 0.25 */ if (z > y) { z -= 0.25; /* adjust to round down */ n--; } n &= 7; /* octant of y mod 2 */ y = y - z + n * 0.25; /* y mod 2 */ switch (n) { case 0: y = __kernel_sin(pi*y,zero,0); break; - case 1: + case 1: case 2: y = __kernel_cos(pi*(0.5-y),zero); break; - case 3: + 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; + double nadj,p,p1,p2,p3,q,r,t,w,y,z; int32_t hx; int i,ix,lx; EXTRACT_WORDS(hx,lx,x); - /* purge off +-inf, NaN, +-0, tiny and negative arguments */ + /* purge +-Inf and NaNs */ *signgamp = 1; ix = hx&0x7fffffff; if(ix>=0x7ff00000) return x*x; - if((ix|lx)==0) return one/vzero; - if(ix<0x3b900000) { /* |x|<2**-70, return -log(|x|) */ - if(hx<0) { - *signgamp = -1; - return -__ieee754_log(-x); - } else return -__ieee754_log(x); + + /* purge +-0 and tiny arguments */ + *signgamp = 1-2*((uint32_t)hx>>31); + if(ix<0x3c700000) { /* |x|<2**-56, return -log(|x|) */ + if((ix|lx)==0) + return one/vzero; + return -__ieee754_log(fabs(x)); } + + /* purge negative integers and start evaluation for other x < 0 */ if(hx<0) { + *signgamp = 1; if(ix>=0x43300000) /* |x|>=2**52, must be -integer */ return one/vzero; t = sin_pi(x); if(t==zero) return one/vzero; /* -integer */ nadj = __ieee754_log(pi/fabs(t*x)); if(t=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; + r += p-y/2; 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: + 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); + r += p1/p2-y/2; } } - else if(ix<0x40200000) { /* x < 8.0 */ - i = (int)x; - y = x-(double)i; + /* x < 8.0 */ + else if(ix<0x40200000) { + i = x; + y = x-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; + r = y/2+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 */ + case 7: z *= (y+6); /* FALLTHRU */ + case 6: z *= (y+5); /* FALLTHRU */ + case 5: z *= (y+4); /* FALLTHRU */ + case 4: z *= (y+3); /* FALLTHRU */ + case 3: z *= (y+2); /* FALLTHRU */ r += __ieee754_log(z); break; } - /* 8.0 <= x < 2**58 */ - } else if (ix < 0x43900000) { + /* 8.0 <= x < 2**56 */ + } else if (ix < 0x43700000) { 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 */ + } else + /* 2**56 <= x <= inf */ r = x*(__ieee754_log(x)-one); if(hx<0) r = nadj - r; return r; } + +#if (LDBL_MANT_DIG == 53) +__weak_reference(lgamma_r, lgammal_r); +#endif Index: stable/10/lib/msun/src/e_lgammaf_r.c =================================================================== --- stable/10/lib/msun/src/e_lgammaf_r.c (revision 284809) +++ stable/10/lib/msun/src/e_lgammaf_r.c (revision 284810) @@ -1,223 +1,215 @@ /* e_lgammaf_r.c -- float version of e_lgamma_r.c. * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + * Conversion to float fixed By Steven G. Kargl. */ /* * ==================================================== * 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. * ==================================================== */ #include __FBSDID("$FreeBSD$"); #include "math.h" #include "math_private.h" static const volatile float vzero = 0; static const float -zero= 0.0000000000e+00, -half= 5.0000000000e-01, /* 0x3f000000 */ -one = 1.0000000000e+00, /* 0x3f800000 */ +zero= 0, +half= 0.5, +one = 1, 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 */ +/* + * Domain y in [0x1p-27, 0.27], range ~[-3.4599e-10, 3.4590e-10]: + * |(lgamma(2 - y) + 0.5 * y) / y - a(y)| < 2**-31.4 + */ +a0 = 7.72156641e-02, /* 0x3d9e233f */ +a1 = 3.22467119e-01, /* 0x3ea51a69 */ +a2 = 6.73484802e-02, /* 0x3d89ee00 */ +a3 = 2.06395667e-02, /* 0x3ca9144f */ +a4 = 6.98275631e-03, /* 0x3be4cf9b */ +a5 = 4.11768444e-03, /* 0x3b86eda4 */ +/* + * Domain x in [tc-0.24, tc+0.28], range ~[-5.6577e-10, 5.5677e-10]: + * |(lgamma(x) - tf) - t(x - tc)| < 2**-30.8. + */ +tc = 1.46163213e+00, /* 0x3fbb16c3 */ +tf = -1.21486291e-01, /* 0xbdf8cdce */ +t0 = -2.94064460e-11, /* 0xae0154b7 */ +t1 = -2.35939837e-08, /* 0xb2caabb8 */ +t2 = 4.83836412e-01, /* 0x3ef7b968 */ +t3 = -1.47586212e-01, /* 0xbe1720d7 */ +t4 = 6.46013096e-02, /* 0x3d844db1 */ +t5 = -3.28450352e-02, /* 0xbd068884 */ +t6 = 1.86483748e-02, /* 0x3c98c47a */ +t7 = -9.89206228e-03, /* 0xbc221251 */ +/* + * Domain y in [-0.1, 0.232], range ~[-8.4931e-10, 8.7794e-10]: + * |(lgamma(1 + y) + 0.5 * y) / y - u(y) / v(y)| < 2**-31.2 + */ +u0 = -7.72156641e-02, /* 0xbd9e233f */ +u1 = 7.36789703e-01, /* 0x3f3c9e40 */ +u2 = 4.95649040e-01, /* 0x3efdc5b6 */ +v1 = 1.10958421e+00, /* 0x3f8e06db */ +v2 = 2.10598111e-01, /* 0x3e57a708 */ +v3 = -1.02995494e-02, /* 0xbc28bf71 */ +/* + * Domain x in (2, 3], range ~[-5.5189e-11, 5.2317e-11]: + * |(lgamma(y+2) - 0.5 * y) / y - s(y)/r(y)| < 2**-35.0 + * with y = x - 2. + */ +s0 = -7.72156641e-02, /* 0xbd9e233f */ +s1 = 2.69987404e-01, /* 0x3e8a3bca */ +s2 = 1.42851010e-01, /* 0x3e124789 */ +s3 = 1.19389519e-02, /* 0x3c439b98 */ +r1 = 6.79650068e-01, /* 0x3f2dfd8c */ +r2 = 1.16058730e-01, /* 0x3dedb033 */ +r3 = 3.75673687e-03, /* 0x3b763396 */ +/* + * Domain z in [8, 0x1p24], range ~[-1.2640e-09, 1.2640e-09]: + * |lgamma(x) - (x - 0.5) * (log(x) - 1) - w(1/x)| < 2**-29.6. + */ +w0 = 4.18938547e-01, /* 0x3ed67f1d */ +w1 = 8.33332464e-02, /* 0x3daaaa9f */ +w2 = -2.76129087e-03; /* 0xbb34f6c6 */ static float sin_pif(float x) { volatile float vz; float y,z; int n; y = -x; vz = y+0x1p23F; /* depend on 0 <= y < 0x1p23 */ z = vz-0x1p23F; /* rintf(y) for the above range */ if (z == y) return zero; vz = y+0x1p21F; GET_FLOAT_WORD(n,vz); /* bits for rounded y (units 0.25) */ z = vz-0x1p21F; /* y rounded to a multiple of 0.25 */ if (z > y) { z -= 0.25F; /* adjust to round down */ n--; } n &= 7; /* octant of y mod 2 */ y = y - z + n * 0.25F; /* y mod 2 */ switch (n) { case 0: y = __kernel_sindf(pi*y); break; case 1: case 2: y = __kernel_cosdf(pi*((float)0.5-y)); break; case 3: case 4: y = __kernel_sindf(pi*(one-y)); break; case 5: case 6: y = -__kernel_cosdf(pi*(y-(float)1.5)); break; default: y = __kernel_sindf(pi*(y-(float)2.0)); break; } return -y; } float __ieee754_lgammaf_r(float x, int *signgamp) { - float t,y,z,nadj,p,p1,p2,p3,q,r,w; + float nadj,p,p1,p2,p3,q,r,t,w,y,z; int32_t hx; int i,ix; GET_FLOAT_WORD(hx,x); - /* purge off +-inf, NaN, +-0, tiny and negative arguments */ + /* purge +-Inf and NaNs */ *signgamp = 1; ix = hx&0x7fffffff; if(ix>=0x7f800000) return x*x; - if(ix==0) return one/vzero; - if(ix<0x35000000) { /* |x|<2**-21, return -log(|x|) */ - if(hx<0) { - *signgamp = -1; - return -__ieee754_logf(-x); - } else return -__ieee754_logf(x); + + /* purge +-0 and tiny arguments */ + *signgamp = 1-2*((uint32_t)hx>>31); + if(ix<0x32000000) { /* |x|<2**-27, return -log(|x|) */ + if(ix==0) + return one/vzero; + return -__ieee754_logf(fabsf(x)); } + + /* purge negative integers and start evaluation for other x < 0 */ if(hx<0) { - if(ix>=0x4b000000) /* |x|>=2**23, must be -integer */ + *signgamp = 1; + if(ix>=0x4b000000) /* |x|>=2**23, must be -integer */ return one/vzero; t = sin_pif(x); if(t==zero) return one/vzero; /* -integer */ nadj = __ieee754_logf(pi/fabsf(t*x)); if(t=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] */ + if(ix>=0x3fdda618) {y=2-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))))); + p1 = a0+z*(a2+z*a4); + p2 = z*(a1+z*(a3+z*a5)); p = y*p1+p2; - r += (p-(float)0.5*y); break; + r += p-y/2; 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; + p = t0+y*t1+y*y*(t2+y*(t3+y*(t4+y*(t5+y*(t6+y*t7))))); + 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); + p1 = y*(u0+y*(u1+y*u2)); + p2 = one+y*(v1+y*(v2+y*v3)); + r += p1/p2-y/2; } } - else if(ix<0x41000000) { /* x < 8.0 */ - i = (int)x; - 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; + /* x < 8.0 */ + else if(ix<0x41000000) { + i = x; + y = x-i; + p = y*(s0+y*(s1+y*(s2+y*s3))); + q = one+y*(r1+y*(r2+y*r3)); + r = y/2+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 */ + case 7: z *= (y+6); /* FALLTHRU */ + case 6: z *= (y+5); /* FALLTHRU */ + case 5: z *= (y+4); /* FALLTHRU */ + case 4: z *= (y+3); /* FALLTHRU */ + case 3: z *= (y+2); /* FALLTHRU */ r += __ieee754_logf(z); break; } - /* 8.0 <= x < 2**58 */ - } else if (ix < 0x5c800000) { + /* 8.0 <= x < 2**27 */ + } else if (ix < 0x4d000000) { t = __ieee754_logf(x); z = one/x; y = z*z; - w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); + w = w0+z*(w1+y*w2); r = (x-half)*(t-one)+w; } else - /* 2**58 <= x <= inf */ + /* 2**27 <= x <= inf */ r = x*(__ieee754_logf(x)-one); if(hx<0) r = nadj - r; return r; } Index: stable/10/lib/msun/src/e_lgammal.c =================================================================== --- stable/10/lib/msun/src/e_lgammal.c (nonexistent) +++ stable/10/lib/msun/src/e_lgammal.c (revision 284810) @@ -0,0 +1,25 @@ +/* @(#)e_lgamma.c 1.3 95/01/18 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include +__FBSDID("$FreeBSD$"); + +#include "math.h" +#include "math_private.h" + +extern int signgam; + +long double +lgammal(long double x) +{ + return lgammal_r(x,&signgam); +} Property changes on: stable/10/lib/msun/src/e_lgammal.c ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: svn:keywords ## -0,0 +1 ## +FreeBSD=%H \ No newline at end of property Added: svn:mime-type ## -0,0 +1 ## +text/plain \ No newline at end of property Index: stable/10/lib/msun/src/imprecise.c =================================================================== --- stable/10/lib/msun/src/imprecise.c (revision 284809) +++ stable/10/lib/msun/src/imprecise.c (revision 284810) @@ -1,64 +1,63 @@ /*- * Copyright (c) 2013 David Chisnall * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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$ */ #include #include /* * If long double is not the same size as double, then these will lose * precision and we should emit a warning whenever something links against * them. */ #if (LDBL_MANT_DIG > 53) #define WARN_IMPRECISE(x) \ __warn_references(x, # x " has lower than advertised precision"); #else #define WARN_IMPRECISE(x) #endif /* * Declare the functions as weak variants so that other libraries providing * real versions can override them. */ #define DECLARE_WEAK(x)\ __weak_reference(imprecise_## x, x);\ WARN_IMPRECISE(x) long double imprecise_powl(long double x, long double y) { return pow(x, y); } DECLARE_WEAK(powl); #define DECLARE_IMPRECISE(f) \ long double imprecise_ ## f ## l(long double v) { return f(v); }\ DECLARE_WEAK(f ## l) -DECLARE_IMPRECISE(lgamma); DECLARE_IMPRECISE(tgamma); Index: stable/10/lib/msun/src/k_exp.c =================================================================== --- stable/10/lib/msun/src/k_exp.c (revision 284809) +++ stable/10/lib/msun/src/k_exp.c (revision 284810) @@ -1,108 +1,108 @@ /*- * Copyright (c) 2011 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include "math.h" #include "math_private.h" static const uint32_t k = 1799; /* constant for reduction */ static const double kln2 = 1246.97177782734161156; /* k * ln2 */ /* * Compute exp(x), scaled to avoid spurious overflow. An exponent is * returned separately in 'expt'. * * Input: ln(DBL_MAX) <= x < ln(2 * DBL_MAX / DBL_MIN_DENORM) ~= 1454.91 * Output: 2**1023 <= y < 2**1024 */ static double __frexp_exp(double x, int *expt) { double exp_x; uint32_t hx; /* * We use exp(x) = exp(x - kln2) * 2**k, carefully chosen to * minimize |exp(kln2) - 2**k|. We also scale the exponent of * exp_x to MAX_EXP so that the result can be multiplied by * a tiny number without losing accuracy due to denormalization. */ exp_x = exp(x - kln2); GET_HIGH_WORD(hx, exp_x); *expt = (hx >> 20) - (0x3ff + 1023) + k; SET_HIGH_WORD(exp_x, (hx & 0xfffff) | ((0x3ff + 1023) << 20)); return (exp_x); } /* * __ldexp_exp(x, expt) and __ldexp_cexp(x, expt) compute exp(x) * 2**expt. * They are intended for large arguments (real part >= ln(DBL_MAX)) * where care is needed to avoid overflow. * * The present implementation is narrowly tailored for our hyperbolic and * exponential functions. We assume expt is small (0 or -1), and the caller * has filtered out very large x, for which overflow would be inevitable. */ double __ldexp_exp(double x, int expt) { double exp_x, scale; int ex_expt; exp_x = __frexp_exp(x, &ex_expt); expt += ex_expt; INSERT_WORDS(scale, (0x3ff + expt) << 20, 0); return (exp_x * scale); } double complex __ldexp_cexp(double complex z, int expt) { double x, y, exp_x, scale1, scale2; int ex_expt, half_expt; x = creal(z); y = cimag(z); exp_x = __frexp_exp(x, &ex_expt); expt += ex_expt; /* * Arrange so that scale1 * scale2 == 2**expt. We use this to * compensate for scalbn being horrendously slow. */ half_expt = expt / 2; INSERT_WORDS(scale1, (0x3ff + half_expt) << 20, 0); half_expt = expt - half_expt; INSERT_WORDS(scale2, (0x3ff + half_expt) << 20, 0); - return (cpack(cos(y) * exp_x * scale1 * scale2, + return (CMPLX(cos(y) * exp_x * scale1 * scale2, sin(y) * exp_x * scale1 * scale2)); } Index: stable/10/lib/msun/src/k_expf.c =================================================================== --- stable/10/lib/msun/src/k_expf.c (revision 284809) +++ stable/10/lib/msun/src/k_expf.c (revision 284810) @@ -1,87 +1,87 @@ /*- * Copyright (c) 2011 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include "math.h" #include "math_private.h" static const uint32_t k = 235; /* constant for reduction */ static const float kln2 = 162.88958740F; /* k * ln2 */ /* * See k_exp.c for details. * * Input: ln(FLT_MAX) <= x < ln(2 * FLT_MAX / FLT_MIN_DENORM) ~= 192.7 * Output: 2**127 <= y < 2**128 */ static float __frexp_expf(float x, int *expt) { float exp_x; uint32_t hx; exp_x = expf(x - kln2); GET_FLOAT_WORD(hx, exp_x); *expt = (hx >> 23) - (0x7f + 127) + k; SET_FLOAT_WORD(exp_x, (hx & 0x7fffff) | ((0x7f + 127) << 23)); return (exp_x); } float __ldexp_expf(float x, int expt) { float exp_x, scale; int ex_expt; exp_x = __frexp_expf(x, &ex_expt); expt += ex_expt; SET_FLOAT_WORD(scale, (0x7f + expt) << 23); return (exp_x * scale); } float complex __ldexp_cexpf(float complex z, int expt) { float x, y, exp_x, scale1, scale2; int ex_expt, half_expt; x = crealf(z); y = cimagf(z); exp_x = __frexp_expf(x, &ex_expt); expt += ex_expt; half_expt = expt / 2; SET_FLOAT_WORD(scale1, (0x7f + half_expt) << 23); half_expt = expt - half_expt; SET_FLOAT_WORD(scale2, (0x7f + half_expt) << 23); - return (cpackf(cosf(y) * exp_x * scale1 * scale2, + return (CMPLXF(cosf(y) * exp_x * scale1 * scale2, sinf(y) * exp_x * scale1 * scale2)); } Index: stable/10/lib/msun/src/math.h =================================================================== --- stable/10/lib/msun/src/math.h (revision 284809) +++ stable/10/lib/msun/src/math.h (revision 284810) @@ -1,507 +1,511 @@ /* * ==================================================== * 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. * ==================================================== */ /* * from: @(#)fdlibm.h 5.1 93/09/24 * $FreeBSD$ */ #ifndef _MATH_H_ #define _MATH_H_ #include #include #include /* * ANSI/POSIX */ extern const union __infinity_un { unsigned char __uc[8]; double __ud; } __infinity; extern const union __nan_un { unsigned char __uc[sizeof(float)]; float __uf; } __nan; #if __GNUC_PREREQ__(3, 3) || (defined(__INTEL_COMPILER) && __INTEL_COMPILER >= 800) #define __MATH_BUILTIN_CONSTANTS #endif #if __GNUC_PREREQ__(3, 0) && !defined(__INTEL_COMPILER) #define __MATH_BUILTIN_RELOPS #endif #ifdef __MATH_BUILTIN_CONSTANTS #define HUGE_VAL __builtin_huge_val() #else #define HUGE_VAL (__infinity.__ud) #endif #if __ISO_C_VISIBLE >= 1999 #define FP_ILOGB0 (-__INT_MAX) #define FP_ILOGBNAN __INT_MAX #ifdef __MATH_BUILTIN_CONSTANTS #define HUGE_VALF __builtin_huge_valf() #define HUGE_VALL __builtin_huge_vall() #define INFINITY __builtin_inff() #define NAN __builtin_nanf("") #else #define HUGE_VALF (float)HUGE_VAL #define HUGE_VALL (long double)HUGE_VAL #define INFINITY HUGE_VALF #define NAN (__nan.__uf) #endif /* __MATH_BUILTIN_CONSTANTS */ #define MATH_ERRNO 1 #define MATH_ERREXCEPT 2 #define math_errhandling MATH_ERREXCEPT #define FP_FAST_FMAF 1 #ifdef __ia64__ #define FP_FAST_FMA 1 #define FP_FAST_FMAL 1 #endif /* Symbolic constants to classify floating point numbers. */ #define FP_INFINITE 0x01 #define FP_NAN 0x02 #define FP_NORMAL 0x04 #define FP_SUBNORMAL 0x08 #define FP_ZERO 0x10 #if (__STDC_VERSION__ >= 201112L && defined(__clang__)) || \ __has_extension(c_generic_selections) #define __fp_type_select(x, f, d, ld) _Generic((x), \ float: f(x), \ double: d(x), \ long double: ld(x), \ volatile float: f(x), \ volatile double: d(x), \ volatile long double: ld(x), \ volatile const float: f(x), \ volatile const double: d(x), \ volatile const long double: ld(x), \ const float: f(x), \ const double: d(x), \ const long double: ld(x)) #elif __GNUC_PREREQ__(3, 1) && !defined(__cplusplus) #define __fp_type_select(x, f, d, ld) __builtin_choose_expr( \ __builtin_types_compatible_p(__typeof(x), long double), ld(x), \ __builtin_choose_expr( \ __builtin_types_compatible_p(__typeof(x), double), d(x), \ __builtin_choose_expr( \ __builtin_types_compatible_p(__typeof(x), float), f(x), (void)0))) #else #define __fp_type_select(x, f, d, ld) \ ((sizeof(x) == sizeof(float)) ? f(x) \ : (sizeof(x) == sizeof(double)) ? d(x) \ : ld(x)) #endif #define fpclassify(x) \ __fp_type_select(x, __fpclassifyf, __fpclassifyd, __fpclassifyl) #define isfinite(x) __fp_type_select(x, __isfinitef, __isfinite, __isfinitel) #define isinf(x) __fp_type_select(x, __isinff, __isinf, __isinfl) #define isnan(x) \ __fp_type_select(x, __inline_isnanf, __inline_isnan, __inline_isnanl) #define isnormal(x) __fp_type_select(x, __isnormalf, __isnormal, __isnormall) #ifdef __MATH_BUILTIN_RELOPS #define isgreater(x, y) __builtin_isgreater((x), (y)) #define isgreaterequal(x, y) __builtin_isgreaterequal((x), (y)) #define isless(x, y) __builtin_isless((x), (y)) #define islessequal(x, y) __builtin_islessequal((x), (y)) #define islessgreater(x, y) __builtin_islessgreater((x), (y)) #define isunordered(x, y) __builtin_isunordered((x), (y)) #else #define isgreater(x, y) (!isunordered((x), (y)) && (x) > (y)) #define isgreaterequal(x, y) (!isunordered((x), (y)) && (x) >= (y)) #define isless(x, y) (!isunordered((x), (y)) && (x) < (y)) #define islessequal(x, y) (!isunordered((x), (y)) && (x) <= (y)) #define islessgreater(x, y) (!isunordered((x), (y)) && \ ((x) > (y) || (y) > (x))) #define isunordered(x, y) (isnan(x) || isnan(y)) #endif /* __MATH_BUILTIN_RELOPS */ #define signbit(x) __fp_type_select(x, __signbitf, __signbit, __signbitl) typedef __double_t double_t; typedef __float_t float_t; #endif /* __ISO_C_VISIBLE >= 1999 */ /* * XOPEN/SVID */ #if __BSD_VISIBLE || __XSI_VISIBLE #define M_E 2.7182818284590452354 /* e */ #define M_LOG2E 1.4426950408889634074 /* log 2e */ #define M_LOG10E 0.43429448190325182765 /* log 10e */ #define M_LN2 0.69314718055994530942 /* log e2 */ #define M_LN10 2.30258509299404568402 /* log e10 */ #define M_PI 3.14159265358979323846 /* pi */ #define M_PI_2 1.57079632679489661923 /* pi/2 */ #define M_PI_4 0.78539816339744830962 /* pi/4 */ #define M_1_PI 0.31830988618379067154 /* 1/pi */ #define M_2_PI 0.63661977236758134308 /* 2/pi */ #define M_2_SQRTPI 1.12837916709551257390 /* 2/sqrt(pi) */ #define M_SQRT2 1.41421356237309504880 /* sqrt(2) */ #define M_SQRT1_2 0.70710678118654752440 /* 1/sqrt(2) */ #define MAXFLOAT ((float)3.40282346638528860e+38) extern int signgam; #endif /* __BSD_VISIBLE || __XSI_VISIBLE */ #if __BSD_VISIBLE #if 0 /* Old value from 4.4BSD-Lite math.h; this is probably better. */ #define HUGE HUGE_VAL #else #define HUGE MAXFLOAT #endif #endif /* __BSD_VISIBLE */ /* * Most of these functions depend on the rounding mode and have the side * effect of raising floating-point exceptions, so they are not declared * as __pure2. In C99, FENV_ACCESS affects the purity of these functions. */ __BEGIN_DECLS /* * ANSI/POSIX */ int __fpclassifyd(double) __pure2; int __fpclassifyf(float) __pure2; int __fpclassifyl(long double) __pure2; int __isfinitef(float) __pure2; int __isfinite(double) __pure2; int __isfinitel(long double) __pure2; int __isinff(float) __pure2; int __isinf(double) __pure2; int __isinfl(long double) __pure2; int __isnormalf(float) __pure2; int __isnormal(double) __pure2; int __isnormall(long double) __pure2; int __signbit(double) __pure2; int __signbitf(float) __pure2; int __signbitl(long double) __pure2; static __inline int __inline_isnan(__const double __x) { return (__x != __x); } static __inline int __inline_isnanf(__const float __x) { return (__x != __x); } static __inline int __inline_isnanl(__const long double __x) { return (__x != __x); } /* * Version 2 of the Single UNIX Specification (UNIX98) defined isnan() and * isinf() as functions taking double. C99, and the subsequent POSIX revisions * (SUSv3, POSIX.1-2001, define it as a macro that accepts any real floating * point type. If we are targeting SUSv2 and C99 or C11 (or C++11) then we * expose the newer definition, assuming that the language spec takes * precedence over the operating system interface spec. */ #if __XSI_VISIBLE > 0 && __XSI_VISIBLE < 600 && __ISO_C_VISIBLE < 1999 #undef isinf #undef isnan int isinf(double); int isnan(double); #endif double acos(double); double asin(double); double atan(double); double atan2(double, double); double cos(double); double sin(double); double tan(double); double cosh(double); double sinh(double); double tanh(double); double exp(double); double frexp(double, int *); /* fundamentally !__pure2 */ double ldexp(double, int); double log(double); double log10(double); double modf(double, double *); /* fundamentally !__pure2 */ double pow(double, double); double sqrt(double); double ceil(double); double fabs(double) __pure2; double floor(double); double fmod(double, double); /* * These functions are not in C90. */ #if __BSD_VISIBLE || __ISO_C_VISIBLE >= 1999 || __XSI_VISIBLE double acosh(double); double asinh(double); double atanh(double); double cbrt(double); double erf(double); double erfc(double); double exp2(double); double expm1(double); double fma(double, double, double); double hypot(double, double); int ilogb(double) __pure2; double lgamma(double); long long llrint(double); long long llround(double); double log1p(double); double log2(double); double logb(double); long lrint(double); long lround(double); double nan(const char *) __pure2; double nextafter(double, double); double remainder(double, double); double remquo(double, double, int *); double rint(double); #endif /* __BSD_VISIBLE || __ISO_C_VISIBLE >= 1999 || __XSI_VISIBLE */ #if __BSD_VISIBLE || __XSI_VISIBLE double j0(double); double j1(double); double jn(int, double); double y0(double); double y1(double); double yn(int, double); #if __XSI_VISIBLE <= 500 || __BSD_VISIBLE double gamma(double); #endif #if __XSI_VISIBLE <= 600 || __BSD_VISIBLE double scalb(double, double); #endif #endif /* __BSD_VISIBLE || __XSI_VISIBLE */ #if __BSD_VISIBLE || __ISO_C_VISIBLE >= 1999 double copysign(double, double) __pure2; double fdim(double, double); double fmax(double, double) __pure2; double fmin(double, double) __pure2; double nearbyint(double); double round(double); double scalbln(double, long); double scalbn(double, int); double tgamma(double); double trunc(double); #endif /* * BSD math library entry points */ #if __BSD_VISIBLE double drem(double, double); int finite(double) __pure2; int isnanf(float) __pure2; /* * Reentrant version of gamma & lgamma; passes signgam back by reference * as the second argument; user must allocate space for signgam. */ double gamma_r(double, int *); double lgamma_r(double, int *); /* * IEEE Test Vector */ double significand(double); #endif /* __BSD_VISIBLE */ /* float versions of ANSI/POSIX functions */ #if __ISO_C_VISIBLE >= 1999 float acosf(float); float asinf(float); float atanf(float); float atan2f(float, float); float cosf(float); float sinf(float); float tanf(float); float coshf(float); float sinhf(float); float tanhf(float); float exp2f(float); float expf(float); float expm1f(float); float frexpf(float, int *); /* fundamentally !__pure2 */ int ilogbf(float) __pure2; float ldexpf(float, int); float log10f(float); float log1pf(float); float log2f(float); float logf(float); float modff(float, float *); /* fundamentally !__pure2 */ float powf(float, float); float sqrtf(float); float ceilf(float); float fabsf(float) __pure2; float floorf(float); float fmodf(float, float); float roundf(float); float erff(float); float erfcf(float); float hypotf(float, float); float lgammaf(float); float tgammaf(float); float acoshf(float); float asinhf(float); float atanhf(float); float cbrtf(float); float logbf(float); float copysignf(float, float) __pure2; long long llrintf(float); long long llroundf(float); long lrintf(float); long lroundf(float); float nanf(const char *) __pure2; float nearbyintf(float); float nextafterf(float, float); float remainderf(float, float); float remquof(float, float, int *); float rintf(float); float scalblnf(float, long); float scalbnf(float, int); float truncf(float); float fdimf(float, float); float fmaf(float, float, float); float fmaxf(float, float) __pure2; float fminf(float, float) __pure2; #endif /* * float versions of BSD math library entry points */ #if __BSD_VISIBLE float dremf(float, float); int finitef(float) __pure2; float gammaf(float); float j0f(float); float j1f(float); float jnf(int, float); float scalbf(float, float); float y0f(float); float y1f(float); float ynf(int, float); /* * Float versions of reentrant version of gamma & lgamma; passes * signgam back by reference as the second argument; user must * allocate space for signgam. */ float gammaf_r(float, int *); float lgammaf_r(float, int *); /* * float version of IEEE Test Vector */ float significandf(float); #endif /* __BSD_VISIBLE */ /* * long double versions of ISO/POSIX math functions */ #if __ISO_C_VISIBLE >= 1999 long double acoshl(long double); long double acosl(long double); long double asinhl(long double); long double asinl(long double); long double atan2l(long double, long double); long double atanhl(long double); long double atanl(long double); long double cbrtl(long double); long double ceill(long double); long double copysignl(long double, long double) __pure2; long double coshl(long double); long double cosl(long double); long double erfcl(long double); long double erfl(long double); long double exp2l(long double); long double expl(long double); long double expm1l(long double); long double fabsl(long double) __pure2; long double fdiml(long double, long double); long double floorl(long double); long double fmal(long double, long double, long double); long double fmaxl(long double, long double) __pure2; long double fminl(long double, long double) __pure2; long double fmodl(long double, long double); long double frexpl(long double value, int *); /* fundamentally !__pure2 */ long double hypotl(long double, long double); int ilogbl(long double) __pure2; long double ldexpl(long double, int); long double lgammal(long double); long long llrintl(long double); long long llroundl(long double); long double log10l(long double); long double log1pl(long double); long double log2l(long double); long double logbl(long double); long double logl(long double); long lrintl(long double); long lroundl(long double); long double modfl(long double, long double *); /* fundamentally !__pure2 */ long double nanl(const char *) __pure2; long double nearbyintl(long double); long double nextafterl(long double, long double); double nexttoward(double, long double); float nexttowardf(float, long double); long double nexttowardl(long double, long double); long double powl(long double, long double); long double remainderl(long double, long double); long double remquol(long double, long double, int *); long double rintl(long double); long double roundl(long double); long double scalblnl(long double, long); long double scalbnl(long double, int); long double sinhl(long double); long double sinl(long double); long double sqrtl(long double); long double tanhl(long double); long double tanl(long double); long double tgammal(long double); long double truncl(long double); - #endif /* __ISO_C_VISIBLE >= 1999 */ + +#if __BSD_VISIBLE +long double lgammal_r(long double, int *); +#endif + __END_DECLS #endif /* !_MATH_H_ */ Index: stable/10/lib/msun/src/math_private.h =================================================================== --- stable/10/lib/msun/src/math_private.h (revision 284809) +++ stable/10/lib/msun/src/math_private.h (revision 284810) @@ -1,764 +1,776 @@ /* * ==================================================== * 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. * ==================================================== */ /* * from: @(#)fdlibm.h 5.1 93/09/24 * $FreeBSD$ */ #ifndef _MATH_PRIVATE_H_ #define _MATH_PRIVATE_H_ #include #include /* * The original fdlibm code used statements like: * n0 = ((*(int*)&one)>>29)^1; * index of high word * * ix0 = *(n0+(int*)&x); * high word of x * * ix1 = *((1-n0)+(int*)&x); * low word of x * * to dig two 32 bit words out of the 64 bit IEEE floating point * value. That is non-ANSI, and, moreover, the gcc instruction * scheduler gets it wrong. We instead use the following macros. * Unlike the original code, we determine the endianness at compile * time, not at run time; I don't see much benefit to selecting * endianness at run time. */ /* * A union which permits us to convert between a double and two 32 bit * ints. */ #ifdef __arm__ #if defined(__VFP_FP__) || defined(__ARM_EABI__) #define IEEE_WORD_ORDER BYTE_ORDER #else #define IEEE_WORD_ORDER BIG_ENDIAN #endif #else /* __arm__ */ #define IEEE_WORD_ORDER BYTE_ORDER #endif #if IEEE_WORD_ORDER == BIG_ENDIAN typedef union { double value; struct { u_int32_t msw; u_int32_t lsw; } parts; struct { u_int64_t w; } xparts; } ieee_double_shape_type; #endif #if IEEE_WORD_ORDER == LITTLE_ENDIAN typedef union { double value; struct { u_int32_t lsw; u_int32_t msw; } parts; struct { u_int64_t w; } xparts; } ieee_double_shape_type; #endif /* Get two 32 bit ints from a double. */ #define EXTRACT_WORDS(ix0,ix1,d) \ do { \ ieee_double_shape_type ew_u; \ ew_u.value = (d); \ (ix0) = ew_u.parts.msw; \ (ix1) = ew_u.parts.lsw; \ } while (0) /* Get a 64-bit int from a double. */ #define EXTRACT_WORD64(ix,d) \ do { \ ieee_double_shape_type ew_u; \ ew_u.value = (d); \ (ix) = ew_u.xparts.w; \ } while (0) /* Get the more significant 32 bit int from a double. */ #define GET_HIGH_WORD(i,d) \ do { \ ieee_double_shape_type gh_u; \ gh_u.value = (d); \ (i) = gh_u.parts.msw; \ } while (0) /* Get the less significant 32 bit int from a double. */ #define GET_LOW_WORD(i,d) \ do { \ ieee_double_shape_type gl_u; \ gl_u.value = (d); \ (i) = gl_u.parts.lsw; \ } while (0) /* Set a double from two 32 bit ints. */ #define INSERT_WORDS(d,ix0,ix1) \ do { \ ieee_double_shape_type iw_u; \ iw_u.parts.msw = (ix0); \ iw_u.parts.lsw = (ix1); \ (d) = iw_u.value; \ } while (0) /* Set a double from a 64-bit int. */ #define INSERT_WORD64(d,ix) \ do { \ ieee_double_shape_type iw_u; \ iw_u.xparts.w = (ix); \ (d) = iw_u.value; \ } while (0) /* Set the more significant 32 bits of a double from an int. */ #define SET_HIGH_WORD(d,v) \ do { \ ieee_double_shape_type sh_u; \ sh_u.value = (d); \ sh_u.parts.msw = (v); \ (d) = sh_u.value; \ } while (0) /* Set the less significant 32 bits of a double from an int. */ #define SET_LOW_WORD(d,v) \ do { \ ieee_double_shape_type sl_u; \ sl_u.value = (d); \ sl_u.parts.lsw = (v); \ (d) = sl_u.value; \ } while (0) /* * A union which permits us to convert between a float and a 32 bit * int. */ typedef union { float value; /* FIXME: Assumes 32 bit int. */ unsigned int word; } ieee_float_shape_type; /* Get a 32 bit int from a float. */ #define GET_FLOAT_WORD(i,d) \ do { \ ieee_float_shape_type gf_u; \ gf_u.value = (d); \ (i) = gf_u.word; \ } while (0) /* Set a float from a 32 bit int. */ #define SET_FLOAT_WORD(d,i) \ do { \ ieee_float_shape_type sf_u; \ sf_u.word = (i); \ (d) = sf_u.value; \ } while (0) /* * Get expsign and mantissa as 16 bit and 64 bit ints from an 80 bit long * double. */ #define EXTRACT_LDBL80_WORDS(ix0,ix1,d) \ do { \ union IEEEl2bits ew_u; \ ew_u.e = (d); \ (ix0) = ew_u.xbits.expsign; \ (ix1) = ew_u.xbits.man; \ } while (0) /* * Get expsign and mantissa as one 16 bit and two 64 bit ints from a 128 bit * long double. */ #define EXTRACT_LDBL128_WORDS(ix0,ix1,ix2,d) \ do { \ union IEEEl2bits ew_u; \ ew_u.e = (d); \ (ix0) = ew_u.xbits.expsign; \ (ix1) = ew_u.xbits.manh; \ (ix2) = ew_u.xbits.manl; \ } while (0) /* Get expsign as a 16 bit int from a long double. */ #define GET_LDBL_EXPSIGN(i,d) \ do { \ union IEEEl2bits ge_u; \ ge_u.e = (d); \ (i) = ge_u.xbits.expsign; \ } while (0) /* * Set an 80 bit long double from a 16 bit int expsign and a 64 bit int * mantissa. */ #define INSERT_LDBL80_WORDS(d,ix0,ix1) \ do { \ union IEEEl2bits iw_u; \ iw_u.xbits.expsign = (ix0); \ iw_u.xbits.man = (ix1); \ (d) = iw_u.e; \ } while (0) /* * Set a 128 bit long double from a 16 bit int expsign and two 64 bit ints * comprising the mantissa. */ #define INSERT_LDBL128_WORDS(d,ix0,ix1,ix2) \ do { \ union IEEEl2bits iw_u; \ iw_u.xbits.expsign = (ix0); \ iw_u.xbits.manh = (ix1); \ iw_u.xbits.manl = (ix2); \ (d) = iw_u.e; \ } while (0) /* Set expsign of a long double from a 16 bit int. */ #define SET_LDBL_EXPSIGN(d,v) \ do { \ union IEEEl2bits se_u; \ se_u.e = (d); \ se_u.xbits.expsign = (v); \ (d) = se_u.e; \ } while (0) #ifdef __i386__ /* Long double constants are broken on i386. */ #define LD80C(m, ex, v) { \ .xbits.man = __CONCAT(m, ULL), \ .xbits.expsign = (0x3fff + (ex)) | ((v) < 0 ? 0x8000 : 0), \ } #else /* The above works on non-i386 too, but we use this to check v. */ #define LD80C(m, ex, v) { .e = (v), } #endif #ifdef FLT_EVAL_METHOD /* * Attempt to get strict C99 semantics for assignment with non-C99 compilers. */ #if FLT_EVAL_METHOD == 0 || __GNUC__ == 0 #define STRICT_ASSIGN(type, lval, rval) ((lval) = (rval)) #else #define STRICT_ASSIGN(type, lval, rval) do { \ volatile type __lval; \ \ if (sizeof(type) >= sizeof(long double)) \ (lval) = (rval); \ else { \ __lval = (rval); \ (lval) = __lval; \ } \ } while (0) #endif #endif /* FLT_EVAL_METHOD */ /* Support switching the mode to FP_PE if necessary. */ #if defined(__i386__) && !defined(NO_FPSETPREC) #define ENTERI() \ long double __retval; \ fp_prec_t __oprec; \ \ if ((__oprec = fpgetprec()) != FP_PE) \ fpsetprec(FP_PE) #define RETURNI(x) do { \ __retval = (x); \ if (__oprec != FP_PE) \ fpsetprec(__oprec); \ RETURNF(__retval); \ } while (0) #else #define ENTERI(x) #define RETURNI(x) RETURNF(x) #endif /* Default return statement if hack*_t() is not used. */ #define RETURNF(v) return (v) /* * 2sum gives the same result as 2sumF without requiring |a| >= |b| or * a == 0, but is slower. */ #define _2sum(a, b) do { \ __typeof(a) __s, __w; \ \ __w = (a) + (b); \ __s = __w - (a); \ (b) = ((a) - (__w - __s)) + ((b) - __s); \ (a) = __w; \ } while (0) /* * 2sumF algorithm. * * "Normalize" the terms in the infinite-precision expression a + b for * the sum of 2 floating point values so that b is as small as possible * relative to 'a'. (The resulting 'a' is the value of the expression in * the same precision as 'a' and the resulting b is the rounding error.) * |a| must be >= |b| or 0, b's type must be no larger than 'a's type, and * exponent overflow or underflow must not occur. This uses a Theorem of * Dekker (1971). See Knuth (1981) 4.2.2 Theorem C. The name "TwoSum" * is apparently due to Skewchuk (1997). * * For this to always work, assignment of a + b to 'a' must not retain any * extra precision in a + b. This is required by C standards but broken * in many compilers. The brokenness cannot be worked around using * STRICT_ASSIGN() like we do elsewhere, since the efficiency of this * algorithm would be destroyed by non-null strict assignments. (The * compilers are correct to be broken -- the efficiency of all floating * point code calculations would be destroyed similarly if they forced the * conversions.) * * Fortunately, a case that works well can usually be arranged by building * any extra precision into the type of 'a' -- 'a' should have type float_t, * double_t or long double. b's type should be no larger than 'a's type. * Callers should use these types with scopes as large as possible, to * reduce their own extra-precision and efficiciency problems. In * particular, they shouldn't convert back and forth just to call here. */ #ifdef DEBUG #define _2sumF(a, b) do { \ __typeof(a) __w; \ volatile __typeof(a) __ia, __ib, __r, __vw; \ \ __ia = (a); \ __ib = (b); \ assert(__ia == 0 || fabsl(__ia) >= fabsl(__ib)); \ \ __w = (a) + (b); \ (b) = ((a) - __w) + (b); \ (a) = __w; \ \ /* The next 2 assertions are weak if (a) is already long double. */ \ assert((long double)__ia + __ib == (long double)(a) + (b)); \ __vw = __ia + __ib; \ __r = __ia - __vw; \ __r += __ib; \ assert(__vw == (a) && __r == (b)); \ } while (0) #else /* !DEBUG */ #define _2sumF(a, b) do { \ __typeof(a) __w; \ \ __w = (a) + (b); \ (b) = ((a) - __w) + (b); \ (a) = __w; \ } while (0) #endif /* DEBUG */ /* * Set x += c, where x is represented in extra precision as a + b. * x must be sufficiently normalized and sufficiently larger than c, * and the result is then sufficiently normalized. * * The details of ordering are that |a| must be >= |c| (so that (a, c) * can be normalized without extra work to swap 'a' with c). The details of * the normalization are that b must be small relative to the normalized 'a'. * Normalization of (a, c) makes the normalized c tiny relative to the * normalized a, so b remains small relative to 'a' in the result. However, * b need not ever be tiny relative to 'a'. For example, b might be about * 2**20 times smaller than 'a' to give about 20 extra bits of precision. * That is usually enough, and adding c (which by normalization is about * 2**53 times smaller than a) cannot change b significantly. However, * cancellation of 'a' with c in normalization of (a, c) may reduce 'a' * significantly relative to b. The caller must ensure that significant * cancellation doesn't occur, either by having c of the same sign as 'a', * or by having |c| a few percent smaller than |a|. Pre-normalization of * (a, b) may help. * * This is is a variant of an algorithm of Kahan (see Knuth (1981) 4.2.2 * exercise 19). We gain considerable efficiency by requiring the terms to * be sufficiently normalized and sufficiently increasing. */ #define _3sumF(a, b, c) do { \ __typeof(a) __tmp; \ \ __tmp = (c); \ _2sumF(__tmp, (a)); \ (b) += (a); \ (a) = __tmp; \ } while (0) /* * Common routine to process the arguments to nan(), nanf(), and nanl(). */ void _scan_nan(uint32_t *__words, int __num_words, const char *__s); #ifdef _COMPLEX_H /* * C99 specifies that complex numbers have the same representation as * an array of two elements, where the first element is the real part * and the second element is the imaginary part. */ typedef union { float complex f; float a[2]; } float_complex; typedef union { double complex f; double a[2]; } double_complex; typedef union { long double complex f; long double a[2]; } long_double_complex; #define REALPART(z) ((z).a[0]) #define IMAGPART(z) ((z).a[1]) /* * Inline functions that can be used to construct complex values. * * The C99 standard intends x+I*y to be used for this, but x+I*y is * currently unusable in general since gcc introduces many overflow, * underflow, sign and efficiency bugs by rewriting I*y as * (0.0+I)*(y+0.0*I) and laboriously computing the full complex product. * In particular, I*Inf is corrupted to NaN+I*Inf, and I*-0 is corrupted * to -0.0+I*0.0. + * + * The C11 standard introduced the macros CMPLX(), CMPLXF() and CMPLXL() + * to construct complex values. Compilers that conform to the C99 + * standard require the following functions to avoid the above issues. */ + +#ifndef CMPLXF static __inline float complex -cpackf(float x, float y) +CMPLXF(float x, float y) { float_complex z; REALPART(z) = x; IMAGPART(z) = y; return (z.f); } +#endif +#ifndef CMPLX static __inline double complex -cpack(double x, double y) +CMPLX(double x, double y) { double_complex z; REALPART(z) = x; IMAGPART(z) = y; return (z.f); } +#endif +#ifndef CMPLXL static __inline long double complex -cpackl(long double x, long double y) +CMPLXL(long double x, long double y) { long_double_complex z; REALPART(z) = x; IMAGPART(z) = y; return (z.f); } +#endif + #endif /* _COMPLEX_H */ #ifdef __GNUCLIKE_ASM /* Asm versions of some functions. */ #ifdef __amd64__ static __inline int irint(double x) { int n; asm("cvtsd2si %1,%0" : "=r" (n) : "x" (x)); return (n); } #define HAVE_EFFICIENT_IRINT #endif #ifdef __i386__ static __inline int irint(double x) { int n; asm("fistl %0" : "=m" (n) : "t" (x)); return (n); } #define HAVE_EFFICIENT_IRINT #endif #if defined(__amd64__) || defined(__i386__) static __inline int irintl(long double x) { int n; asm("fistl %0" : "=m" (n) : "t" (x)); return (n); } #define HAVE_EFFICIENT_IRINTL #endif #endif /* __GNUCLIKE_ASM */ #ifdef DEBUG #if defined(__amd64__) || defined(__i386__) #define breakpoint() asm("int $3") #else #include #define breakpoint() raise(SIGTRAP) #endif #endif /* Write a pari script to test things externally. */ #ifdef DOPRINT #include #ifndef DOPRINT_SWIZZLE #define DOPRINT_SWIZZLE 0 #endif #ifdef DOPRINT_LD80 #define DOPRINT_START(xp) do { \ uint64_t __lx; \ uint16_t __hx; \ \ /* Hack to give more-problematic args. */ \ EXTRACT_LDBL80_WORDS(__hx, __lx, *xp); \ __lx ^= DOPRINT_SWIZZLE; \ INSERT_LDBL80_WORDS(*xp, __hx, __lx); \ printf("x = %.21Lg; ", (long double)*xp); \ } while (0) #define DOPRINT_END1(v) \ printf("y = %.21Lg; z = 0; show(x, y, z);\n", (long double)(v)) #define DOPRINT_END2(hi, lo) \ printf("y = %.21Lg; z = %.21Lg; show(x, y, z);\n", \ (long double)(hi), (long double)(lo)) #elif defined(DOPRINT_D64) #define DOPRINT_START(xp) do { \ uint32_t __hx, __lx; \ \ EXTRACT_WORDS(__hx, __lx, *xp); \ __lx ^= DOPRINT_SWIZZLE; \ INSERT_WORDS(*xp, __hx, __lx); \ printf("x = %.21Lg; ", (long double)*xp); \ } while (0) #define DOPRINT_END1(v) \ printf("y = %.21Lg; z = 0; show(x, y, z);\n", (long double)(v)) #define DOPRINT_END2(hi, lo) \ printf("y = %.21Lg; z = %.21Lg; show(x, y, z);\n", \ (long double)(hi), (long double)(lo)) #elif defined(DOPRINT_F32) #define DOPRINT_START(xp) do { \ uint32_t __hx; \ \ GET_FLOAT_WORD(__hx, *xp); \ __hx ^= DOPRINT_SWIZZLE; \ SET_FLOAT_WORD(*xp, __hx); \ printf("x = %.21Lg; ", (long double)*xp); \ } while (0) #define DOPRINT_END1(v) \ printf("y = %.21Lg; z = 0; show(x, y, z);\n", (long double)(v)) #define DOPRINT_END2(hi, lo) \ printf("y = %.21Lg; z = %.21Lg; show(x, y, z);\n", \ (long double)(hi), (long double)(lo)) #else /* !DOPRINT_LD80 && !DOPRINT_D64 (LD128 only) */ #ifndef DOPRINT_SWIZZLE_HIGH #define DOPRINT_SWIZZLE_HIGH 0 #endif #define DOPRINT_START(xp) do { \ uint64_t __lx, __llx; \ uint16_t __hx; \ \ EXTRACT_LDBL128_WORDS(__hx, __lx, __llx, *xp); \ __llx ^= DOPRINT_SWIZZLE; \ __lx ^= DOPRINT_SWIZZLE_HIGH; \ INSERT_LDBL128_WORDS(*xp, __hx, __lx, __llx); \ printf("x = %.36Lg; ", (long double)*xp); \ } while (0) #define DOPRINT_END1(v) \ printf("y = %.36Lg; z = 0; show(x, y, z);\n", (long double)(v)) #define DOPRINT_END2(hi, lo) \ printf("y = %.36Lg; z = %.36Lg; show(x, y, z);\n", \ (long double)(hi), (long double)(lo)) #endif /* DOPRINT_LD80 */ #else /* !DOPRINT */ #define DOPRINT_START(xp) #define DOPRINT_END1(v) #define DOPRINT_END2(hi, lo) #endif /* DOPRINT */ #define RETURNP(x) do { \ DOPRINT_END1(x); \ RETURNF(x); \ } while (0) #define RETURNPI(x) do { \ DOPRINT_END1(x); \ RETURNI(x); \ } while (0) #define RETURN2P(x, y) do { \ DOPRINT_END2((x), (y)); \ RETURNF((x) + (y)); \ } while (0) #define RETURN2PI(x, y) do { \ DOPRINT_END2((x), (y)); \ RETURNI((x) + (y)); \ } while (0) #ifdef STRUCT_RETURN #define RETURNSP(rp) do { \ if (!(rp)->lo_set) \ RETURNP((rp)->hi); \ RETURN2P((rp)->hi, (rp)->lo); \ } while (0) #define RETURNSPI(rp) do { \ if (!(rp)->lo_set) \ RETURNPI((rp)->hi); \ RETURN2PI((rp)->hi, (rp)->lo); \ } while (0) #endif #define SUM2P(x, y) ({ \ const __typeof (x) __x = (x); \ const __typeof (y) __y = (y); \ \ DOPRINT_END2(__x, __y); \ __x + __y; \ }) /* * ieee style elementary functions * * We rename functions here to improve other sources' diffability * against fdlibm. */ #define __ieee754_sqrt sqrt #define __ieee754_acos acos #define __ieee754_acosh acosh #define __ieee754_log log #define __ieee754_log2 log2 #define __ieee754_atanh atanh #define __ieee754_asin asin #define __ieee754_atan2 atan2 #define __ieee754_exp exp #define __ieee754_cosh cosh #define __ieee754_fmod fmod #define __ieee754_pow pow #define __ieee754_lgamma lgamma #define __ieee754_gamma gamma #define __ieee754_lgamma_r lgamma_r #define __ieee754_gamma_r gamma_r #define __ieee754_log10 log10 #define __ieee754_sinh sinh #define __ieee754_hypot hypot #define __ieee754_j0 j0 #define __ieee754_j1 j1 #define __ieee754_y0 y0 #define __ieee754_y1 y1 #define __ieee754_jn jn #define __ieee754_yn yn #define __ieee754_remainder remainder #define __ieee754_scalb scalb #define __ieee754_sqrtf sqrtf #define __ieee754_acosf acosf #define __ieee754_acoshf acoshf #define __ieee754_logf logf #define __ieee754_atanhf atanhf #define __ieee754_asinf asinf #define __ieee754_atan2f atan2f #define __ieee754_expf expf #define __ieee754_coshf coshf #define __ieee754_fmodf fmodf #define __ieee754_powf powf #define __ieee754_lgammaf lgammaf #define __ieee754_gammaf gammaf #define __ieee754_lgammaf_r lgammaf_r #define __ieee754_gammaf_r gammaf_r #define __ieee754_log10f log10f #define __ieee754_log2f log2f #define __ieee754_sinhf sinhf #define __ieee754_hypotf hypotf #define __ieee754_j0f j0f #define __ieee754_j1f j1f #define __ieee754_y0f y0f #define __ieee754_y1f y1f #define __ieee754_jnf jnf #define __ieee754_ynf ynf #define __ieee754_remainderf remainderf #define __ieee754_scalbf scalbf /* fdlibm kernel function */ int __kernel_rem_pio2(double*,double*,int,int,int); /* double precision kernel functions */ #ifndef INLINE_REM_PIO2 int __ieee754_rem_pio2(double,double*); #endif double __kernel_sin(double,double,int); double __kernel_cos(double,double); double __kernel_tan(double,double,int); double __ldexp_exp(double,int); #ifdef _COMPLEX_H double complex __ldexp_cexp(double complex,int); #endif /* float precision kernel functions */ #ifndef INLINE_REM_PIO2F int __ieee754_rem_pio2f(float,double*); #endif #ifndef INLINE_KERNEL_SINDF float __kernel_sindf(double); #endif #ifndef INLINE_KERNEL_COSDF float __kernel_cosdf(double); #endif #ifndef INLINE_KERNEL_TANDF float __kernel_tandf(double,int); #endif float __ldexp_expf(float,int); #ifdef _COMPLEX_H float complex __ldexp_cexpf(float complex,int); #endif /* long double precision kernel functions */ long double __kernel_sinl(long double, long double, int); long double __kernel_cosl(long double, long double); long double __kernel_tanl(long double, long double, int); #endif /* !_MATH_PRIVATE_H_ */ Index: stable/10/lib/msun/src/s_ccosh.c =================================================================== --- stable/10/lib/msun/src/s_ccosh.c (revision 284809) +++ stable/10/lib/msun/src/s_ccosh.c (revision 284810) @@ -1,155 +1,156 @@ /*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. */ /* * Hyperbolic cosine of a complex argument z = x + i y. * * cosh(z) = cosh(x+iy) * = cosh(x) cos(y) + i sinh(x) sin(y). * * Exceptional values are noted in the comments within the source code. * These values and the return value were taken from n1124.pdf. + * The sign of the result for some exceptional values is unspecified but + * must satisfy both cosh(conj(z)) == conj(cosh(z)) and cosh(-z) == cosh(z). */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" static const double huge = 0x1p1023; double complex ccosh(double complex z) { double x, y, h; int32_t hx, hy, ix, iy, lx, ly; x = creal(z); y = cimag(z); EXTRACT_WORDS(hx, lx, x); EXTRACT_WORDS(hy, ly, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; /* Handle the nearly-non-exceptional cases where x and y are finite. */ if (ix < 0x7ff00000 && iy < 0x7ff00000) { if ((iy | ly) == 0) - return (cpack(cosh(x), x * y)); - if (ix < 0x40360000) /* small x: normal case */ - return (cpack(cosh(x) * cos(y), sinh(x) * sin(y))); + return (CMPLX(cosh(x), x * y)); + if (ix < 0x40360000) /* |x| < 22: normal case */ + return (CMPLX(cosh(x) * cos(y), sinh(x) * sin(y))); /* |x| >= 22, so cosh(x) ~= exp(|x|) */ if (ix < 0x40862e42) { /* x < 710: exp(|x|) won't overflow */ h = exp(fabs(x)) * 0.5; - return (cpack(h * cos(y), copysign(h, x) * sin(y))); + return (CMPLX(h * cos(y), copysign(h, x) * sin(y))); } else if (ix < 0x4096bbaa) { /* x < 1455: scale to avoid overflow */ - z = __ldexp_cexp(cpack(fabs(x), y), -1); - return (cpack(creal(z), cimag(z) * copysign(1, x))); + z = __ldexp_cexp(CMPLX(fabs(x), y), -1); + return (CMPLX(creal(z), cimag(z) * copysign(1, x))); } else { /* x >= 1455: the result always overflows */ h = huge * x; - return (cpack(h * h * cos(y), h * sin(y))); + return (CMPLX(h * h * cos(y), h * sin(y))); } } /* - * cosh(+-0 +- I Inf) = dNaN + I sign(d(+-0, dNaN))0. - * The sign of 0 in the result is unspecified. Choice = normally - * the same as dNaN. Raise the invalid floating-point exception. + * cosh(+-0 +- I Inf) = dNaN + I (+-)(+-)0. + * The sign of 0 in the result is unspecified. Choice = product + * of the signs of the argument. Raise the invalid floating-point + * exception. * - * cosh(+-0 +- I NaN) = d(NaN) + I sign(d(+-0, NaN))0. - * The sign of 0 in the result is unspecified. Choice = normally - * the same as d(NaN). + * cosh(+-0 +- I NaN) = d(NaN) + I (+-)(+-)0. + * The sign of 0 in the result is unspecified. Choice = product + * of the signs of the argument. */ - if ((ix | lx) == 0 && iy >= 0x7ff00000) - return (cpack(y - y, copysign(0, x * (y - y)))); + if ((ix | lx) == 0) /* && iy >= 0x7ff00000 */ + return (CMPLX(y - y, x * copysign(0, y))); /* * cosh(+-Inf +- I 0) = +Inf + I (+-)(+-)0. * - * cosh(NaN +- I 0) = d(NaN) + I sign(d(NaN, +-0))0. - * The sign of 0 in the result is unspecified. + * cosh(NaN +- I 0) = d(NaN) + I (+-)(+-)0. + * The sign of 0 in the result is unspecified. Choice = product + * of the signs of the argument. */ - if ((iy | ly) == 0 && ix >= 0x7ff00000) { - if (((hx & 0xfffff) | lx) == 0) - return (cpack(x * x, copysign(0, x) * y)); - return (cpack(x * x, copysign(0, (x + x) * y))); - } + if ((iy | ly) == 0) /* && ix >= 0x7ff00000 */ + return (CMPLX(x * x, copysign(0, x) * y)); /* * cosh(x +- I Inf) = dNaN + I dNaN. * Raise the invalid floating-point exception for finite nonzero x. * * cosh(x + I NaN) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero x. Choice = don't raise (except for signaling NaNs). */ - if (ix < 0x7ff00000 && iy >= 0x7ff00000) - return (cpack(y - y, x * (y - y))); + if (ix < 0x7ff00000) /* && iy >= 0x7ff00000 */ + return (CMPLX(y - y, x * (y - y))); /* * cosh(+-Inf + I NaN) = +Inf + I d(NaN). * * cosh(+-Inf +- I Inf) = +Inf + I dNaN. * The sign of Inf in the result is unspecified. Choice = always +. * Raise the invalid floating-point exception. * * cosh(+-Inf + I y) = +Inf cos(y) +- I Inf sin(y) */ - if (ix >= 0x7ff00000 && ((hx & 0xfffff) | lx) == 0) { + if (ix == 0x7ff00000 && lx == 0) { if (iy >= 0x7ff00000) - return (cpack(x * x, x * (y - y))); - return (cpack((x * x) * cos(y), x * sin(y))); + return (CMPLX(INFINITY, x * (y - y))); + return (CMPLX(INFINITY * cos(y), x * sin(y))); } /* * cosh(NaN + I NaN) = d(NaN) + I d(NaN). * * cosh(NaN +- I Inf) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception. * Choice = raise. * * cosh(NaN + I y) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero y. Choice = don't raise (except for signaling NaNs). */ - return (cpack((x * x) * (y - y), (x + x) * (y - y))); + return (CMPLX((x * x) * (y - y), (x + x) * (y - y))); } double complex ccos(double complex z) { /* ccos(z) = ccosh(I * z) */ - return (ccosh(cpack(-cimag(z), creal(z)))); + return (ccosh(CMPLX(-cimag(z), creal(z)))); } Index: stable/10/lib/msun/src/s_ccoshf.c =================================================================== --- stable/10/lib/msun/src/s_ccoshf.c (revision 284809) +++ stable/10/lib/msun/src/s_ccoshf.c (revision 284810) @@ -1,104 +1,101 @@ /*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. */ /* - * Hyperbolic cosine of a complex argument. See s_ccosh.c for details. + * Float version of ccosh(). See s_ccosh.c for details. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" static const float huge = 0x1p127; float complex ccoshf(float complex z) { float x, y, h; int32_t hx, hy, ix, iy; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hx, x); GET_FLOAT_WORD(hy, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; if (ix < 0x7f800000 && iy < 0x7f800000) { if (iy == 0) - return (cpackf(coshf(x), x * y)); - if (ix < 0x41100000) /* small x: normal case */ - return (cpackf(coshf(x) * cosf(y), sinhf(x) * sinf(y))); + return (CMPLXF(coshf(x), x * y)); + if (ix < 0x41100000) /* |x| < 9: normal case */ + return (CMPLXF(coshf(x) * cosf(y), sinhf(x) * sinf(y))); /* |x| >= 9, so cosh(x) ~= exp(|x|) */ if (ix < 0x42b17218) { /* x < 88.7: expf(|x|) won't overflow */ - h = expf(fabsf(x)) * 0.5f; - return (cpackf(h * cosf(y), copysignf(h, x) * sinf(y))); + h = expf(fabsf(x)) * 0.5F; + return (CMPLXF(h * cosf(y), copysignf(h, x) * sinf(y))); } else if (ix < 0x4340b1e7) { /* x < 192.7: scale to avoid overflow */ - z = __ldexp_cexpf(cpackf(fabsf(x), y), -1); - return (cpackf(crealf(z), cimagf(z) * copysignf(1, x))); + z = __ldexp_cexpf(CMPLXF(fabsf(x), y), -1); + return (CMPLXF(crealf(z), cimagf(z) * copysignf(1, x))); } else { /* x >= 192.7: the result always overflows */ h = huge * x; - return (cpackf(h * h * cosf(y), h * sinf(y))); + return (CMPLXF(h * h * cosf(y), h * sinf(y))); } } - if (ix == 0 && iy >= 0x7f800000) - return (cpackf(y - y, copysignf(0, x * (y - y)))); + if (ix == 0) /* && iy >= 0x7f800000 */ + return (CMPLXF(y - y, x * copysignf(0, y))); - if (iy == 0 && ix >= 0x7f800000) { - if ((hx & 0x7fffff) == 0) - return (cpackf(x * x, copysignf(0, x) * y)); - return (cpackf(x * x, copysignf(0, (x + x) * y))); - } + if (iy == 0) /* && ix >= 0x7f800000 */ + return (CMPLXF(x * x, copysignf(0, x) * y)); - if (ix < 0x7f800000 && iy >= 0x7f800000) - return (cpackf(y - y, x * (y - y))); + if (ix < 0x7f800000) /* && iy >= 0x7f800000 */ + return (CMPLXF(y - y, x * (y - y))); - if (ix >= 0x7f800000 && (hx & 0x7fffff) == 0) { + if (ix == 0x7f800000) { if (iy >= 0x7f800000) - return (cpackf(x * x, x * (y - y))); - return (cpackf((x * x) * cosf(y), x * sinf(y))); + return (CMPLXF(INFINITY, x * (y - y))); + return (CMPLXF(INFINITY * cosf(y), x * sinf(y))); } - return (cpackf((x * x) * (y - y), (x + x) * (y - y))); + return (CMPLXF((x * x) * (y - y), (x + x) * (y - y))); } float complex ccosf(float complex z) { - return (ccoshf(cpackf(-cimagf(z), crealf(z)))); + return (ccoshf(CMPLXF(-cimagf(z), crealf(z)))); } Index: stable/10/lib/msun/src/s_cexp.c =================================================================== --- stable/10/lib/msun/src/s_cexp.c (revision 284809) +++ stable/10/lib/msun/src/s_cexp.c (revision 284810) @@ -1,89 +1,89 @@ /*- * Copyright (c) 2011 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" static const uint32_t exp_ovfl = 0x40862e42, /* high bits of MAX_EXP * ln2 ~= 710 */ cexp_ovfl = 0x4096b8e4; /* (MAX_EXP - MIN_DENORM_EXP) * ln2 */ double complex cexp(double complex z) { double x, y, exp_x; uint32_t hx, hy, lx, ly; x = creal(z); y = cimag(z); EXTRACT_WORDS(hy, ly, y); hy &= 0x7fffffff; /* cexp(x + I 0) = exp(x) + I 0 */ if ((hy | ly) == 0) - return (cpack(exp(x), y)); + return (CMPLX(exp(x), y)); EXTRACT_WORDS(hx, lx, x); /* cexp(0 + I y) = cos(y) + I sin(y) */ if (((hx & 0x7fffffff) | lx) == 0) - return (cpack(cos(y), sin(y))); + return (CMPLX(cos(y), sin(y))); if (hy >= 0x7ff00000) { if (lx != 0 || (hx & 0x7fffffff) != 0x7ff00000) { /* cexp(finite|NaN +- I Inf|NaN) = NaN + I NaN */ - return (cpack(y - y, y - y)); + return (CMPLX(y - y, y - y)); } else if (hx & 0x80000000) { /* cexp(-Inf +- I Inf|NaN) = 0 + I 0 */ - return (cpack(0.0, 0.0)); + return (CMPLX(0.0, 0.0)); } else { /* cexp(+Inf +- I Inf|NaN) = Inf + I NaN */ - return (cpack(x, y - y)); + return (CMPLX(x, y - y)); } } if (hx >= exp_ovfl && hx <= cexp_ovfl) { /* * x is between 709.7 and 1454.3, so we must scale to avoid * overflow in exp(x). */ return (__ldexp_cexp(z, 0)); } else { /* * Cases covered here: * - x < exp_ovfl and exp(x) won't overflow (common case) * - x > cexp_ovfl, so exp(x) * s overflows for all s > 0 * - x = +-Inf (generated by exp()) * - x = NaN (spurious inexact exception from y) */ exp_x = exp(x); - return (cpack(exp_x * cos(y), exp_x * sin(y))); + return (CMPLX(exp_x * cos(y), exp_x * sin(y))); } } Index: stable/10/lib/msun/src/s_cexpf.c =================================================================== --- stable/10/lib/msun/src/s_cexpf.c (revision 284809) +++ stable/10/lib/msun/src/s_cexpf.c (revision 284810) @@ -1,89 +1,89 @@ /*- * Copyright (c) 2011 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" static const uint32_t exp_ovfl = 0x42b17218, /* MAX_EXP * ln2 ~= 88.722839355 */ cexp_ovfl = 0x43400074; /* (MAX_EXP - MIN_DENORM_EXP) * ln2 */ float complex cexpf(float complex z) { float x, y, exp_x; uint32_t hx, hy; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hy, y); hy &= 0x7fffffff; /* cexp(x + I 0) = exp(x) + I 0 */ if (hy == 0) - return (cpackf(expf(x), y)); + return (CMPLXF(expf(x), y)); GET_FLOAT_WORD(hx, x); /* cexp(0 + I y) = cos(y) + I sin(y) */ if ((hx & 0x7fffffff) == 0) - return (cpackf(cosf(y), sinf(y))); + return (CMPLXF(cosf(y), sinf(y))); if (hy >= 0x7f800000) { if ((hx & 0x7fffffff) != 0x7f800000) { /* cexp(finite|NaN +- I Inf|NaN) = NaN + I NaN */ - return (cpackf(y - y, y - y)); + return (CMPLXF(y - y, y - y)); } else if (hx & 0x80000000) { /* cexp(-Inf +- I Inf|NaN) = 0 + I 0 */ - return (cpackf(0.0, 0.0)); + return (CMPLXF(0.0, 0.0)); } else { /* cexp(+Inf +- I Inf|NaN) = Inf + I NaN */ - return (cpackf(x, y - y)); + return (CMPLXF(x, y - y)); } } if (hx >= exp_ovfl && hx <= cexp_ovfl) { /* * x is between 88.7 and 192, so we must scale to avoid * overflow in expf(x). */ return (__ldexp_cexpf(z, 0)); } else { /* * Cases covered here: * - x < exp_ovfl and exp(x) won't overflow (common case) * - x > cexp_ovfl, so exp(x) * s overflows for all s > 0 * - x = +-Inf (generated by exp()) * - x = NaN (spurious inexact exception from y) */ exp_x = expf(x); - return (cpackf(exp_x * cosf(y), exp_x * sinf(y))); + return (CMPLXF(exp_x * cosf(y), exp_x * sinf(y))); } } Index: stable/10/lib/msun/src/s_conj.c =================================================================== --- stable/10/lib/msun/src/s_conj.c (revision 284809) +++ stable/10/lib/msun/src/s_conj.c (revision 284810) @@ -1,38 +1,38 @@ /*- * Copyright (c) 2004 Stefan Farfeleder * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``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 AUTHOR OR CONTRIBUTORS 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$ */ #include #include "math_private.h" double complex conj(double complex z) { - return (cpack(creal(z), -cimag(z))); + return (CMPLX(creal(z), -cimag(z))); } Index: stable/10/lib/msun/src/s_conjf.c =================================================================== --- stable/10/lib/msun/src/s_conjf.c (revision 284809) +++ stable/10/lib/msun/src/s_conjf.c (revision 284810) @@ -1,38 +1,38 @@ /*- * Copyright (c) 2004 Stefan Farfeleder * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``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 AUTHOR OR CONTRIBUTORS 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$ */ #include #include "math_private.h" float complex conjf(float complex z) { - return (cpackf(crealf(z), -cimagf(z))); + return (CMPLXF(crealf(z), -cimagf(z))); } Index: stable/10/lib/msun/src/s_conjl.c =================================================================== --- stable/10/lib/msun/src/s_conjl.c (revision 284809) +++ stable/10/lib/msun/src/s_conjl.c (revision 284810) @@ -1,38 +1,38 @@ /*- * Copyright (c) 2004 Stefan Farfeleder * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``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 AUTHOR OR CONTRIBUTORS 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$ */ #include #include "math_private.h" long double complex conjl(long double complex z) { - return (cpackl(creall(z), -cimagl(z))); + return (CMPLXL(creall(z), -cimagl(z))); } Index: stable/10/lib/msun/src/s_cproj.c =================================================================== --- stable/10/lib/msun/src/s_cproj.c (revision 284809) +++ stable/10/lib/msun/src/s_cproj.c (revision 284810) @@ -1,47 +1,47 @@ /*- * Copyright (c) 2008 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" double complex cproj(double complex z) { if (!isinf(creal(z)) && !isinf(cimag(z))) return (z); else - return (cpack(INFINITY, copysign(0.0, cimag(z)))); + return (CMPLX(INFINITY, copysign(0.0, cimag(z)))); } #if LDBL_MANT_DIG == 53 __weak_reference(cproj, cprojl); #endif Index: stable/10/lib/msun/src/s_cprojf.c =================================================================== --- stable/10/lib/msun/src/s_cprojf.c (revision 284809) +++ stable/10/lib/msun/src/s_cprojf.c (revision 284810) @@ -1,43 +1,43 @@ /*- * Copyright (c) 2008 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" float complex cprojf(float complex z) { if (!isinf(crealf(z)) && !isinf(cimagf(z))) return (z); else - return (cpackf(INFINITY, copysignf(0.0, cimagf(z)))); + return (CMPLXF(INFINITY, copysignf(0.0, cimagf(z)))); } Index: stable/10/lib/msun/src/s_cprojl.c =================================================================== --- stable/10/lib/msun/src/s_cprojl.c (revision 284809) +++ stable/10/lib/msun/src/s_cprojl.c (revision 284810) @@ -1,43 +1,43 @@ /*- * Copyright (c) 2008 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" long double complex cprojl(long double complex z) { if (!isinf(creall(z)) && !isinf(cimagl(z))) return (z); else - return (cpackl(INFINITY, copysignl(0.0, cimagl(z)))); + return (CMPLXL(INFINITY, copysignl(0.0, cimagl(z)))); } Index: stable/10/lib/msun/src/s_csinh.c =================================================================== --- stable/10/lib/msun/src/s_csinh.c (revision 284809) +++ stable/10/lib/msun/src/s_csinh.c (revision 284810) @@ -1,157 +1,156 @@ /*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. */ /* * Hyperbolic sine of a complex argument z = x + i y. * * sinh(z) = sinh(x+iy) * = sinh(x) cos(y) + i cosh(x) sin(y). * * Exceptional values are noted in the comments within the source code. * These values and the return value were taken from n1124.pdf. + * The sign of the result for some exceptional values is unspecified but + * must satisfy both sinh(conj(z)) == conj(sinh(z)) and sinh(-z) == -sinh(z). */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" static const double huge = 0x1p1023; double complex csinh(double complex z) { double x, y, h; int32_t hx, hy, ix, iy, lx, ly; x = creal(z); y = cimag(z); EXTRACT_WORDS(hx, lx, x); EXTRACT_WORDS(hy, ly, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; /* Handle the nearly-non-exceptional cases where x and y are finite. */ if (ix < 0x7ff00000 && iy < 0x7ff00000) { if ((iy | ly) == 0) - return (cpack(sinh(x), y)); - if (ix < 0x40360000) /* small x: normal case */ - return (cpack(sinh(x) * cos(y), cosh(x) * sin(y))); + return (CMPLX(sinh(x), y)); + if (ix < 0x40360000) /* |x| < 22: normal case */ + return (CMPLX(sinh(x) * cos(y), cosh(x) * sin(y))); /* |x| >= 22, so cosh(x) ~= exp(|x|) */ if (ix < 0x40862e42) { /* x < 710: exp(|x|) won't overflow */ h = exp(fabs(x)) * 0.5; - return (cpack(copysign(h, x) * cos(y), h * sin(y))); + return (CMPLX(copysign(h, x) * cos(y), h * sin(y))); } else if (ix < 0x4096bbaa) { /* x < 1455: scale to avoid overflow */ - z = __ldexp_cexp(cpack(fabs(x), y), -1); - return (cpack(creal(z) * copysign(1, x), cimag(z))); + z = __ldexp_cexp(CMPLX(fabs(x), y), -1); + return (CMPLX(creal(z) * copysign(1, x), cimag(z))); } else { /* x >= 1455: the result always overflows */ h = huge * x; - return (cpack(h * cos(y), h * h * sin(y))); + return (CMPLX(h * cos(y), h * h * sin(y))); } } /* - * sinh(+-0 +- I Inf) = sign(d(+-0, dNaN))0 + I dNaN. - * The sign of 0 in the result is unspecified. Choice = normally - * the same as dNaN. Raise the invalid floating-point exception. + * sinh(+-0 +- I Inf) = +-0 + I dNaN. + * The sign of 0 in the result is unspecified. Choice = same sign + * as the argument. Raise the invalid floating-point exception. * - * sinh(+-0 +- I NaN) = sign(d(+-0, NaN))0 + I d(NaN). - * The sign of 0 in the result is unspecified. Choice = normally - * the same as d(NaN). + * sinh(+-0 +- I NaN) = +-0 + I d(NaN). + * The sign of 0 in the result is unspecified. Choice = same sign + * as the argument. */ - if ((ix | lx) == 0 && iy >= 0x7ff00000) - return (cpack(copysign(0, x * (y - y)), y - y)); + if ((ix | lx) == 0) /* && iy >= 0x7ff00000 */ + return (CMPLX(x, y - y)); /* * sinh(+-Inf +- I 0) = +-Inf + I +-0. * * sinh(NaN +- I 0) = d(NaN) + I +-0. */ - if ((iy | ly) == 0 && ix >= 0x7ff00000) { - if (((hx & 0xfffff) | lx) == 0) - return (cpack(x, y)); - return (cpack(x, copysign(0, y))); - } + if ((iy | ly) == 0) /* && ix >= 0x7ff00000 */ + return (CMPLX(x + x, y)); /* * sinh(x +- I Inf) = dNaN + I dNaN. * Raise the invalid floating-point exception for finite nonzero x. * * sinh(x + I NaN) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero x. Choice = don't raise (except for signaling NaNs). */ - if (ix < 0x7ff00000 && iy >= 0x7ff00000) - return (cpack(y - y, x * (y - y))); + if (ix < 0x7ff00000) /* && iy >= 0x7ff00000 */ + return (CMPLX(y - y, y - y)); /* * sinh(+-Inf + I NaN) = +-Inf + I d(NaN). - * The sign of Inf in the result is unspecified. Choice = normally - * the same as d(NaN). + * The sign of Inf in the result is unspecified. Choice = same sign + * as the argument. * - * sinh(+-Inf +- I Inf) = +Inf + I dNaN. - * The sign of Inf in the result is unspecified. Choice = always +. - * Raise the invalid floating-point exception. + * sinh(+-Inf +- I Inf) = +-Inf + I dNaN. + * The sign of Inf in the result is unspecified. Choice = same sign + * as the argument. Raise the invalid floating-point exception. * * sinh(+-Inf + I y) = +-Inf cos(y) + I Inf sin(y) */ - if (ix >= 0x7ff00000 && ((hx & 0xfffff) | lx) == 0) { + if (ix == 0x7ff00000 && lx == 0) { if (iy >= 0x7ff00000) - return (cpack(x * x, x * (y - y))); - return (cpack(x * cos(y), INFINITY * sin(y))); + return (CMPLX(x, y - y)); + return (CMPLX(x * cos(y), INFINITY * sin(y))); } /* - * sinh(NaN + I NaN) = d(NaN) + I d(NaN). + * sinh(NaN1 + I NaN2) = d(NaN1, NaN2) + I d(NaN1, NaN2). * - * sinh(NaN +- I Inf) = d(NaN) + I d(NaN). + * sinh(NaN +- I Inf) = d(NaN, dNaN) + I d(NaN, dNaN). * Optionally raises the invalid floating-point exception. * Choice = raise. * - * sinh(NaN + I y) = d(NaN) + I d(NaN). + * sinh(NaN + I y) = d(NaN) + I d(NaN). * Optionally raises the invalid floating-point exception for finite * nonzero y. Choice = don't raise (except for signaling NaNs). */ - return (cpack((x * x) * (y - y), (x + x) * (y - y))); + return (CMPLX((x + x) * (y - y), (x * x) * (y - y))); } double complex csin(double complex z) { - /* csin(z) = -I * csinh(I * z) */ - z = csinh(cpack(-cimag(z), creal(z))); - return (cpack(cimag(z), -creal(z))); + /* csin(z) = -I * csinh(I * z) = I * conj(csinh(I * conj(z))). */ + z = csinh(CMPLX(cimag(z), creal(z))); + return (CMPLX(cimag(z), creal(z))); } Index: stable/10/lib/msun/src/s_csinhf.c =================================================================== --- stable/10/lib/msun/src/s_csinhf.c (revision 284809) +++ stable/10/lib/msun/src/s_csinhf.c (revision 284810) @@ -1,105 +1,102 @@ /*- * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. */ /* - * Hyperbolic sine of a complex argument z. See s_csinh.c for details. + * Float version of csinh(). See s_csinh.c for details. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" static const float huge = 0x1p127; float complex csinhf(float complex z) { float x, y, h; int32_t hx, hy, ix, iy; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hx, x); GET_FLOAT_WORD(hy, y); ix = 0x7fffffff & hx; iy = 0x7fffffff & hy; if (ix < 0x7f800000 && iy < 0x7f800000) { if (iy == 0) - return (cpackf(sinhf(x), y)); - if (ix < 0x41100000) /* small x: normal case */ - return (cpackf(sinhf(x) * cosf(y), coshf(x) * sinf(y))); + return (CMPLXF(sinhf(x), y)); + if (ix < 0x41100000) /* |x| < 9: normal case */ + return (CMPLXF(sinhf(x) * cosf(y), coshf(x) * sinf(y))); /* |x| >= 9, so cosh(x) ~= exp(|x|) */ if (ix < 0x42b17218) { /* x < 88.7: expf(|x|) won't overflow */ - h = expf(fabsf(x)) * 0.5f; - return (cpackf(copysignf(h, x) * cosf(y), h * sinf(y))); + h = expf(fabsf(x)) * 0.5F; + return (CMPLXF(copysignf(h, x) * cosf(y), h * sinf(y))); } else if (ix < 0x4340b1e7) { /* x < 192.7: scale to avoid overflow */ - z = __ldexp_cexpf(cpackf(fabsf(x), y), -1); - return (cpackf(crealf(z) * copysignf(1, x), cimagf(z))); + z = __ldexp_cexpf(CMPLXF(fabsf(x), y), -1); + return (CMPLXF(crealf(z) * copysignf(1, x), cimagf(z))); } else { /* x >= 192.7: the result always overflows */ h = huge * x; - return (cpackf(h * cosf(y), h * h * sinf(y))); + return (CMPLXF(h * cosf(y), h * h * sinf(y))); } } - if (ix == 0 && iy >= 0x7f800000) - return (cpackf(copysignf(0, x * (y - y)), y - y)); + if (ix == 0) /* && iy >= 0x7f800000 */ + return (CMPLXF(x, y - y)); - if (iy == 0 && ix >= 0x7f800000) { - if ((hx & 0x7fffff) == 0) - return (cpackf(x, y)); - return (cpackf(x, copysignf(0, y))); - } + if (iy == 0) /* && ix >= 0x7f800000 */ + return (CMPLXF(x + x, y)); - if (ix < 0x7f800000 && iy >= 0x7f800000) - return (cpackf(y - y, x * (y - y))); + if (ix < 0x7f800000) /* && iy >= 0x7f800000 */ + return (CMPLXF(y - y, y - y)); - if (ix >= 0x7f800000 && (hx & 0x7fffff) == 0) { + if (ix == 0x7f800000) { if (iy >= 0x7f800000) - return (cpackf(x * x, x * (y - y))); - return (cpackf(x * cosf(y), INFINITY * sinf(y))); + return (CMPLXF(x, y - y)); + return (CMPLXF(x * cosf(y), INFINITY * sinf(y))); } - return (cpackf((x * x) * (y - y), (x + x) * (y - y))); + return (CMPLXF((x + x) * (y - y), (x * x) * (y - y))); } float complex csinf(float complex z) { - z = csinhf(cpackf(-cimagf(z), crealf(z))); - return (cpackf(cimagf(z), -crealf(z))); + z = csinhf(CMPLXF(cimagf(z), crealf(z))); + return (CMPLXF(cimagf(z), crealf(z))); } Index: stable/10/lib/msun/src/s_csqrt.c =================================================================== --- stable/10/lib/msun/src/s_csqrt.c (revision 284809) +++ stable/10/lib/msun/src/s_csqrt.c (revision 284810) @@ -1,112 +1,112 @@ /*- * Copyright (c) 2007 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include #include "math_private.h" /* * gcc doesn't implement complex multiplication or division correctly, * so we need to handle infinities specially. We turn on this pragma to * notify conforming c99 compilers that the fast-but-incorrect code that * gcc generates is acceptable, since the special cases have already been * handled. */ #pragma STDC CX_LIMITED_RANGE ON /* We risk spurious overflow for components >= DBL_MAX / (1 + sqrt(2)). */ #define THRESH 0x1.a827999fcef32p+1022 double complex csqrt(double complex z) { double complex result; double a, b; double t; int scale; a = creal(z); b = cimag(z); /* Handle special cases. */ if (z == 0) - return (cpack(0, b)); + return (CMPLX(0, b)); if (isinf(b)) - return (cpack(INFINITY, b)); + return (CMPLX(INFINITY, b)); if (isnan(a)) { t = (b - b) / (b - b); /* raise invalid if b is not a NaN */ - return (cpack(a, t)); /* return NaN + NaN i */ + return (CMPLX(a, t)); /* return NaN + NaN i */ } if (isinf(a)) { /* * csqrt(inf + NaN i) = inf + NaN i * csqrt(inf + y i) = inf + 0 i * csqrt(-inf + NaN i) = NaN +- inf i * csqrt(-inf + y i) = 0 + inf i */ if (signbit(a)) - return (cpack(fabs(b - b), copysign(a, b))); + return (CMPLX(fabs(b - b), copysign(a, b))); else - return (cpack(a, copysign(b - b, b))); + return (CMPLX(a, copysign(b - b, b))); } /* * The remaining special case (b is NaN) is handled just fine by * the normal code path below. */ /* Scale to avoid overflow. */ if (fabs(a) >= THRESH || fabs(b) >= THRESH) { a *= 0.25; b *= 0.25; scale = 1; } else { scale = 0; } /* Algorithm 312, CACM vol 10, Oct 1967. */ if (a >= 0) { t = sqrt((a + hypot(a, b)) * 0.5); - result = cpack(t, b / (2 * t)); + result = CMPLX(t, b / (2 * t)); } else { t = sqrt((-a + hypot(a, b)) * 0.5); - result = cpack(fabs(b) / (2 * t), copysign(t, b)); + result = CMPLX(fabs(b) / (2 * t), copysign(t, b)); } /* Rescale. */ if (scale) return (result * 2); else return (result); } #if LDBL_MANT_DIG == 53 __weak_reference(csqrt, csqrtl); #endif Index: stable/10/lib/msun/src/s_csqrtf.c =================================================================== --- stable/10/lib/msun/src/s_csqrtf.c (revision 284809) +++ stable/10/lib/msun/src/s_csqrtf.c (revision 284810) @@ -1,88 +1,88 @@ /*- * Copyright (c) 2007 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" /* * gcc doesn't implement complex multiplication or division correctly, * so we need to handle infinities specially. We turn on this pragma to * notify conforming c99 compilers that the fast-but-incorrect code that * gcc generates is acceptable, since the special cases have already been * handled. */ #pragma STDC CX_LIMITED_RANGE ON float complex csqrtf(float complex z) { float a = crealf(z), b = cimagf(z); double t; /* Handle special cases. */ if (z == 0) - return (cpackf(0, b)); + return (CMPLXF(0, b)); if (isinf(b)) - return (cpackf(INFINITY, b)); + return (CMPLXF(INFINITY, b)); if (isnan(a)) { t = (b - b) / (b - b); /* raise invalid if b is not a NaN */ - return (cpackf(a, t)); /* return NaN + NaN i */ + return (CMPLXF(a, t)); /* return NaN + NaN i */ } if (isinf(a)) { /* * csqrtf(inf + NaN i) = inf + NaN i * csqrtf(inf + y i) = inf + 0 i * csqrtf(-inf + NaN i) = NaN +- inf i * csqrtf(-inf + y i) = 0 + inf i */ if (signbit(a)) - return (cpackf(fabsf(b - b), copysignf(a, b))); + return (CMPLXF(fabsf(b - b), copysignf(a, b))); else - return (cpackf(a, copysignf(b - b, b))); + return (CMPLXF(a, copysignf(b - b, b))); } /* * The remaining special case (b is NaN) is handled just fine by * the normal code path below. */ /* * We compute t in double precision to avoid overflow and to * provide correct rounding in nearly all cases. * This is Algorithm 312, CACM vol 10, Oct 1967. */ if (a >= 0) { t = sqrt((a + hypot(a, b)) * 0.5); - return (cpackf(t, b / (2.0 * t))); + return (CMPLXF(t, b / (2.0 * t))); } else { t = sqrt((-a + hypot(a, b)) * 0.5); - return (cpackf(fabsf(b) / (2.0 * t), copysignf(t, b))); + return (CMPLXF(fabsf(b) / (2.0 * t), copysignf(t, b))); } } Index: stable/10/lib/msun/src/s_csqrtl.c =================================================================== --- stable/10/lib/msun/src/s_csqrtl.c (revision 284809) +++ stable/10/lib/msun/src/s_csqrtl.c (revision 284810) @@ -1,108 +1,108 @@ /*- * Copyright (c) 2007-2008 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); #include #include #include #include "math_private.h" /* * gcc doesn't implement complex multiplication or division correctly, * so we need to handle infinities specially. We turn on this pragma to * notify conforming c99 compilers that the fast-but-incorrect code that * gcc generates is acceptable, since the special cases have already been * handled. */ #pragma STDC CX_LIMITED_RANGE ON /* We risk spurious overflow for components >= LDBL_MAX / (1 + sqrt(2)). */ #define THRESH (LDBL_MAX / 2.414213562373095048801688724209698L) long double complex csqrtl(long double complex z) { long double complex result; long double a, b; long double t; int scale; a = creall(z); b = cimagl(z); /* Handle special cases. */ if (z == 0) - return (cpackl(0, b)); + return (CMPLXL(0, b)); if (isinf(b)) - return (cpackl(INFINITY, b)); + return (CMPLXL(INFINITY, b)); if (isnan(a)) { t = (b - b) / (b - b); /* raise invalid if b is not a NaN */ - return (cpackl(a, t)); /* return NaN + NaN i */ + return (CMPLXL(a, t)); /* return NaN + NaN i */ } if (isinf(a)) { /* * csqrt(inf + NaN i) = inf + NaN i * csqrt(inf + y i) = inf + 0 i * csqrt(-inf + NaN i) = NaN +- inf i * csqrt(-inf + y i) = 0 + inf i */ if (signbit(a)) - return (cpackl(fabsl(b - b), copysignl(a, b))); + return (CMPLXL(fabsl(b - b), copysignl(a, b))); else - return (cpackl(a, copysignl(b - b, b))); + return (CMPLXL(a, copysignl(b - b, b))); } /* * The remaining special case (b is NaN) is handled just fine by * the normal code path below. */ /* Scale to avoid overflow. */ if (fabsl(a) >= THRESH || fabsl(b) >= THRESH) { a *= 0.25; b *= 0.25; scale = 1; } else { scale = 0; } /* Algorithm 312, CACM vol 10, Oct 1967. */ if (a >= 0) { t = sqrtl((a + hypotl(a, b)) * 0.5); - result = cpackl(t, b / (2 * t)); + result = CMPLXL(t, b / (2 * t)); } else { t = sqrtl((-a + hypotl(a, b)) * 0.5); - result = cpackl(fabsl(b) / (2 * t), copysignl(t, b)); + result = CMPLXL(fabsl(b) / (2 * t), copysignl(t, b)); } /* Rescale. */ if (scale) return (result * 2); else return (result); } Index: stable/10/lib/msun/src/s_ctanh.c =================================================================== --- stable/10/lib/msun/src/s_ctanh.c (revision 284809) +++ stable/10/lib/msun/src/s_ctanh.c (revision 284810) @@ -1,144 +1,145 @@ /*- * Copyright (c) 2011 David Schultz * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. */ /* - * Hyperbolic tangent of a complex argument z = x + i y. + * Hyperbolic tangent of a complex argument z = x + I y. * * The algorithm is from: * * W. Kahan. Branch Cuts for Complex Elementary Functions or Much * Ado About Nothing's Sign Bit. In The State of the Art in * Numerical Analysis, pp. 165 ff. Iserles and Powell, eds., 1987. * * Method: * * Let t = tan(x) * beta = 1/cos^2(y) * s = sinh(x) * rho = cosh(x) * * We have: * * tanh(z) = sinh(z) / cosh(z) * - * sinh(x) cos(y) + i cosh(x) sin(y) + * sinh(x) cos(y) + I cosh(x) sin(y) * = --------------------------------- - * cosh(x) cos(y) + i sinh(x) sin(y) + * cosh(x) cos(y) + I sinh(x) sin(y) * - * cosh(x) sinh(x) / cos^2(y) + i tan(y) + * cosh(x) sinh(x) / cos^2(y) + I tan(y) * = ------------------------------------- * 1 + sinh^2(x) / cos^2(y) * - * beta rho s + i t + * beta rho s + I t * = ---------------- * 1 + beta s^2 * * Modifications: * * I omitted the original algorithm's handling of overflow in tan(x) after * verifying with nearpi.c that this can't happen in IEEE single or double * precision. I also handle large x differently. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" double complex ctanh(double complex z) { double x, y; double t, beta, s, rho, denom; uint32_t hx, ix, lx; x = creal(z); y = cimag(z); EXTRACT_WORDS(hx, lx, x); ix = hx & 0x7fffffff; /* - * ctanh(NaN + i 0) = NaN + i 0 + * ctanh(NaN +- I 0) = d(NaN) +- I 0 * - * ctanh(NaN + i y) = NaN + i NaN for y != 0 + * ctanh(NaN + I y) = d(NaN,y) + I d(NaN,y) for y != 0 * * The imaginary part has the sign of x*sin(2*y), but there's no * special effort to get this right. * - * ctanh(+-Inf +- i Inf) = +-1 +- 0 + * ctanh(+-Inf +- I Inf) = +-1 +- I 0 * - * ctanh(+-Inf + i y) = +-1 + 0 sin(2y) for y finite + * ctanh(+-Inf + I y) = +-1 + I 0 sin(2y) for y finite * * The imaginary part of the sign is unspecified. This special * case is only needed to avoid a spurious invalid exception when * y is infinite. */ if (ix >= 0x7ff00000) { if ((ix & 0xfffff) | lx) /* x is NaN */ - return (cpack(x, (y == 0 ? y : x * y))); + return (CMPLX((x + 0) * (y + 0), + y == 0 ? y : (x + 0) * (y + 0))); SET_HIGH_WORD(x, hx - 0x40000000); /* x = copysign(1, x) */ - return (cpack(x, copysign(0, isinf(y) ? y : sin(y) * cos(y)))); + return (CMPLX(x, copysign(0, isinf(y) ? y : sin(y) * cos(y)))); } /* - * ctanh(x + i NAN) = NaN + i NaN - * ctanh(x +- i Inf) = NaN + i NaN + * ctanh(x + I NaN) = d(NaN) + I d(NaN) + * ctanh(x +- I Inf) = dNaN + I dNaN */ if (!isfinite(y)) - return (cpack(y - y, y - y)); + return (CMPLX(y - y, y - y)); /* - * ctanh(+-huge + i +-y) ~= +-1 +- i 2sin(2y)/exp(2x), using the + * ctanh(+-huge +- I y) ~= +-1 +- I 2sin(2y)/exp(2x), using the * approximation sinh^2(huge) ~= exp(2*huge) / 4. * We use a modified formula to avoid spurious overflow. */ - if (ix >= 0x40360000) { /* x >= 22 */ + if (ix >= 0x40360000) { /* |x| >= 22 */ double exp_mx = exp(-fabs(x)); - return (cpack(copysign(1, x), + return (CMPLX(copysign(1, x), 4 * sin(y) * cos(y) * exp_mx * exp_mx)); } /* Kahan's algorithm */ t = tan(y); beta = 1.0 + t * t; /* = 1 / cos^2(y) */ s = sinh(x); rho = sqrt(1 + s * s); /* = cosh(x) */ denom = 1 + beta * s * s; - return (cpack((beta * rho * s) / denom, t / denom)); + return (CMPLX((beta * rho * s) / denom, t / denom)); } double complex ctan(double complex z) { - /* ctan(z) = -I * ctanh(I * z) */ - z = ctanh(cpack(-cimag(z), creal(z))); - return (cpack(cimag(z), -creal(z))); + /* ctan(z) = -I * ctanh(I * z) = I * conj(ctanh(I * conj(z))) */ + z = ctanh(CMPLX(cimag(z), creal(z))); + return (CMPLX(cimag(z), creal(z))); } Index: stable/10/lib/msun/src/s_ctanhf.c =================================================================== --- stable/10/lib/msun/src/s_ctanhf.c (revision 284809) +++ stable/10/lib/msun/src/s_ctanhf.c (revision 284810) @@ -1,84 +1,85 @@ /*- * Copyright (c) 2011 David Schultz * 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 unmodified, this list of conditions, and the following * disclaimer. * 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. * * 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. */ /* * Hyperbolic tangent of a complex argument z. See s_ctanh.c for details. */ #include __FBSDID("$FreeBSD$"); #include #include #include "math_private.h" float complex ctanhf(float complex z) { float x, y; float t, beta, s, rho, denom; uint32_t hx, ix; x = crealf(z); y = cimagf(z); GET_FLOAT_WORD(hx, x); ix = hx & 0x7fffffff; if (ix >= 0x7f800000) { if (ix & 0x7fffff) - return (cpackf(x, (y == 0 ? y : x * y))); + return (CMPLXF((x + 0) * (y + 0), + y == 0 ? y : (x + 0) * (y + 0))); SET_FLOAT_WORD(x, hx - 0x40000000); - return (cpackf(x, + return (CMPLXF(x, copysignf(0, isinf(y) ? y : sinf(y) * cosf(y)))); } if (!isfinite(y)) - return (cpackf(y - y, y - y)); + return (CMPLXF(y - y, y - y)); - if (ix >= 0x41300000) { /* x >= 11 */ + if (ix >= 0x41300000) { /* |x| >= 11 */ float exp_mx = expf(-fabsf(x)); - return (cpackf(copysignf(1, x), + return (CMPLXF(copysignf(1, x), 4 * sinf(y) * cosf(y) * exp_mx * exp_mx)); } t = tanf(y); beta = 1.0 + t * t; s = sinhf(x); rho = sqrtf(1 + s * s); denom = 1 + beta * s * s; - return (cpackf((beta * rho * s) / denom, t / denom)); + return (CMPLXF((beta * rho * s) / denom, t / denom)); } float complex ctanf(float complex z) { - z = ctanhf(cpackf(-cimagf(z), crealf(z))); - return (cpackf(cimagf(z), -crealf(z))); + z = ctanhf(CMPLXF(cimagf(z), crealf(z))); + return (CMPLXF(cimagf(z), crealf(z))); } Index: stable/10/lib/msun/src/s_scalbln.c =================================================================== --- stable/10/lib/msun/src/s_scalbln.c (revision 284809) +++ stable/10/lib/msun/src/s_scalbln.c (revision 284810) @@ -1,58 +1,54 @@ /*- * Copyright (c) 2004 David Schultz * 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. * 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. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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. */ #include __FBSDID("$FreeBSD$"); -#include #include +#define NMAX 65536 +#define NMIN -65536 + double -scalbln (double x, long n) +scalbln(double x, long n) { - int in; - in = (n > INT_MAX) ? INT_MAX : (n < INT_MIN) ? INT_MIN : n; - return (scalbn(x, in)); + return (scalbn(x, (n > NMAX) ? NMAX : (n < NMIN) ? NMIN : (int)n)); } float -scalblnf (float x, long n) +scalblnf(float x, long n) { - int in; - in = (n > INT_MAX) ? INT_MAX : (n < INT_MIN) ? INT_MIN : n; - return (scalbnf(x, in)); + return (scalbnf(x, (n > NMAX) ? NMAX : (n < NMIN) ? NMIN : (int)n)); } long double -scalblnl (long double x, long n) +scalblnl(long double x, long n) { - int in; - in = (n > INT_MAX) ? INT_MAX : (n < INT_MIN) ? INT_MIN : n; - return (scalbnl(x, in)); + return (scalbnl(x, (n > NMAX) ? NMAX : (n < NMIN) ? NMIN : (int)n)); } Index: stable/10 =================================================================== --- stable/10 (revision 284809) +++ stable/10 (revision 284810) Property changes on: stable/10 ___________________________________________________________________ Modified: svn:mergeinfo ## -0,0 +0,1 ## Merged /head:r271651,271719,272138,272457,272845,275476,275518,275614,275819,276176,278154,278160,278339,279127,279240,279491,279493,279856,283032,284423,284426-284428