diff options
Diffstat (limited to 'lib/libm')
99 files changed, 11084 insertions, 57 deletions
diff --git a/lib/libm/Makefile b/lib/libm/Makefile index 486a71a384a..46e6cf9c12a 100644 --- a/lib/libm/Makefile +++ b/lib/libm/Makefile @@ -1,4 +1,4 @@ -# $OpenBSD: Makefile,v 1.82 2011/05/28 22:13:52 martynas Exp $ +# $OpenBSD: Makefile,v 1.83 2011/07/06 00:02:42 martynas Exp $ # $NetBSD: Makefile,v 1.28 1995/11/20 22:06:19 jtc Exp $ # # @(#)Makefile 5.1beta 93/09/24 @@ -118,12 +118,12 @@ COMMON_SRCS = b_exp__D.c b_log__D.c b_tgamma.c \ s_cproj.c s_cprojf.c s_creal.c s_crealf.c s_csin.c s_csinf.c s_csinh.c \ s_csinhf.c s_csqrt.c s_csqrtf.c s_ctan.c s_ctanf.c s_ctanh.c \ s_ctanhf.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_fmax.c s_fmaxf.c s_fmin.c s_fminf.c \ - s_floor.c s_floorf.c s_frexpf.c s_ilogb.c s_ilogbf.c \ + s_fabsf.c s_fdim.c s_fma.c s_fmaf.c s_fmax.c s_fmaxf.c s_fmin.c \ + s_fminf.c s_floor.c s_floorf.c s_frexpf.c s_ilogb.c s_ilogbf.c \ s_log1p.c \ s_log1pf.c s_logb.c s_logbf.c s_llrint.c s_llrintf.c s_lrint.c \ - s_lrintf.c s_modff.c s_nan.c s_nearbyint.c \ - s_nextafter.c s_nextafterf.c s_remquo.c s_remquof.c s_rint.c \ + s_lrintf.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_signgam.c s_significand.c \ s_significandf.c \ @@ -131,12 +131,17 @@ COMMON_SRCS = b_exp__D.c b_log__D.c b_tgamma.c \ s_truncf.c w_drem.c w_dremf.c w_gamma.c w_gamma_r.c w_gammaf.c \ w_gammaf_r.c w_lgamma.c w_lgammaf.c -LONG_SRCS = e_acosl.c e_asinl.c e_atan2l.c e_sqrtl.c \ - invtrig.c \ - k_cosl.c k_sinl.c k_tanl.c \ - s_atanl.c s_copysignl.c s_cosl.c s_exp2l.c s_fabsl.c s_fmaxl.c \ - s_fminl.c s_frexpl.c s_ilogbl.c s_logbl.c s_nanl.c s_rintl.c \ - s_scalbnl.c s_sinl.c s_tanl.c +LONG_SRCS = e_acoshl.c e_acosl.c e_asinl.c e_atan2l.c e_atanhl.c \ + e_coshl.c e_expl.c e_fmodl.c e_hypotl.c e_lgammal.c e_log10l.c \ + e_log2l.c e_logl.c e_powl.c e_remainderl.c e_sinhl.c e_sqrtl.c \ + e_tgammal.c invtrig.c k_cosl.c k_sinl.c k_tanl.c polevll.c \ + s_asinhl.c s_atanl.c s_cbrtl.c s_ceill.c s_copysignl.c \ + s_cosl.c s_erfl.c s_exp2l.c s_expm1l.c s_fabsl.c s_floorl.c \ + s_fmal.c s_fmaxl.c s_fminl.c s_frexpl.c s_ilogbl.c s_llrintl.c \ + s_llroundl.c s_log1pl.c s_logbl.c s_lrintl.c s_lroundl.c \ + s_modfl.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 # math routines for non-IEEE architectures. NOIEEE_SRCS = n_acosh.c n_argred.c n_asincos.c n_asinh.c n_atan.c \ diff --git a/lib/libm/shlib_version b/lib/libm/shlib_version index 3d02023227e..11ab6a71a24 100644 --- a/lib/libm/shlib_version +++ b/lib/libm/shlib_version @@ -1,2 +1,2 @@ major=5 -minor=3 +minor=4 diff --git a/lib/libm/src/b_tgamma.c b/lib/libm/src/b_tgamma.c index b6bacffd311..14a1e8f54ee 100644 --- a/lib/libm/src/b_tgamma.c +++ b/lib/libm/src/b_tgamma.c @@ -1,4 +1,4 @@ -/* $OpenBSD: b_tgamma.c,v 1.3 2009/10/27 23:59:29 deraadt Exp $ */ +/* $OpenBSD: b_tgamma.c,v 1.4 2011/07/06 00:02:42 martynas Exp $ */ /*- * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. @@ -28,6 +28,8 @@ * SUCH DAMAGE. */ +/* LINTLIBRARY */ + /* * This code by P. McIlroy, Oct 1992; * @@ -35,7 +37,10 @@ * acknowledged. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" /* METHOD: @@ -330,3 +335,12 @@ neg_gam(double x) if (sgn < 0) y = -y; return (M_PI / (y*z)); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double tgammal(long double); +#else /* lint */ +__weak_alias(tgammal, tgamma); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_acosh.c b/lib/libm/src/e_acosh.c index c9d8b366dda..290e6bef9ec 100644 --- a/lib/libm/src/e_acosh.c +++ b/lib/libm/src/e_acosh.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* acosh(x) * Method : * Based on @@ -24,7 +26,10 @@ * acosh(NaN) is NaN without signal. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -55,3 +60,12 @@ acosh(double x) return log1p(t+sqrt(2.0*t+t*t)); } } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double acoshl(long double); +#else /* lint */ +__weak_alias(acoshl, acosh); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_atanh.c b/lib/libm/src/e_atanh.c index 734aece6f79..a8d114291f2 100644 --- a/lib/libm/src/e_atanh.c +++ b/lib/libm/src/e_atanh.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* atanh(x) * Method : * 1.Reduced x to positive by atanh(-x) = -atanh(x) @@ -28,7 +30,10 @@ * */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double one = 1.0, huge = 1e300; @@ -55,3 +60,12 @@ atanh(double x) t = 0.5*log1p((x+x)/(one-x)); if(hx>=0) return t; else return -t; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double atanhl(long double); +#else /* lint */ +__weak_alias(atanhl, atanh); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_cosh.c b/lib/libm/src/e_cosh.c index 795f15b392b..030b6b4d9a1 100644 --- a/lib/libm/src/e_cosh.c +++ b/lib/libm/src/e_cosh.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* cosh(x) * Method : * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2 @@ -31,7 +33,10 @@ * only cosh(0)=1 is exact for finite x. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double one = 1.0, half=0.5, huge = 1.0e300; @@ -79,3 +84,12 @@ cosh(double x) /* |x| > overflowthresold, cosh(x) overflow */ return huge*huge; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double coshl(long double); +#else /* lint */ +__weak_alias(coshl, cosh); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_exp.c b/lib/libm/src/e_exp.c index 23c1d2888b5..a9a4fcb40b8 100644 --- a/lib/libm/src/e_exp.c +++ b/lib/libm/src/e_exp.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* exp(x) * Returns the exponential of x. * @@ -73,7 +75,10 @@ * to produce the hexadecimal values shown. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -153,3 +158,12 @@ exp(double x) /* default IEEE double exp */ return y*twom1000; } } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double expl(long double); +#else /* lint */ +__weak_alias(expl, exp); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_fmod.c b/lib/libm/src/e_fmod.c index e2b2f0a0b53..36cc8e81cd8 100644 --- a/lib/libm/src/e_fmod.c +++ b/lib/libm/src/e_fmod.c @@ -10,13 +10,18 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* * fmod(x,y) * Return x mod y in exact arithmetic * Method: shift and subtract */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double one = 1.0, Zero[] = {0.0, -0.0,}; @@ -126,3 +131,12 @@ fmod(double x, double y) } return x; /* exact output */ } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double fmodl(long double, long double); +#else /* lint */ +__weak_alias(fmodl, fmod); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_hypot.c b/lib/libm/src/e_hypot.c index d5d86fb53a2..011cd47aa57 100644 --- a/lib/libm/src/e_hypot.c +++ b/lib/libm/src/e_hypot.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* hypot(x,y) * * Method : @@ -42,7 +44,10 @@ * than 1 ulps (units in the last place) */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" double @@ -118,3 +123,12 @@ hypot(double x, double y) return t1*w; } else return w; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double hypotl(long double, long double); +#else /* lint */ +__weak_alias(hypotl, hypot); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_log.c b/lib/libm/src/e_log.c index 3c3c63d8098..7d4dcdd5e87 100644 --- a/lib/libm/src/e_log.c +++ b/lib/libm/src/e_log.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* log(x) * Return the logrithm of x * @@ -61,7 +63,10 @@ * to produce the hexadecimal values shown. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -128,3 +133,12 @@ log(double x) return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f); } } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double logl(long double); +#else /* lint */ +__weak_alias(logl, log); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_log10.c b/lib/libm/src/e_log10.c index e6b826c229b..a4178648a1d 100644 --- a/lib/libm/src/e_log10.c +++ b/lib/libm/src/e_log10.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* log10(x) * Return the base 10 logarithm of x * @@ -43,7 +45,10 @@ * shown. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -80,3 +85,12 @@ log10(double x) z = y*log10_2lo + ivln10*log(x); return z+y*log10_2hi; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double log10l(long double); +#else /* lint */ +__weak_alias(log10l, log10); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_log2.c b/lib/libm/src/e_log2.c index aed716670dc..89ed4a774ea 100644 --- a/lib/libm/src/e_log2.c +++ b/lib/libm/src/e_log2.c @@ -10,7 +10,12 @@ * ==================================================== */ -#include "math.h" +/* LINTLIBRARY */ + +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -72,3 +77,12 @@ log2(double x) } else return (dk-((s*(f-R))-f)/ln2); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double log2l(long double); +#else /* lint */ +__weak_alias(log2l, log2); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_pow.c b/lib/libm/src/e_pow.c index 938b37cc798..e342119e9a4 100644 --- a/lib/libm/src/e_pow.c +++ b/lib/libm/src/e_pow.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* pow(x,y) return x**y * * n @@ -55,7 +57,10 @@ * to produce the hexadecimal values shown. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -295,3 +300,12 @@ pow(double x, double y) else SET_HIGH_WORD(z,j); return s*z; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double powl(long double, long double); +#else /* lint */ +__weak_alias(powl, pow); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_remainder.c b/lib/libm/src/e_remainder.c index 3d7839700e7..2a9fbc8eb8a 100644 --- a/lib/libm/src/e_remainder.c +++ b/lib/libm/src/e_remainder.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* remainder(x,p) * Return : * returns x REM p = x - [x/p]*p as if in infinite @@ -19,7 +21,10 @@ * Based on fmod() return x-[x/p]chopped*p exactlp. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double zero = 0.0; @@ -66,3 +71,12 @@ remainder(double x, double p) SET_HIGH_WORD(x,hx^sx); return x; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double remainderl(long double, long double); +#else /* lint */ +__weak_alias(remainderl, remainder); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/e_remainderl.c b/lib/libm/src/e_remainderl.c new file mode 100644 index 00000000000..732b62f4963 --- /dev/null +++ b/lib/libm/src/e_remainderl.c @@ -0,0 +1,27 @@ +/* $OpenBSD: e_remainderl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2011 Martynas Venckus <martynas@openbsd.org> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#include <math.h> + +long double +remainderl(long double x, long double y) +{ + int quo; + + return (remquol(x, y, &quo)); +} diff --git a/lib/libm/src/e_sinh.c b/lib/libm/src/e_sinh.c index a2dbe01acec..3c7d1da237e 100644 --- a/lib/libm/src/e_sinh.c +++ b/lib/libm/src/e_sinh.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* sinh(x) * Method : * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 @@ -28,7 +30,10 @@ * only sinh(0)=0 is exact for finite x. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double one = 1.0, shuge = 1.0e307; @@ -72,3 +77,12 @@ sinh(double x) /* |x| > overflowthresold, sinh(x) overflow */ return x*shuge; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double sinhl(long double); +#else /* lint */ +__weak_alias(sinhl, sinh); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/ld128/e_acoshl.c b/lib/libm/src/ld128/e_acoshl.c new file mode 100644 index 00000000000..dd8197f259f --- /dev/null +++ b/lib/libm/src/ld128/e_acoshl.c @@ -0,0 +1,58 @@ +/* @(#)e_acosh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* acoshl(x) + * Method : + * Based on + * acoshl(x) = logl [ x + sqrtl(x*x-1) ] + * we have + * acoshl(x) := logl(x)+ln2, if x is large; else + * acoshl(x) := logl(2x-1/(sqrtl(x*x-1)+x)) if x>2; else + * acoshl(x) := log1pl(t+sqrtl(2.0*t+t*t)); where t=x-1. + * + * Special cases: + * acoshl(x) is NaN with signal if x<1. + * acoshl(NaN) is NaN without signal. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double +one = 1.0, +ln2 = 0.6931471805599453094172321214581766L; + +long double +acoshl(long double x) +{ + long double t; + u_int64_t lx; + int64_t hx; + GET_LDOUBLE_WORDS64(hx,lx,x); + if(hx<0x3fff000000000000LL) { /* x < 1 */ + return (x-x)/(x-x); + } else if(hx >=0x4035000000000000LL) { /* x > 2**54 */ + if(hx >=0x7fff000000000000LL) { /* x is inf of NaN */ + return x+x; + } else + return logl(x)+ln2; /* acoshl(huge)=logl(2x) */ + } else if(((hx-0x3fff000000000000LL)|lx)==0) { + return 0.0L; /* acosh(1) = 0 */ + } else if (hx > 0x4000000000000000LL) { /* 2**28 > x > 2 */ + t=x*x; + return logl(2.0L*x-one/(x+sqrtl(t-one))); + } else { /* 1<x<2 */ + t = x-one; + return log1pl(t+sqrtl(2.0L*t+t*t)); + } +} diff --git a/lib/libm/src/ld128/e_atanhl.c b/lib/libm/src/ld128/e_atanhl.c new file mode 100644 index 00000000000..51485b3d5b7 --- /dev/null +++ b/lib/libm/src/ld128/e_atanhl.c @@ -0,0 +1,65 @@ +/* @(#)e_atanh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* atanhl(x) + * Method : + * 1.Reduced x to positive by atanh(-x) = -atanh(x) + * 2.For x>=0.5 + * 1 2x x + * atanhl(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) + * 2 1 - x 1 - x + * + * For x<0.5 + * atanhl(x) = 0.5*log1pl(2x+2x*x/(1-x)) + * + * Special cases: + * atanhl(x) is NaN if |x| > 1 with signal; + * atanhl(NaN) is that NaN with no signal; + * atanhl(+-1) is +-INF with signal. + * + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0L, huge = 1e4900L; + +static const long double zero = 0.0L; + +long double +atanhl(long double x) +{ + long double t; + u_int32_t jx, ix; + ieee_quad_shape_type u; + + u.value = x; + jx = u.parts32.mswhi; + ix = jx & 0x7fffffff; + u.parts32.mswhi = ix; + if (ix >= 0x3fff0000) /* |x| >= 1.0 or infinity or NaN */ + { + if (u.value == one) + return x/zero; + else + return (x-x)/(x-x); + } + if(ix<0x3fc60000 && (huge+x)>zero) return x; /* x < 2^-57 */ + + if(ix<0x3ffe0000) { /* x < 0.5 */ + t = u.value+u.value; + t = 0.5*log1pl(t+t*u.value/(one-u.value)); + } else + t = 0.5*log1pl((u.value+u.value)/(one-u.value)); + if(jx & 0x80000000) return -t; else return t; +} diff --git a/lib/libm/src/ld128/e_coshl.c b/lib/libm/src/ld128/e_coshl.c new file mode 100644 index 00000000000..3098c7b625d --- /dev/null +++ b/lib/libm/src/ld128/e_coshl.c @@ -0,0 +1,105 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* coshl(x) + * Method : + * mathematically coshl(x) if defined to be (exp(x)+exp(-x))/2 + * 1. Replace x by |x| (coshl(x) = coshl(-x)). + * 2. + * [ exp(x) - 1 ]^2 + * 0 <= x <= ln2/2 : coshl(x) := 1 + ------------------- + * 2*exp(x) + * + * exp(x) + 1/exp(x) + * ln2/2 <= x <= 22 : coshl(x) := ------------------- + * 2 + * 22 <= x <= lnovft : coshl(x) := expl(x)/2 + * lnovft <= x <= ln2ovft: coshl(x) := expl(x/2)/2 * expl(x/2) + * ln2ovft < x : coshl(x) := huge*huge (overflow) + * + * Special cases: + * coshl(x) is |x| if x is +INF, -INF, or NaN. + * only coshl(0)=1 is exact for finite x. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0, half = 0.5, huge = 1.0e4900L, +ovf_thresh = 1.1357216553474703894801348310092223067821E4L; + +long double +coshl(long double x) +{ + long double t, w; + int32_t ex; + ieee_quad_shape_type u; + + u.value = x; + ex = u.parts32.mswhi & 0x7fffffff; + + /* Absolute value of x. */ + u.parts32.mswhi = ex; + + /* x is INF or NaN */ + if (ex >= 0x7fff0000) + return x * x; + + /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */ + if (ex < 0x3ffd62e4) /* 0.3465728759765625 */ + { + t = expm1l (u.value); + w = one + t; + if (ex < 0x3fb80000) /* |x| < 2^-116 */ + return w; /* cosh(tiny) = 1 */ + + return one + (t * t) / (w + w); + } + + /* |x| in [0.5*ln2,40], return (exp(|x|)+1/exp(|x|)/2; */ + if (ex < 0x40044000) + { + t = expl (u.value); + return half * t + half / t; + } + + /* |x| in [22, ln(maxdouble)] return half*exp(|x|) */ + if (ex <= 0x400c62e3) /* 11356.375 */ + return half * expl (u.value); + + /* |x| in [log(maxdouble), overflowthresold] */ + if (u.value <= ovf_thresh) + { + w = expl (half * u.value); + t = half * w; + return t * w; + } + + /* |x| > overflowthresold, cosh(x) overflow */ + return huge * huge; +} diff --git a/lib/libm/src/ld128/e_expl.c b/lib/libm/src/ld128/e_expl.c new file mode 100644 index 00000000000..6ef65e83a04 --- /dev/null +++ b/lib/libm/src/ld128/e_expl.c @@ -0,0 +1,145 @@ +/* $OpenBSD: e_expl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* expl.c + * + * Exponential function, 128-bit long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, expl(); + * + * y = expl( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * A Pade' form of degree 2/3 is used to approximate exp(f) - 1 + * in the basic range [-0.5 ln 2, 0.5 ln 2]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-MAXLOG 100,000 2.6e-34 8.6e-35 + * + * + * Error amplification in the exponential function can be + * a serious matter. The error propagation involves + * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), + * which shows that a 1 lsb error in representing X produces + * a relative error of X times 1 lsb in the function. + * While the routine gives an accurate result for arguments + * that are exactly represented by a long double precision + * computer number, the result contains amplified roundoff + * error for large arguments not exactly represented. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * exp underflow x < MINLOG 0.0 + * exp overflow x > MAXLOG MAXNUM + * + */ + +/* Exponential function */ + +#include <float.h> +#include <math.h> + +/* Pade' coefficients for exp(x) - 1 + Theoretical peak relative error = 2.2e-37, + relative peak error spread = 9.2e-38 + */ +static long double P[5] = { + 3.279723985560247033712687707263393506266E-10L, + 6.141506007208645008909088812338454698548E-7L, + 2.708775201978218837374512615596512792224E-4L, + 3.508710990737834361215404761139478627390E-2L, + 9.999999999999999999999999999999999998502E-1L +}; +static long double Q[6] = { + 2.980756652081995192255342779918052538681E-12L, + 1.771372078166251484503904874657985291164E-8L, + 1.504792651814944826817779302637284053660E-5L, + 3.611828913847589925056132680618007270344E-3L, + 2.368408864814233538909747618894558968880E-1L, + 2.000000000000000000000000000000000000150E0L +}; +/* C1 + C2 = ln 2 */ +static long double C1 = -6.93145751953125E-1L; +static long double C2 = -1.428606820309417232121458176568075500134E-6L; + +static long double LOG2EL = 1.442695040888963407359924681001892137426646L; +static long double MAXLOGL = 1.1356523406294143949491931077970764891253E4L; +static long double MINLOGL = -1.143276959615573793352782661133116431383730e4L; +static const long double huge = 0x1p10000L; +#if 0 /* XXX Prevent gcc from erroneously constant folding this. */ +static const long double twom10000 = 0x1p-10000L; +#else +static volatile long double twom10000 = 0x1p-10000L; +#endif + +extern long double __polevll(long double, void *, int); + +long double +expl(long double x) +{ +long double px, xx; +int n; + +if( x > MAXLOGL) + return (huge*huge); /* overflow */ + +if( x < MINLOGL ) + return (twom10000*twom10000); /* underflow */ + +/* Express e**x = e**g 2**n + * = e**g e**( n loge(2) ) + * = e**( g + n loge(2) ) + */ +px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */ +n = px; +x += px * C1; +x += px * C2; +/* rational approximation for exponential + * of the fractional part: + * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) + */ +xx = x * x; +px = x * __polevll( xx, P, 4 ); +xx = __polevll( xx, Q, 5 ); +x = px/( xx - px ); +x = 1.0L + x + x; + +x = ldexpl( x, n ); +return(x); +} diff --git a/lib/libm/src/ld128/e_fmodl.c b/lib/libm/src/ld128/e_fmodl.c new file mode 100644 index 00000000000..cb629ddd7be --- /dev/null +++ b/lib/libm/src/ld128/e_fmodl.c @@ -0,0 +1,129 @@ +/* @(#)e_fmod.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * fmodl(x,y) + * Return x mod y in exact arithmetic + * Method: shift and subtract + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0, Zero[] = {0.0, -0.0,}; + +long double +fmodl(long double x, long double y) +{ + int64_t n,hx,hy,hz,ix,iy,sx,i; + u_int64_t lx,ly,lz; + + GET_LDOUBLE_WORDS64(hx,lx,x); + GET_LDOUBLE_WORDS64(hy,ly,y); + sx = hx&0x8000000000000000ULL; /* sign of x */ + hx ^=sx; /* |x| */ + hy &= 0x7fffffffffffffffLL; /* |y| */ + + /* purge off exception values */ + if((hy|ly)==0||(hx>=0x7fff000000000000LL)|| /* y=0,or x not finite */ + ((hy|((ly|-ly)>>63))>0x7fff000000000000LL)) /* or y is NaN */ + return (x*y)/(x*y); + if(hx<=hy) { + if((hx<hy)||(lx<ly)) return x; /* |x|<|y| return x */ + if(lx==ly) + return Zero[(u_int64_t)sx>>63]; /* |x|=|y| return x*0*/ + } + + /* determine ix = ilogb(x) */ + if(hx<0x0001000000000000LL) { /* subnormal x */ + if(hx==0) { + for (ix = -16431, i=lx; i>0; i<<=1) ix -=1; + } else { + for (ix = -16382, i=hx<<15; i>0; i<<=1) ix -=1; + } + } else ix = (hx>>48)-0x3fff; + + /* determine iy = ilogb(y) */ + if(hy<0x0001000000000000LL) { /* subnormal y */ + if(hy==0) { + for (iy = -16431, i=ly; i>0; i<<=1) iy -=1; + } else { + for (iy = -16382, i=hy<<15; i>0; i<<=1) iy -=1; + } + } else iy = (hy>>48)-0x3fff; + + /* set up {hx,lx}, {hy,ly} and align y to x */ + if(ix >= -16382) + hx = 0x0001000000000000LL|(0x0000ffffffffffffLL&hx); + else { /* subnormal x, shift x to normal */ + n = -16382-ix; + if(n<=63) { + hx = (hx<<n)|(lx>>(64-n)); + lx <<= n; + } else { + hx = lx<<(n-64); + lx = 0; + } + } + if(iy >= -16382) + hy = 0x0001000000000000LL|(0x0000ffffffffffffLL&hy); + else { /* subnormal y, shift y to normal */ + n = -16382-iy; + if(n<=63) { + hy = (hy<<n)|(ly>>(64-n)); + ly <<= n; + } else { + hy = ly<<(n-64); + ly = 0; + } + } + + /* fix point fmod */ + n = ix - iy; + while(n--) { + hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz<0){hx = hx+hx+(lx>>63); lx = lx+lx;} + else { + if((hz|lz)==0) /* return sign(x)*0 */ + return Zero[(u_int64_t)sx>>63]; + hx = hz+hz+(lz>>63); lx = lz+lz; + } + } + hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz>=0) {hx=hz;lx=lz;} + + /* convert back to floating value and restore the sign */ + if((hx|lx)==0) /* return sign(x)*0 */ + return Zero[(u_int64_t)sx>>63]; + while(hx<0x0001000000000000LL) { /* normalize x */ + hx = hx+hx+(lx>>63); lx = lx+lx; + iy -= 1; + } + if(iy>= -16382) { /* normalize output */ + hx = ((hx-0x0001000000000000LL)|((iy+16383)<<48)); + SET_LDOUBLE_WORDS64(x,hx|sx,lx); + } else { /* subnormal output */ + n = -16382 - iy; + if(n<=48) { + lx = (lx>>n)|((u_int64_t)hx<<(64-n)); + hx >>= n; + } else if (n<=63) { + lx = (hx<<(64-n))|(lx>>n); hx = sx; + } else { + lx = hx>>(n-64); hx = sx; + } + SET_LDOUBLE_WORDS64(x,hx|sx,lx); + x *= one; /* create necessary signal */ + } + return x; /* exact output */ +} diff --git a/lib/libm/src/ld128/e_hypotl.c b/lib/libm/src/ld128/e_hypotl.c new file mode 100644 index 00000000000..ff642d9ce91 --- /dev/null +++ b/lib/libm/src/ld128/e_hypotl.c @@ -0,0 +1,122 @@ +/* @(#)e_hypot.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* hypotl(x,y) + * + * Method : + * If (assume round-to-nearest) z=x*x+y*y + * has error less than sqrtl(2)/2 ulp, than + * sqrtl(z) has error less than 1 ulp (exercise). + * + * So, compute sqrtl(x*x+y*y) with some care as + * follows to get the error below 1 ulp: + * + * Assume x>y>0; + * (if possible, set rounding to round-to-nearest) + * 1. if x > 2y use + * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y + * where x1 = x with lower 64 bits cleared, x2 = x-x1; else + * 2. if x <= 2y use + * t1*yy1+((x-y)*(x-y)+(t1*y2+t2*y)) + * where t1 = 2x with lower 64 bits cleared, t2 = 2x-t1, + * yy1= y with lower 64 bits chopped, y2 = y-yy1. + * + * NOTE: scaling may be necessary if some argument is too + * large or too tiny + * + * Special cases: + * hypotl(x,y) is INF if x or y is +INF or -INF; else + * hypotl(x,y) is NAN if x or y is NAN. + * + * Accuracy: + * hypotl(x,y) returns sqrtl(x^2+y^2) with error less + * than 1 ulps (units in the last place) + */ + +#include <math.h> + +#include "math_private.h" + +long double +hypotl(long double x, long double y) +{ + long double a,b,t1,t2,yy1,y2,w; + int64_t j,k,ha,hb; + + GET_LDOUBLE_MSW64(ha,x); + ha &= 0x7fffffffffffffffLL; + GET_LDOUBLE_MSW64(hb,y); + hb &= 0x7fffffffffffffffLL; + if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;} + SET_LDOUBLE_MSW64(a,ha); /* a <- |a| */ + SET_LDOUBLE_MSW64(b,hb); /* b <- |b| */ + if((ha-hb)>0x78000000000000LL) {return a+b;} /* x/y > 2**120 */ + k=0; + if(ha > 0x5f3f000000000000LL) { /* a>2**8000 */ + if(ha >= 0x7fff000000000000LL) { /* Inf or NaN */ + u_int64_t low; + w = a+b; /* for sNaN */ + GET_LDOUBLE_LSW64(low,a); + if(((ha&0xffffffffffffLL)|low)==0) w = a; + GET_LDOUBLE_LSW64(low,b); + if(((hb^0x7fff000000000000LL)|low)==0) w = b; + return w; + } + /* scale a and b by 2**-9600 */ + ha -= 0x2580000000000000LL; + hb -= 0x2580000000000000LL; k += 9600; + SET_LDOUBLE_MSW64(a,ha); + SET_LDOUBLE_MSW64(b,hb); + } + if(hb < 0x20bf000000000000LL) { /* b < 2**-8000 */ + if(hb <= 0x0000ffffffffffffLL) { /* subnormal b or 0 */ + u_int64_t low; + GET_LDOUBLE_LSW64(low,b); + if((hb|low)==0) return a; + t1=0; + SET_LDOUBLE_MSW64(t1,0x7ffd000000000000LL); /* t1=2^16382 */ + b *= t1; + a *= t1; + k -= 16382; + } else { /* scale a and b by 2^9600 */ + ha += 0x2580000000000000LL; /* a *= 2^9600 */ + hb += 0x2580000000000000LL; /* b *= 2^9600 */ + k -= 9600; + SET_LDOUBLE_MSW64(a,ha); + SET_LDOUBLE_MSW64(b,hb); + } + } + /* medium size a and b */ + w = a-b; + if (w>b) { + t1 = 0; + SET_LDOUBLE_MSW64(t1,ha); + t2 = a-t1; + w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); + } else { + a = a+a; + yy1 = 0; + SET_LDOUBLE_MSW64(yy1,hb); + y2 = b - yy1; + t1 = 0; + SET_LDOUBLE_MSW64(t1,ha+0x0001000000000000LL); + t2 = a - t1; + w = sqrtl(t1*yy1-(w*(-w)-(t1*y2+t2*b))); + } + if(k!=0) { + u_int64_t high; + t1 = 1.0L; + GET_LDOUBLE_MSW64(high,t1); + SET_LDOUBLE_MSW64(t1,high+(k<<48)); + return t1*w; + } else return w; +} diff --git a/lib/libm/src/ld128/e_lgammal.c b/lib/libm/src/ld128/e_lgammal.c new file mode 100644 index 00000000000..3464271c776 --- /dev/null +++ b/lib/libm/src/ld128/e_lgammal.c @@ -0,0 +1,1037 @@ +/* $OpenBSD: e_lgammal.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* lgammal + * + * Natural logarithm of gamma function + * + * + * + * SYNOPSIS: + * + * long double x, y, lgammal(); + * extern int signgam; + * + * y = lgammal(x); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of the absolute + * value of the gamma function of the argument. + * The sign (+1 or -1) of the gamma function is returned in a + * global (extern) variable named signgam. + * + * The positive domain is partitioned into numerous segments for approximation. + * For x > 10, + * log gamma(x) = (x - 0.5) log(x) - x + log sqrt(2 pi) + 1/x R(1/x^2) + * Near the minimum at x = x0 = 1.46... the approximation is + * log gamma(x0 + z) = log gamma(x0) + z^2 P(z)/Q(z) + * for small z. + * Elsewhere between 0 and 10, + * log gamma(n + z) = log gamma(n) + z P(z)/Q(z) + * for various selected n and small z. + * + * The cosecant reflection formula is employed for negative arguments. + * + * + * + * ACCURACY: + * + * + * arithmetic domain # trials peak rms + * Relative error: + * IEEE 10, 30 100000 3.9e-34 9.8e-35 + * IEEE 0, 10 100000 3.8e-34 5.3e-35 + * Absolute error: + * IEEE -10, 0 100000 8.0e-34 8.0e-35 + * IEEE -30, -10 100000 4.4e-34 1.0e-34 + * IEEE -100, 100 100000 1.0e-34 + * + * The absolute error criterion is the same as relative error + * when the function magnitude is greater than one but it is absolute + * when the magnitude is less than one. + * + */ + +#include <math.h> + +#include "math_private.h" + +static const long double PIL = 3.1415926535897932384626433832795028841972E0L; +static const long double MAXLGM = 1.0485738685148938358098967157129705071571E4928L; +static const long double one = 1.0L; +static const long double huge = 1.0e4000L; + +/* log gamma(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x P(1/x^2) + 1/x <= 0.0741 (x >= 13.495...) + Peak relative error 1.5e-36 */ +static const long double ls2pi = 9.1893853320467274178032973640561763986140E-1L; +#define NRASY 12 +static const long double RASY[NRASY + 1] = +{ + 8.333333333333333333333333333310437112111E-2L, + -2.777777777777777777777774789556228296902E-3L, + 7.936507936507936507795933938448586499183E-4L, + -5.952380952380952041799269756378148574045E-4L, + 8.417508417507928904209891117498524452523E-4L, + -1.917526917481263997778542329739806086290E-3L, + 6.410256381217852504446848671499409919280E-3L, + -2.955064066900961649768101034477363301626E-2L, + 1.796402955865634243663453415388336954675E-1L, + -1.391522089007758553455753477688592767741E0L, + 1.326130089598399157988112385013829305510E1L, + -1.420412699593782497803472576479997819149E2L, + 1.218058922427762808938869872528846787020E3L +}; + + +/* log gamma(x+13) = log gamma(13) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 12.5 <= x+13 <= 13.5 + Peak relative error 1.1e-36 */ +static const long double lgam13a = 1.9987213134765625E1L; +static const long double lgam13b = 1.3608962611495173623870550785125024484248E-6L; +#define NRN13 7 +static const long double RN13[NRN13 + 1] = +{ + 8.591478354823578150238226576156275285700E11L, + 2.347931159756482741018258864137297157668E11L, + 2.555408396679352028680662433943000804616E10L, + 1.408581709264464345480765758902967123937E9L, + 4.126759849752613822953004114044451046321E7L, + 6.133298899622688505854211579222889943778E5L, + 3.929248056293651597987893340755876578072E3L, + 6.850783280018706668924952057996075215223E0L +}; +#define NRD13 6 +static const long double RD13[NRD13 + 1] = +{ + 3.401225382297342302296607039352935541669E11L, + 8.756765276918037910363513243563234551784E10L, + 8.873913342866613213078554180987647243903E9L, + 4.483797255342763263361893016049310017973E8L, + 1.178186288833066430952276702931512870676E7L, + 1.519928623743264797939103740132278337476E5L, + 7.989298844938119228411117593338850892311E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+12) = log gamma(12) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 11.5 <= x+12 <= 12.5 + Peak relative error 4.1e-36 */ +static const long double lgam12a = 1.75023040771484375E1L; +static const long double lgam12b = 3.7687254483392876529072161996717039575982E-6L; +#define NRN12 7 +static const long double RN12[NRN12 + 1] = +{ + 4.709859662695606986110997348630997559137E11L, + 1.398713878079497115037857470168777995230E11L, + 1.654654931821564315970930093932954900867E10L, + 9.916279414876676861193649489207282144036E8L, + 3.159604070526036074112008954113411389879E7L, + 5.109099197547205212294747623977502492861E5L, + 3.563054878276102790183396740969279826988E3L, + 6.769610657004672719224614163196946862747E0L +}; +#define NRD12 6 +static const long double RD12[NRD12 + 1] = +{ + 1.928167007860968063912467318985802726613E11L, + 5.383198282277806237247492369072266389233E10L, + 5.915693215338294477444809323037871058363E9L, + 3.241438287570196713148310560147925781342E8L, + 9.236680081763754597872713592701048455890E6L, + 1.292246897881650919242713651166596478850E5L, + 7.366532445427159272584194816076600211171E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+11) = log gamma(11) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 10.5 <= x+11 <= 11.5 + Peak relative error 1.8e-35 */ +static const long double lgam11a = 1.5104400634765625E1L; +static const long double lgam11b = 1.1938309890295225709329251070371882250744E-5L; +#define NRN11 7 +static const long double RN11[NRN11 + 1] = +{ + 2.446960438029415837384622675816736622795E11L, + 7.955444974446413315803799763901729640350E10L, + 1.030555327949159293591618473447420338444E10L, + 6.765022131195302709153994345470493334946E8L, + 2.361892792609204855279723576041468347494E7L, + 4.186623629779479136428005806072176490125E5L, + 3.202506022088912768601325534149383594049E3L, + 6.681356101133728289358838690666225691363E0L +}; +#define NRD11 6 +static const long double RD11[NRD11 + 1] = +{ + 1.040483786179428590683912396379079477432E11L, + 3.172251138489229497223696648369823779729E10L, + 3.806961885984850433709295832245848084614E9L, + 2.278070344022934913730015420611609620171E8L, + 7.089478198662651683977290023829391596481E6L, + 1.083246385105903533237139380509590158658E5L, + 6.744420991491385145885727942219463243597E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+10) = log gamma(10) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 9.5 <= x+10 <= 10.5 + Peak relative error 5.4e-37 */ +static const long double lgam10a = 1.280181884765625E1L; +static const long double lgam10b = 8.6324252196112077178745667061642811492557E-6L; +#define NRN10 7 +static const long double RN10[NRN10 + 1] = +{ + -1.239059737177249934158597996648808363783E14L, + -4.725899566371458992365624673357356908719E13L, + -7.283906268647083312042059082837754850808E12L, + -5.802855515464011422171165179767478794637E11L, + -2.532349691157548788382820303182745897298E10L, + -5.884260178023777312587193693477072061820E8L, + -6.437774864512125749845840472131829114906E6L, + -2.350975266781548931856017239843273049384E4L +}; +#define NRD10 7 +static const long double RD10[NRD10 + 1] = +{ + -5.502645997581822567468347817182347679552E13L, + -1.970266640239849804162284805400136473801E13L, + -2.819677689615038489384974042561531409392E12L, + -2.056105863694742752589691183194061265094E11L, + -8.053670086493258693186307810815819662078E9L, + -1.632090155573373286153427982504851867131E8L, + -1.483575879240631280658077826889223634921E6L, + -4.002806669713232271615885826373550502510E3L + /* 1.0E0L */ +}; + + +/* log gamma(x+9) = log gamma(9) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 8.5 <= x+9 <= 9.5 + Peak relative error 3.6e-36 */ +static const long double lgam9a = 1.06045989990234375E1L; +static const long double lgam9b = 3.9037218127284172274007216547549861681400E-6L; +#define NRN9 7 +static const long double RN9[NRN9 + 1] = +{ + -4.936332264202687973364500998984608306189E13L, + -2.101372682623700967335206138517766274855E13L, + -3.615893404644823888655732817505129444195E12L, + -3.217104993800878891194322691860075472926E11L, + -1.568465330337375725685439173603032921399E10L, + -4.073317518162025744377629219101510217761E8L, + -4.983232096406156139324846656819246974500E6L, + -2.036280038903695980912289722995505277253E4L +}; +#define NRD9 7 +static const long double RD9[NRD9 + 1] = +{ + -2.306006080437656357167128541231915480393E13L, + -9.183606842453274924895648863832233799950E12L, + -1.461857965935942962087907301194381010380E12L, + -1.185728254682789754150068652663124298303E11L, + -5.166285094703468567389566085480783070037E9L, + -1.164573656694603024184768200787835094317E8L, + -1.177343939483908678474886454113163527909E6L, + -3.529391059783109732159524500029157638736E3L + /* 1.0E0L */ +}; + + +/* log gamma(x+8) = log gamma(8) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 7.5 <= x+8 <= 8.5 + Peak relative error 2.4e-37 */ +static const long double lgam8a = 8.525146484375E0L; +static const long double lgam8b = 1.4876690414300165531036347125050759667737E-5L; +#define NRN8 8 +static const long double RN8[NRN8 + 1] = +{ + 6.600775438203423546565361176829139703289E11L, + 3.406361267593790705240802723914281025800E11L, + 7.222460928505293914746983300555538432830E10L, + 8.102984106025088123058747466840656458342E9L, + 5.157620015986282905232150979772409345927E8L, + 1.851445288272645829028129389609068641517E7L, + 3.489261702223124354745894067468953756656E5L, + 2.892095396706665774434217489775617756014E3L, + 6.596977510622195827183948478627058738034E0L +}; +#define NRD8 7 +static const long double RD8[NRD8 + 1] = +{ + 3.274776546520735414638114828622673016920E11L, + 1.581811207929065544043963828487733970107E11L, + 3.108725655667825188135393076860104546416E10L, + 3.193055010502912617128480163681842165730E9L, + 1.830871482669835106357529710116211541839E8L, + 5.790862854275238129848491555068073485086E6L, + 9.305213264307921522842678835618803553589E4L, + 6.216974105861848386918949336819572333622E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+7) = log gamma(7) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 6.5 <= x+7 <= 7.5 + Peak relative error 3.2e-36 */ +static const long double lgam7a = 6.5792388916015625E0L; +static const long double lgam7b = 1.2320408538495060178292903945321122583007E-5L; +#define NRN7 8 +static const long double RN7[NRN7 + 1] = +{ + 2.065019306969459407636744543358209942213E11L, + 1.226919919023736909889724951708796532847E11L, + 2.996157990374348596472241776917953749106E10L, + 3.873001919306801037344727168434909521030E9L, + 2.841575255593761593270885753992732145094E8L, + 1.176342515359431913664715324652399565551E7L, + 2.558097039684188723597519300356028511547E5L, + 2.448525238332609439023786244782810774702E3L, + 6.460280377802030953041566617300902020435E0L +}; +#define NRD7 7 +static const long double RD7[NRD7 + 1] = +{ + 1.102646614598516998880874785339049304483E11L, + 6.099297512712715445879759589407189290040E10L, + 1.372898136289611312713283201112060238351E10L, + 1.615306270420293159907951633566635172343E9L, + 1.061114435798489135996614242842561967459E8L, + 3.845638971184305248268608902030718674691E6L, + 7.081730675423444975703917836972720495507E4L, + 5.423122582741398226693137276201344096370E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+6) = log gamma(6) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 5.5 <= x+6 <= 6.5 + Peak relative error 6.2e-37 */ +static const long double lgam6a = 4.7874908447265625E0L; +static const long double lgam6b = 8.9805548349424770093452324304839959231517E-7L; +#define NRN6 8 +static const long double RN6[NRN6 + 1] = +{ + -3.538412754670746879119162116819571823643E13L, + -2.613432593406849155765698121483394257148E13L, + -8.020670732770461579558867891923784753062E12L, + -1.322227822931250045347591780332435433420E12L, + -1.262809382777272476572558806855377129513E11L, + -7.015006277027660872284922325741197022467E9L, + -2.149320689089020841076532186783055727299E8L, + -3.167210585700002703820077565539658995316E6L, + -1.576834867378554185210279285358586385266E4L +}; +#define NRD6 8 +static const long double RD6[NRD6 + 1] = +{ + -2.073955870771283609792355579558899389085E13L, + -1.421592856111673959642750863283919318175E13L, + -4.012134994918353924219048850264207074949E12L, + -6.013361045800992316498238470888523722431E11L, + -5.145382510136622274784240527039643430628E10L, + -2.510575820013409711678540476918249524123E9L, + -6.564058379709759600836745035871373240904E7L, + -7.861511116647120540275354855221373571536E5L, + -2.821943442729620524365661338459579270561E3L + /* 1.0E0L */ +}; + + +/* log gamma(x+5) = log gamma(5) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 4.5 <= x+5 <= 5.5 + Peak relative error 3.4e-37 */ +static const long double lgam5a = 3.17803955078125E0L; +static const long double lgam5b = 1.4279566695619646941601297055408873990961E-5L; +#define NRN5 9 +static const long double RN5[NRN5 + 1] = +{ + 2.010952885441805899580403215533972172098E11L, + 1.916132681242540921354921906708215338584E11L, + 7.679102403710581712903937970163206882492E10L, + 1.680514903671382470108010973615268125169E10L, + 2.181011222911537259440775283277711588410E9L, + 1.705361119398837808244780667539728356096E8L, + 7.792391565652481864976147945997033946360E6L, + 1.910741381027985291688667214472560023819E5L, + 2.088138241893612679762260077783794329559E3L, + 6.330318119566998299106803922739066556550E0L +}; +#define NRD5 8 +static const long double RD5[NRD5 + 1] = +{ + 1.335189758138651840605141370223112376176E11L, + 1.174130445739492885895466097516530211283E11L, + 4.308006619274572338118732154886328519910E10L, + 8.547402888692578655814445003283720677468E9L, + 9.934628078575618309542580800421370730906E8L, + 6.847107420092173812998096295422311820672E7L, + 2.698552646016599923609773122139463150403E6L, + 5.526516251532464176412113632726150253215E4L, + 4.772343321713697385780533022595450486932E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+4) = log gamma(4) + x P(x)/Q(x) + -0.5 <= x <= 0.5 + 3.5 <= x+4 <= 4.5 + Peak relative error 6.7e-37 */ +static const long double lgam4a = 1.791748046875E0L; +static const long double lgam4b = 1.1422353055000812477358380702272722990692E-5L; +#define NRN4 9 +static const long double RN4[NRN4 + 1] = +{ + -1.026583408246155508572442242188887829208E13L, + -1.306476685384622809290193031208776258809E13L, + -7.051088602207062164232806511992978915508E12L, + -2.100849457735620004967624442027793656108E12L, + -3.767473790774546963588549871673843260569E11L, + -4.156387497364909963498394522336575984206E10L, + -2.764021460668011732047778992419118757746E9L, + -1.036617204107109779944986471142938641399E8L, + -1.895730886640349026257780896972598305443E6L, + -1.180509051468390914200720003907727988201E4L +}; +#define NRD4 9 +static const long double RD4[NRD4 + 1] = +{ + -8.172669122056002077809119378047536240889E12L, + -9.477592426087986751343695251801814226960E12L, + -4.629448850139318158743900253637212801682E12L, + -1.237965465892012573255370078308035272942E12L, + -1.971624313506929845158062177061297598956E11L, + -1.905434843346570533229942397763361493610E10L, + -1.089409357680461419743730978512856675984E9L, + -3.416703082301143192939774401370222822430E7L, + -4.981791914177103793218433195857635265295E5L, + -2.192507743896742751483055798411231453733E3L + /* 1.0E0L */ +}; + + +/* log gamma(x+3) = log gamma(3) + x P(x)/Q(x) + -0.25 <= x <= 0.5 + 2.75 <= x+3 <= 3.5 + Peak relative error 6.0e-37 */ +static const long double lgam3a = 6.93145751953125E-1L; +static const long double lgam3b = 1.4286068203094172321214581765680755001344E-6L; + +#define NRN3 9 +static const long double RN3[NRN3 + 1] = +{ + -4.813901815114776281494823863935820876670E11L, + -8.425592975288250400493910291066881992620E11L, + -6.228685507402467503655405482985516909157E11L, + -2.531972054436786351403749276956707260499E11L, + -6.170200796658926701311867484296426831687E10L, + -9.211477458528156048231908798456365081135E9L, + -8.251806236175037114064561038908691305583E8L, + -4.147886355917831049939930101151160447495E7L, + -1.010851868928346082547075956946476932162E6L, + -8.333374463411801009783402800801201603736E3L +}; +#define NRD3 9 +static const long double RD3[NRD3 + 1] = +{ + -5.216713843111675050627304523368029262450E11L, + -8.014292925418308759369583419234079164391E11L, + -5.180106858220030014546267824392678611990E11L, + -1.830406975497439003897734969120997840011E11L, + -3.845274631904879621945745960119924118925E10L, + -4.891033385370523863288908070309417710903E9L, + -3.670172254411328640353855768698287474282E8L, + -1.505316381525727713026364396635522516989E7L, + -2.856327162923716881454613540575964890347E5L, + -1.622140448015769906847567212766206894547E3L + /* 1.0E0L */ +}; + + +/* log gamma(x+2.5) = log gamma(2.5) + x P(x)/Q(x) + -0.125 <= x <= 0.25 + 2.375 <= x+2.5 <= 2.75 */ +static const long double lgam2r5a = 2.8466796875E-1L; +static const long double lgam2r5b = 1.4901722919159632494669682701924320137696E-5L; +#define NRN2r5 8 +static const long double RN2r5[NRN2r5 + 1] = +{ + -4.676454313888335499356699817678862233205E9L, + -9.361888347911187924389905984624216340639E9L, + -7.695353600835685037920815799526540237703E9L, + -3.364370100981509060441853085968900734521E9L, + -8.449902011848163568670361316804900559863E8L, + -1.225249050950801905108001246436783022179E8L, + -9.732972931077110161639900388121650470926E6L, + -3.695711763932153505623248207576425983573E5L, + -4.717341584067827676530426007495274711306E3L +}; +#define NRD2r5 8 +static const long double RD2r5[NRD2r5 + 1] = +{ + -6.650657966618993679456019224416926875619E9L, + -1.099511409330635807899718829033488771623E10L, + -7.482546968307837168164311101447116903148E9L, + -2.702967190056506495988922973755870557217E9L, + -5.570008176482922704972943389590409280950E8L, + -6.536934032192792470926310043166993233231E7L, + -4.101991193844953082400035444146067511725E6L, + -1.174082735875715802334430481065526664020E5L, + -9.932840389994157592102947657277692978511E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+2) = x P(x)/Q(x) + -0.125 <= x <= +0.375 + 1.875 <= x+2 <= 2.375 + Peak relative error 4.6e-36 */ +#define NRN2 9 +static const long double RN2[NRN2 + 1] = +{ + -3.716661929737318153526921358113793421524E9L, + -1.138816715030710406922819131397532331321E10L, + -1.421017419363526524544402598734013569950E10L, + -9.510432842542519665483662502132010331451E9L, + -3.747528562099410197957514973274474767329E9L, + -8.923565763363912474488712255317033616626E8L, + -1.261396653700237624185350402781338231697E8L, + -9.918402520255661797735331317081425749014E6L, + -3.753996255897143855113273724233104768831E5L, + -4.778761333044147141559311805999540765612E3L +}; +#define NRD2 9 +static const long double RD2[NRD2 + 1] = +{ + -8.790916836764308497770359421351673950111E9L, + -2.023108608053212516399197678553737477486E10L, + -1.958067901852022239294231785363504458367E10L, + -1.035515043621003101254252481625188704529E10L, + -3.253884432621336737640841276619272224476E9L, + -6.186383531162456814954947669274235815544E8L, + -6.932557847749518463038934953605969951466E7L, + -4.240731768287359608773351626528479703758E6L, + -1.197343995089189188078944689846348116630E5L, + -1.004622911670588064824904487064114090920E3L +/* 1.0E0 */ +}; + + +/* log gamma(x+1.75) = log gamma(1.75) + x P(x)/Q(x) + -0.125 <= x <= +0.125 + 1.625 <= x+1.75 <= 1.875 + Peak relative error 9.2e-37 */ +static const long double lgam1r75a = -8.441162109375E-2L; +static const long double lgam1r75b = 1.0500073264444042213965868602268256157604E-5L; +#define NRN1r75 8 +static const long double RN1r75[NRN1r75 + 1] = +{ + -5.221061693929833937710891646275798251513E7L, + -2.052466337474314812817883030472496436993E8L, + -2.952718275974940270675670705084125640069E8L, + -2.132294039648116684922965964126389017840E8L, + -8.554103077186505960591321962207519908489E7L, + -1.940250901348870867323943119132071960050E7L, + -2.379394147112756860769336400290402208435E6L, + -1.384060879999526222029386539622255797389E5L, + -2.698453601378319296159355612094598695530E3L +}; +#define NRD1r75 8 +static const long double RD1r75[NRD1r75 + 1] = +{ + -2.109754689501705828789976311354395393605E8L, + -5.036651829232895725959911504899241062286E8L, + -4.954234699418689764943486770327295098084E8L, + -2.589558042412676610775157783898195339410E8L, + -7.731476117252958268044969614034776883031E7L, + -1.316721702252481296030801191240867486965E7L, + -1.201296501404876774861190604303728810836E6L, + -5.007966406976106636109459072523610273928E4L, + -6.155817990560743422008969155276229018209E2L + /* 1.0E0L */ +}; + + +/* log gamma(x+x0) = y0 + x^2 P(x)/Q(x) + -0.0867 <= x <= +0.1634 + 1.374932... <= x+x0 <= 1.625032... + Peak relative error 4.0e-36 */ +static const long double x0a = 1.4616241455078125L; +static const long double x0b = 7.9994605498412626595423257213002588621246E-6L; +static const long double y0a = -1.21490478515625E-1L; +static const long double y0b = 4.1879797753919044854428223084178486438269E-6L; +#define NRN1r5 8 +static const long double RN1r5[NRN1r5 + 1] = +{ + 6.827103657233705798067415468881313128066E5L, + 1.910041815932269464714909706705242148108E6L, + 2.194344176925978377083808566251427771951E6L, + 1.332921400100891472195055269688876427962E6L, + 4.589080973377307211815655093824787123508E5L, + 8.900334161263456942727083580232613796141E4L, + 9.053840838306019753209127312097612455236E3L, + 4.053367147553353374151852319743594873771E2L, + 5.040631576303952022968949605613514584950E0L +}; +#define NRD1r5 8 +static const long double RD1r5[NRD1r5 + 1] = +{ + 1.411036368843183477558773688484699813355E6L, + 4.378121767236251950226362443134306184849E6L, + 5.682322855631723455425929877581697918168E6L, + 3.999065731556977782435009349967042222375E6L, + 1.653651390456781293163585493620758410333E6L, + 4.067774359067489605179546964969435858311E5L, + 5.741463295366557346748361781768833633256E4L, + 4.226404539738182992856094681115746692030E3L, + 1.316980975410327975566999780608618774469E2L, + /* 1.0E0L */ +}; + + +/* log gamma(x+1.25) = log gamma(1.25) + x P(x)/Q(x) + -.125 <= x <= +.125 + 1.125 <= x+1.25 <= 1.375 + Peak relative error = 4.9e-36 */ +static const long double lgam1r25a = -9.82818603515625E-2L; +static const long double lgam1r25b = 1.0023929749338536146197303364159774377296E-5L; +#define NRN1r25 9 +static const long double RN1r25[NRN1r25 + 1] = +{ + -9.054787275312026472896002240379580536760E4L, + -8.685076892989927640126560802094680794471E4L, + 2.797898965448019916967849727279076547109E5L, + 6.175520827134342734546868356396008898299E5L, + 5.179626599589134831538516906517372619641E5L, + 2.253076616239043944538380039205558242161E5L, + 5.312653119599957228630544772499197307195E4L, + 6.434329437514083776052669599834938898255E3L, + 3.385414416983114598582554037612347549220E2L, + 4.907821957946273805080625052510832015792E0L +}; +#define NRD1r25 8 +static const long double RD1r25[NRD1r25 + 1] = +{ + 3.980939377333448005389084785896660309000E5L, + 1.429634893085231519692365775184490465542E6L, + 2.145438946455476062850151428438668234336E6L, + 1.743786661358280837020848127465970357893E6L, + 8.316364251289743923178092656080441655273E5L, + 2.355732939106812496699621491135458324294E5L, + 3.822267399625696880571810137601310855419E4L, + 3.228463206479133236028576845538387620856E3L, + 1.152133170470059555646301189220117965514E2L + /* 1.0E0L */ +}; + + +/* log gamma(x + 1) = x P(x)/Q(x) + 0.0 <= x <= +0.125 + 1.0 <= x+1 <= 1.125 + Peak relative error 1.1e-35 */ +#define NRN1 8 +static const long double RN1[NRN1 + 1] = +{ + -9.987560186094800756471055681088744738818E3L, + -2.506039379419574361949680225279376329742E4L, + -1.386770737662176516403363873617457652991E4L, + 1.439445846078103202928677244188837130744E4L, + 2.159612048879650471489449668295139990693E4L, + 1.047439813638144485276023138173676047079E4L, + 2.250316398054332592560412486630769139961E3L, + 1.958510425467720733041971651126443864041E2L, + 4.516830313569454663374271993200291219855E0L +}; +#define NRD1 7 +static const long double RD1[NRD1 + 1] = +{ + 1.730299573175751778863269333703788214547E4L, + 6.807080914851328611903744668028014678148E4L, + 1.090071629101496938655806063184092302439E5L, + 9.124354356415154289343303999616003884080E4L, + 4.262071638655772404431164427024003253954E4L, + 1.096981664067373953673982635805821283581E4L, + 1.431229503796575892151252708527595787588E3L, + 7.734110684303689320830401788262295992921E1L + /* 1.0E0 */ +}; + + +/* log gamma(x + 1) = x P(x)/Q(x) + -0.125 <= x <= 0 + 0.875 <= x+1 <= 1.0 + Peak relative error 7.0e-37 */ +#define NRNr9 8 +static const long double RNr9[NRNr9 + 1] = +{ + 4.441379198241760069548832023257571176884E5L, + 1.273072988367176540909122090089580368732E6L, + 9.732422305818501557502584486510048387724E5L, + -5.040539994443998275271644292272870348684E5L, + -1.208719055525609446357448132109723786736E6L, + -7.434275365370936547146540554419058907156E5L, + -2.075642969983377738209203358199008185741E5L, + -2.565534860781128618589288075109372218042E4L, + -1.032901669542994124131223797515913955938E3L, +}; +#define NRDr9 8 +static const long double RDr9[NRDr9 + 1] = +{ + -7.694488331323118759486182246005193998007E5L, + -3.301918855321234414232308938454112213751E6L, + -5.856830900232338906742924836032279404702E6L, + -5.540672519616151584486240871424021377540E6L, + -3.006530901041386626148342989181721176919E6L, + -9.350378280513062139466966374330795935163E5L, + -1.566179100031063346901755685375732739511E5L, + -1.205016539620260779274902967231510804992E4L, + -2.724583156305709733221564484006088794284E2L +/* 1.0E0 */ +}; + + +/* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +neval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + +/* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +deval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = x + *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + +long double +lgammal(long double x) +{ + long double p, q, w, z, nx; + int i, nn; + + signgam = 1; + + if (! finite (x)) + return x * x; + + if (x == 0.0L) + { + if (signbitl (x)) + signgam = -1; + } + + if (x < 0.0L) + { + q = -x; + p = floorl (q); + if (p == q) + return (one / (p - p)); + i = p; + if ((i & 1) == 0) + signgam = -1; + else + signgam = 1; + z = q - p; + if (z > 0.5L) + { + p += 1.0L; + z = p - q; + } + z = q * sinl (PIL * z); + if (z == 0.0L) + return (signgam * huge * huge); + w = lgammal (q); + z = logl (PIL / z) - w; + return (z); + } + + if (x < 13.5L) + { + p = 0.0L; + nx = floorl (x + 0.5L); + nn = nx; + switch (nn) + { + case 0: + /* log gamma (x + 1) = log(x) + log gamma(x) */ + if (x <= 0.125) + { + p = x * neval (x, RN1, NRN1) / deval (x, RD1, NRD1); + } + else if (x <= 0.375) + { + z = x - 0.25L; + p = z * neval (z, RN1r25, NRN1r25) / deval (z, RD1r25, NRD1r25); + p += lgam1r25b; + p += lgam1r25a; + } + else if (x <= 0.625) + { + z = x + (1.0L - x0a); + z = z - x0b; + p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); + p = p * z * z; + p = p + y0b; + p = p + y0a; + } + else if (x <= 0.875) + { + z = x - 0.75L; + p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); + p += lgam1r75b; + p += lgam1r75a; + } + else + { + z = x - 1.0L; + p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); + } + p = p - logl (x); + break; + + case 1: + if (x < 0.875L) + { + if (x <= 0.625) + { + z = x + (1.0L - x0a); + z = z - x0b; + p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); + p = p * z * z; + p = p + y0b; + p = p + y0a; + } + else if (x <= 0.875) + { + z = x - 0.75L; + p = z * neval (z, RN1r75, NRN1r75) + / deval (z, RD1r75, NRD1r75); + p += lgam1r75b; + p += lgam1r75a; + } + else + { + z = x - 1.0L; + p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); + } + p = p - logl (x); + } + else if (x < 1.0L) + { + z = x - 1.0L; + p = z * neval (z, RNr9, NRNr9) / deval (z, RDr9, NRDr9); + } + else if (x == 1.0L) + p = 0.0L; + else if (x <= 1.125L) + { + z = x - 1.0L; + p = z * neval (z, RN1, NRN1) / deval (z, RD1, NRD1); + } + else if (x <= 1.375) + { + z = x - 1.25L; + p = z * neval (z, RN1r25, NRN1r25) / deval (z, RD1r25, NRD1r25); + p += lgam1r25b; + p += lgam1r25a; + } + else + { + /* 1.375 <= x+x0 <= 1.625 */ + z = x - x0a; + z = z - x0b; + p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); + p = p * z * z; + p = p + y0b; + p = p + y0a; + } + break; + + case 2: + if (x < 1.625L) + { + z = x - x0a; + z = z - x0b; + p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); + p = p * z * z; + p = p + y0b; + p = p + y0a; + } + else if (x < 1.875L) + { + z = x - 1.75L; + p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); + p += lgam1r75b; + p += lgam1r75a; + } + else if (x == 2.0L) + p = 0.0L; + else if (x < 2.375L) + { + z = x - 2.0L; + p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); + } + else + { + z = x - 2.5L; + p = z * neval (z, RN2r5, NRN2r5) / deval (z, RD2r5, NRD2r5); + p += lgam2r5b; + p += lgam2r5a; + } + break; + + case 3: + if (x < 2.75) + { + z = x - 2.5L; + p = z * neval (z, RN2r5, NRN2r5) / deval (z, RD2r5, NRD2r5); + p += lgam2r5b; + p += lgam2r5a; + } + else + { + z = x - 3.0L; + p = z * neval (z, RN3, NRN3) / deval (z, RD3, NRD3); + p += lgam3b; + p += lgam3a; + } + break; + + case 4: + z = x - 4.0L; + p = z * neval (z, RN4, NRN4) / deval (z, RD4, NRD4); + p += lgam4b; + p += lgam4a; + break; + + case 5: + z = x - 5.0L; + p = z * neval (z, RN5, NRN5) / deval (z, RD5, NRD5); + p += lgam5b; + p += lgam5a; + break; + + case 6: + z = x - 6.0L; + p = z * neval (z, RN6, NRN6) / deval (z, RD6, NRD6); + p += lgam6b; + p += lgam6a; + break; + + case 7: + z = x - 7.0L; + p = z * neval (z, RN7, NRN7) / deval (z, RD7, NRD7); + p += lgam7b; + p += lgam7a; + break; + + case 8: + z = x - 8.0L; + p = z * neval (z, RN8, NRN8) / deval (z, RD8, NRD8); + p += lgam8b; + p += lgam8a; + break; + + case 9: + z = x - 9.0L; + p = z * neval (z, RN9, NRN9) / deval (z, RD9, NRD9); + p += lgam9b; + p += lgam9a; + break; + + case 10: + z = x - 10.0L; + p = z * neval (z, RN10, NRN10) / deval (z, RD10, NRD10); + p += lgam10b; + p += lgam10a; + break; + + case 11: + z = x - 11.0L; + p = z * neval (z, RN11, NRN11) / deval (z, RD11, NRD11); + p += lgam11b; + p += lgam11a; + break; + + case 12: + z = x - 12.0L; + p = z * neval (z, RN12, NRN12) / deval (z, RD12, NRD12); + p += lgam12b; + p += lgam12a; + break; + + case 13: + z = x - 13.0L; + p = z * neval (z, RN13, NRN13) / deval (z, RD13, NRD13); + p += lgam13b; + p += lgam13a; + break; + } + return p; + } + + if (x > MAXLGM) + return (signgam * huge * huge); + + q = ls2pi - x; + q = (x - 0.5L) * logl (x) + q; + if (x > 1.0e18L) + return (q); + + p = 1.0L / (x * x); + q += neval (p, RASY, NRASY) / x; + return (q); +} diff --git a/lib/libm/src/ld128/e_log10l.c b/lib/libm/src/ld128/e_log10l.c new file mode 100644 index 00000000000..99802034466 --- /dev/null +++ b/lib/libm/src/ld128/e_log10l.c @@ -0,0 +1,255 @@ +/* $OpenBSD: e_log10l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* log10l.c + * + * Common logarithm, 128-bit long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, log10l(); + * + * y = log10l( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 10 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z^3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 2.3e-34 4.9e-35 + * IEEE exp(+-10000) 30000 1.0e-34 4.1e-35 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + */ + +#include <math.h> + +#include "math_private.h" + +/* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 5.3e-37, + * relative peak error spread = 2.3e-14 + */ +static const long double P[13] = +{ + 1.313572404063446165910279910527789794488E4L, + 7.771154681358524243729929227226708890930E4L, + 2.014652742082537582487669938141683759923E5L, + 3.007007295140399532324943111654767187848E5L, + 2.854829159639697837788887080758954924001E5L, + 1.797628303815655343403735250238293741397E5L, + 7.594356839258970405033155585486712125861E4L, + 2.128857716871515081352991964243375186031E4L, + 3.824952356185897735160588078446136783779E3L, + 4.114517881637811823002128927449878962058E2L, + 2.321125933898420063925789532045674660756E1L, + 4.998469661968096229986658302195402690910E-1L, + 1.538612243596254322971797716843006400388E-6L +}; +static const long double Q[12] = +{ + 3.940717212190338497730839731583397586124E4L, + 2.626900195321832660448791748036714883242E5L, + 7.777690340007566932935753241556479363645E5L, + 1.347518538384329112529391120390701166528E6L, + 1.514882452993549494932585972882995548426E6L, + 1.158019977462989115839826904108208787040E6L, + 6.132189329546557743179177159925690841200E5L, + 2.248234257620569139969141618556349415120E5L, + 5.605842085972455027590989944010492125825E4L, + 9.147150349299596453976674231612674085381E3L, + 9.104928120962988414618126155557301584078E2L, + 4.839208193348159620282142911143429644326E1L +/* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 1.1e-35, + * relative peak error spread 1.1e-9 + */ +static const long double R[6] = +{ + 1.418134209872192732479751274970992665513E5L, + -8.977257995689735303686582344659576526998E4L, + 2.048819892795278657810231591630928516206E4L, + -2.024301798136027039250415126250455056397E3L, + 8.057002716646055371965756206836056074715E1L, + -8.828896441624934385266096344596648080902E-1L +}; +static const long double S[6] = +{ + 1.701761051846631278975701529965589676574E6L, + -1.332535117259762928288745111081235577029E6L, + 4.001557694070773974936904547424676279307E5L, + -5.748542087379434595104154610899551484314E4L, + 3.998526750980007367835804959888064681098E3L, + -1.186359407982897997337150403816839480438E2L +/* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double +/* log10(2) */ +L102A = 0.3125L, +L102B = -1.14700043360188047862611052755069732318101185E-2L, +/* log10(e) */ +L10EA = 0.5L, +L10EB = -6.570551809674817234887108108339491770560299E-2L, +/* sqrt(2)/2 */ +SQRTH = 7.071067811865475244008443621048490392848359E-1L; + + + +/* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +neval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + +/* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +deval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = x + *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + + +long double +log10l(long double x) +{ + long double z; + long double y; + int e; + int64_t hx, lx; + +/* Test for domain */ + GET_LDOUBLE_WORDS64 (hx, lx, x); + if (((hx & 0x7fffffffffffffffLL) | lx) == 0) + return (-1.0L / (x - x)); + if (hx < 0) + return (x - x) / (x - x); + if (hx >= 0x7fff000000000000LL) + return (x + x); + +/* separate mantissa from exponent */ + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ + x = frexpl (x, &e); + + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + if ((e > 2) || (e < -2)) + { + if (x < SQRTH) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } + else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x * x; + y = x * (z * neval (z, R, 5) / deval (z, S, 5)); + goto done; + } + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + + if (x < SQRTH) + { + e -= 1; + x = 2.0 * x - 1.0L; /* 2x - 1 */ + } + else + { + x = x - 1.0L; + } + z = x * x; + y = x * (z * neval (x, P, 12) / deval (x, Q, 11)); + y = y - 0.5 * z; + +done: + + /* Multiply log of fraction by log10(e) + * and base 2 exponent by log10(2). + */ + z = y * L10EB; + z += x * L10EB; + z += e * L102B; + z += y * L10EA; + z += x * L10EA; + z += e * L102A; + return (z); +} diff --git a/lib/libm/src/ld128/e_log2l.c b/lib/libm/src/ld128/e_log2l.c new file mode 100644 index 00000000000..fe15b824586 --- /dev/null +++ b/lib/libm/src/ld128/e_log2l.c @@ -0,0 +1,248 @@ +/* $OpenBSD: e_log2l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* log2l.c + * Base 2 logarithm, 128-bit long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, log2l(); + * + * y = log2l( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 2 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the (natural) + * logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z^3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 100,000 2.6e-34 4.9e-35 + * IEEE exp(+-10000) 100,000 9.6e-35 4.0e-35 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + */ + +#include <math.h> + +#include "math_private.h" + +/* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 5.3e-37, + * relative peak error spread = 2.3e-14 + */ +static const long double P[13] = +{ + 1.313572404063446165910279910527789794488E4L, + 7.771154681358524243729929227226708890930E4L, + 2.014652742082537582487669938141683759923E5L, + 3.007007295140399532324943111654767187848E5L, + 2.854829159639697837788887080758954924001E5L, + 1.797628303815655343403735250238293741397E5L, + 7.594356839258970405033155585486712125861E4L, + 2.128857716871515081352991964243375186031E4L, + 3.824952356185897735160588078446136783779E3L, + 4.114517881637811823002128927449878962058E2L, + 2.321125933898420063925789532045674660756E1L, + 4.998469661968096229986658302195402690910E-1L, + 1.538612243596254322971797716843006400388E-6L +}; +static const long double Q[12] = +{ + 3.940717212190338497730839731583397586124E4L, + 2.626900195321832660448791748036714883242E5L, + 7.777690340007566932935753241556479363645E5L, + 1.347518538384329112529391120390701166528E6L, + 1.514882452993549494932585972882995548426E6L, + 1.158019977462989115839826904108208787040E6L, + 6.132189329546557743179177159925690841200E5L, + 2.248234257620569139969141618556349415120E5L, + 5.605842085972455027590989944010492125825E4L, + 9.147150349299596453976674231612674085381E3L, + 9.104928120962988414618126155557301584078E2L, + 4.839208193348159620282142911143429644326E1L +/* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 1.1e-35, + * relative peak error spread 1.1e-9 + */ +static const long double R[6] = +{ + 1.418134209872192732479751274970992665513E5L, + -8.977257995689735303686582344659576526998E4L, + 2.048819892795278657810231591630928516206E4L, + -2.024301798136027039250415126250455056397E3L, + 8.057002716646055371965756206836056074715E1L, + -8.828896441624934385266096344596648080902E-1L +}; +static const long double S[6] = +{ + 1.701761051846631278975701529965589676574E6L, + -1.332535117259762928288745111081235577029E6L, + 4.001557694070773974936904547424676279307E5L, + -5.748542087379434595104154610899551484314E4L, + 3.998526750980007367835804959888064681098E3L, + -1.186359407982897997337150403816839480438E2L +/* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double +/* log2(e) - 1 */ +LOG2EA = 4.4269504088896340735992468100189213742664595E-1L, +/* sqrt(2)/2 */ +SQRTH = 7.071067811865475244008443621048490392848359E-1L; + + +/* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +neval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + +/* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +deval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = x + *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + + +long double +log2l(long double x) +{ + long double z; + long double y; + int e; + int64_t hx, lx; + +/* Test for domain */ + GET_LDOUBLE_WORDS64 (hx, lx, x); + if (((hx & 0x7fffffffffffffffLL) | lx) == 0) + return (-1.0L / (x - x)); + if (hx < 0) + return (x - x) / (x - x); + if (hx >= 0x7fff000000000000LL) + return (x + x); + +/* separate mantissa from exponent */ + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ + x = frexpl (x, &e); + + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + if ((e > 2) || (e < -2)) + { + if (x < SQRTH) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } + else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x * x; + y = x * (z * neval (z, R, 5) / deval (z, S, 5)); + goto done; + } + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + + if (x < SQRTH) + { + e -= 1; + x = 2.0 * x - 1.0L; /* 2x - 1 */ + } + else + { + x = x - 1.0L; + } + z = x * x; + y = x * (z * neval (x, P, 12) / deval (x, Q, 11)); + y = y - 0.5 * z; + +done: + +/* Multiply log of fraction by log2(e) + * and base 2 exponent by 1 + */ + z = y * LOG2EA; + z += x * LOG2EA; + z += y; + z += x; + z += e; + return (z); +} diff --git a/lib/libm/src/ld128/e_logl.c b/lib/libm/src/ld128/e_logl.c new file mode 100644 index 00000000000..8f2b7e6e709 --- /dev/null +++ b/lib/libm/src/ld128/e_logl.c @@ -0,0 +1,283 @@ +/* $OpenBSD: e_logl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* logl.c + * + * Natural logarithm for 128-bit long double precision. + * + * + * + * SYNOPSIS: + * + * long double x, y, logl(); + * + * y = logl( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. Use of a lookup table increases the speed of the routine. + * The program uses logarithms tabulated at intervals of 1/128 to + * cover the domain from approximately 0.7 to 1.4. + * + * On the interval [-1/128, +1/128] the logarithm of 1+x is approximated by + * log(1+x) = x - 0.5 x^2 + x^3 P(x) . + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.875, 1.125 100000 1.2e-34 4.1e-35 + * IEEE 0.125, 8 100000 1.2e-34 4.1e-35 + * + * + * WARNING: + * + * This program uses integer operations on bit fields of floating-point + * numbers. It does not work with data structures other than the + * structure assumed. + * + */ + +#include <math.h> + +#include "math_private.h" + +/* log(1+x) = x - .5 x^2 + x^3 l(x) + -.0078125 <= x <= +.0078125 + peak relative error 1.2e-37 */ +static const long double +l3 = 3.333333333333333333333333333333336096926E-1L, +l4 = -2.499999999999999999999999999486853077002E-1L, +l5 = 1.999999999999999999999999998515277861905E-1L, +l6 = -1.666666666666666666666798448356171665678E-1L, +l7 = 1.428571428571428571428808945895490721564E-1L, +l8 = -1.249999999999999987884655626377588149000E-1L, +l9 = 1.111111111111111093947834982832456459186E-1L, +l10 = -1.000000000000532974938900317952530453248E-1L, +l11 = 9.090909090915566247008015301349979892689E-2L, +l12 = -8.333333211818065121250921925397567745734E-2L, +l13 = 7.692307559897661630807048686258659316091E-2L, +l14 = -7.144242754190814657241902218399056829264E-2L, +l15 = 6.668057591071739754844678883223432347481E-2L; + +/* Lookup table of ln(t) - (t-1) + t = 0.5 + (k+26)/128) + k = 0, ..., 91 */ +static const long double logtbl[92] = { +-5.5345593589352099112142921677820359632418E-2L, +-5.2108257402767124761784665198737642086148E-2L, +-4.8991686870576856279407775480686721935120E-2L, +-4.5993270766361228596215288742353061431071E-2L, +-4.3110481649613269682442058976885699556950E-2L, +-4.0340872319076331310838085093194799765520E-2L, +-3.7682072451780927439219005993827431503510E-2L, +-3.5131785416234343803903228503274262719586E-2L, +-3.2687785249045246292687241862699949178831E-2L, +-3.0347913785027239068190798397055267411813E-2L, +-2.8110077931525797884641940838507561326298E-2L, +-2.5972247078357715036426583294246819637618E-2L, +-2.3932450635346084858612873953407168217307E-2L, +-2.1988775689981395152022535153795155900240E-2L, +-2.0139364778244501615441044267387667496733E-2L, +-1.8382413762093794819267536615342902718324E-2L, +-1.6716169807550022358923589720001638093023E-2L, +-1.5138929457710992616226033183958974965355E-2L, +-1.3649036795397472900424896523305726435029E-2L, +-1.2244881690473465543308397998034325468152E-2L, +-1.0924898127200937840689817557742469105693E-2L, +-9.6875626072830301572839422532631079809328E-3L, +-8.5313926245226231463436209313499745894157E-3L, +-7.4549452072765973384933565912143044991706E-3L, +-6.4568155251217050991200599386801665681310E-3L, +-5.5356355563671005131126851708522185605193E-3L, +-4.6900728132525199028885749289712348829878E-3L, +-3.9188291218610470766469347968659624282519E-3L, +-3.2206394539524058873423550293617843896540E-3L, +-2.5942708080877805657374888909297113032132E-3L, +-2.0385211375711716729239156839929281289086E-3L, +-1.5522183228760777967376942769773768850872E-3L, +-1.1342191863606077520036253234446621373191E-3L, +-7.8340854719967065861624024730268350459991E-4L, +-4.9869831458030115699628274852562992756174E-4L, +-2.7902661731604211834685052867305795169688E-4L, +-1.2335696813916860754951146082826952093496E-4L, +-3.0677461025892873184042490943581654591817E-5L, +#define ZERO logtbl[38] + 0.0000000000000000000000000000000000000000E0L, +-3.0359557945051052537099938863236321874198E-5L, +-1.2081346403474584914595395755316412213151E-4L, +-2.7044071846562177120083903771008342059094E-4L, +-4.7834133324631162897179240322783590830326E-4L, +-7.4363569786340080624467487620270965403695E-4L, +-1.0654639687057968333207323853366578860679E-3L, +-1.4429854811877171341298062134712230604279E-3L, +-1.8753781835651574193938679595797367137975E-3L, +-2.3618380914922506054347222273705859653658E-3L, +-2.9015787624124743013946600163375853631299E-3L, +-3.4938307889254087318399313316921940859043E-3L, +-4.1378413103128673800485306215154712148146E-3L, +-4.8328735414488877044289435125365629849599E-3L, +-5.5782063183564351739381962360253116934243E-3L, +-6.3731336597098858051938306767880719015261E-3L, +-7.2169643436165454612058905294782949315193E-3L, +-8.1090214990427641365934846191367315083867E-3L, +-9.0486422112807274112838713105168375482480E-3L, +-1.0035177140880864314674126398350812606841E-2L, +-1.1067990155502102718064936259435676477423E-2L, +-1.2146457974158024928196575103115488672416E-2L, +-1.3269969823361415906628825374158424754308E-2L, +-1.4437927104692837124388550722759686270765E-2L, +-1.5649743073340777659901053944852735064621E-2L, +-1.6904842527181702880599758489058031645317E-2L, +-1.8202661505988007336096407340750378994209E-2L, +-1.9542647000370545390701192438691126552961E-2L, +-2.0924256670080119637427928803038530924742E-2L, +-2.2346958571309108496179613803760727786257E-2L, +-2.3810230892650362330447187267648486279460E-2L, +-2.5313561699385640380910474255652501521033E-2L, +-2.6856448685790244233704909690165496625399E-2L, +-2.8438398935154170008519274953860128449036E-2L, +-3.0058928687233090922411781058956589863039E-2L, +-3.1717563112854831855692484086486099896614E-2L, +-3.3413836095418743219397234253475252001090E-2L, +-3.5147290019036555862676702093393332533702E-2L, +-3.6917475563073933027920505457688955423688E-2L, +-3.8723951502862058660874073462456610731178E-2L, +-4.0566284516358241168330505467000838017425E-2L, +-4.2444048996543693813649967076598766917965E-2L, +-4.4356826869355401653098777649745233339196E-2L, +-4.6304207416957323121106944474331029996141E-2L, +-4.8285787106164123613318093945035804818364E-2L, +-5.0301169421838218987124461766244507342648E-2L, +-5.2349964705088137924875459464622098310997E-2L, +-5.4431789996103111613753440311680967840214E-2L, +-5.6546268881465384189752786409400404404794E-2L, +-5.8693031345788023909329239565012647817664E-2L, +-6.0871713627532018185577188079210189048340E-2L, +-6.3081958078862169742820420185833800925568E-2L, +-6.5323413029406789694910800219643791556918E-2L, +-6.7595732653791419081537811574227049288168E-2L +}; + +/* ln(2) = ln2a + ln2b with extended precision. */ +static const long double + ln2a = 6.93145751953125e-1L, + ln2b = 1.4286068203094172321214581765680755001344E-6L; + +long double +logl(long double x) +{ + long double z, y, w; + ieee_quad_shape_type u, t; + unsigned int m; + int k, e; + + u.value = x; + m = u.parts32.mswhi; + + /* Check for IEEE special cases. */ + k = m & 0x7fffffff; + /* log(0) = -infinity. */ + if ((k | u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) + { + return -0.5L / ZERO; + } + /* log ( x < 0 ) = NaN */ + if (m & 0x80000000) + { + return (x - x) / ZERO; + } + /* log (infinity or NaN) */ + if (k >= 0x7fff0000) + { + return x + x; + } + + /* Extract exponent and reduce domain to 0.703125 <= u < 1.40625 */ + e = (int) (m >> 16) - (int) 0x3ffe; + m &= 0xffff; + u.parts32.mswhi = m | 0x3ffe0000; + m |= 0x10000; + /* Find lookup table index k from high order bits of the significand. */ + if (m < 0x16800) + { + k = (m - 0xff00) >> 9; + /* t is the argument 0.5 + (k+26)/128 + of the nearest item to u in the lookup table. */ + t.parts32.mswhi = 0x3fff0000 + (k << 9); + t.parts32.mswlo = 0; + t.parts32.lswhi = 0; + t.parts32.lswlo = 0; + u.parts32.mswhi += 0x10000; + e -= 1; + k += 64; + } + else + { + k = (m - 0xfe00) >> 10; + t.parts32.mswhi = 0x3ffe0000 + (k << 10); + t.parts32.mswlo = 0; + t.parts32.lswhi = 0; + t.parts32.lswlo = 0; + } + /* On this interval the table is not used due to cancellation error. */ + if ((x <= 1.0078125L) && (x >= 0.9921875L)) + { + z = x - 1.0L; + k = 64; + t.value = 1.0L; + e = 0; + } + else + { + /* log(u) = log( t u/t ) = log(t) + log(u/t) + log(t) is tabulated in the lookup table. + Express log(u/t) = log(1+z), where z = u/t - 1 = (u-t)/t. + cf. Cody & Waite. */ + z = (u.value - t.value) / t.value; + } + /* Series expansion of log(1+z). */ + w = z * z; + y = ((((((((((((l15 * z + + l14) * z + + l13) * z + + l12) * z + + l11) * z + + l10) * z + + l9) * z + + l8) * z + + l7) * z + + l6) * z + + l5) * z + + l4) * z + + l3) * z * w; + y -= 0.5 * w; + y += e * ln2b; /* Base 2 exponent offset times ln(2). */ + y += z; + y += logtbl[k-26]; /* log(t) - (t-1) */ + y += (t.value - 1.0L); + y += e * ln2a; + return y; +} diff --git a/lib/libm/src/ld128/e_powl.c b/lib/libm/src/ld128/e_powl.c new file mode 100644 index 00000000000..1c73633e4f5 --- /dev/null +++ b/lib/libm/src/ld128/e_powl.c @@ -0,0 +1,439 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* powl(x,y) return x**y + * + * n + * Method: Let x = 2 * (1+f) + * 1. Compute and return log2(x) in two pieces: + * log2(x) = w1 + w2, + * where w1 has 113-53 = 60 bit trailing zeros. + * 2. Perform y*log2(x) = n+y' by simulating muti-precision + * arithmetic, where |y'|<=0.5. + * 3. Return x**y = 2**n*exp(y'*log2) + * + * Special cases: + * 1. (anything) ** 0 is 1 + * 2. (anything) ** 1 is itself + * 3. (anything) ** NAN is NAN + * 4. NAN ** (anything except 0) is NAN + * 5. +-(|x| > 1) ** +INF is +INF + * 6. +-(|x| > 1) ** -INF is +0 + * 7. +-(|x| < 1) ** +INF is +0 + * 8. +-(|x| < 1) ** -INF is +INF + * 9. +-1 ** +-INF is NAN + * 10. +0 ** (+anything except 0, NAN) is +0 + * 11. -0 ** (+anything except 0, NAN, odd integer) is +0 + * 12. +0 ** (-anything except 0, NAN) is +INF + * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF + * 14. -0 ** (odd integer) = -( +0 ** (odd integer) ) + * 15. +INF ** (+anything except 0,NAN) is +INF + * 16. +INF ** (-anything except 0,NAN) is +0 + * 17. -INF ** (anything) = -0 ** (-anything) + * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer) + * 19. (-anything except 0 and inf) ** (non-integer) is NAN + * + */ + +#include <math.h> + +#include "math_private.h" + +static const long double bp[] = { + 1.0L, + 1.5L, +}; + +/* log_2(1.5) */ +static const long double dp_h[] = { + 0.0, + 5.8496250072115607565592654282227158546448E-1L +}; + +/* Low part of log_2(1.5) */ +static const long double dp_l[] = { + 0.0, + 1.0579781240112554492329533686862998106046E-16L +}; + +static const long double zero = 0.0L, + one = 1.0L, + two = 2.0L, + two113 = 1.0384593717069655257060992658440192E34L, + huge = 1.0e3000L, + tiny = 1.0e-3000L; + +/* 3/2 log x = 3 z + z^3 + z^3 (z^2 R(z^2)) + z = (x-1)/(x+1) + 1 <= x <= 1.25 + Peak relative error 2.3e-37 */ +static const long double LN[] = +{ + -3.0779177200290054398792536829702930623200E1L, + 6.5135778082209159921251824580292116201640E1L, + -4.6312921812152436921591152809994014413540E1L, + 1.2510208195629420304615674658258363295208E1L, + -9.9266909031921425609179910128531667336670E-1L +}; +static const long double LD[] = +{ + -5.129862866715009066465422805058933131960E1L, + 1.452015077564081884387441590064272782044E2L, + -1.524043275549860505277434040464085593165E2L, + 7.236063513651544224319663428634139768808E1L, + -1.494198912340228235853027849917095580053E1L + /* 1.0E0 */ +}; + +/* exp(x) = 1 + x - x / (1 - 2 / (x - x^2 R(x^2))) + 0 <= x <= 0.5 + Peak relative error 5.7e-38 */ +static const long double PN[] = +{ + 5.081801691915377692446852383385968225675E8L, + 9.360895299872484512023336636427675327355E6L, + 4.213701282274196030811629773097579432957E4L, + 5.201006511142748908655720086041570288182E1L, + 9.088368420359444263703202925095675982530E-3L, +}; +static const long double PD[] = +{ + 3.049081015149226615468111430031590411682E9L, + 1.069833887183886839966085436512368982758E8L, + 8.259257717868875207333991924545445705394E5L, + 1.872583833284143212651746812884298360922E3L, + /* 1.0E0 */ +}; + +static const long double + /* ln 2 */ + lg2 = 6.9314718055994530941723212145817656807550E-1L, + lg2_h = 6.9314718055994528622676398299518041312695E-1L, + lg2_l = 2.3190468138462996154948554638754786504121E-17L, + ovt = 8.0085662595372944372e-0017L, + /* 2/(3*log(2)) */ + cp = 9.6179669392597560490661645400126142495110E-1L, + cp_h = 9.6179669392597555432899980587535537779331E-1L, + cp_l = 5.0577616648125906047157785230014751039424E-17L; + +long double +powl(long double x, long double y) +{ + long double z, ax, z_h, z_l, p_h, p_l; + long double yy1, t1, t2, r, s, t, u, v, w; + long double s2, s_h, s_l, t_h, t_l; + int32_t i, j, k, yisint, n; + u_int32_t ix, iy; + int32_t hx, hy; + ieee_quad_shape_type o, p, q; + + p.value = x; + hx = p.parts32.mswhi; + ix = hx & 0x7fffffff; + + q.value = y; + hy = q.parts32.mswhi; + iy = hy & 0x7fffffff; + + + /* y==zero: x**0 = 1 */ + if ((iy | q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) == 0) + return one; + + /* 1.0**y = 1; -1.0**+-Inf = 1 */ + if (x == one) + return one; + if (x == -1.0L && iy == 0x7fff0000 + && (q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) == 0) + return one; + + /* +-NaN return x+y */ + if ((ix > 0x7fff0000) + || ((ix == 0x7fff0000) + && ((p.parts32.mswlo | p.parts32.lswhi | p.parts32.lswlo) != 0)) + || (iy > 0x7fff0000) + || ((iy == 0x7fff0000) + && ((q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) != 0))) + return x + y; + + /* determine if y is an odd int when x < 0 + * yisint = 0 ... y is not an integer + * yisint = 1 ... y is an odd int + * yisint = 2 ... y is an even int + */ + yisint = 0; + if (hx < 0) + { + if (iy >= 0x40700000) /* 2^113 */ + yisint = 2; /* even integer y */ + else if (iy >= 0x3fff0000) /* 1.0 */ + { + if (floorl (y) == y) + { + z = 0.5 * y; + if (floorl (z) == z) + yisint = 2; + else + yisint = 1; + } + } + } + + /* special value of y */ + if ((q.parts32.mswlo | q.parts32.lswhi | q.parts32.lswlo) == 0) + { + if (iy == 0x7fff0000) /* y is +-inf */ + { + if (((ix - 0x3fff0000) | p.parts32.mswlo | p.parts32.lswhi | + p.parts32.lswlo) == 0) + return y - y; /* +-1**inf is NaN */ + else if (ix >= 0x3fff0000) /* (|x|>1)**+-inf = inf,0 */ + return (hy >= 0) ? y : zero; + else /* (|x|<1)**-,+inf = inf,0 */ + return (hy < 0) ? -y : zero; + } + if (iy == 0x3fff0000) + { /* y is +-1 */ + if (hy < 0) + return one / x; + else + return x; + } + if (hy == 0x40000000) + return x * x; /* y is 2 */ + if (hy == 0x3ffe0000) + { /* y is 0.5 */ + if (hx >= 0) /* x >= +0 */ + return sqrtl (x); + } + } + + ax = fabsl (x); + /* special value of x */ + if ((p.parts32.mswlo | p.parts32.lswhi | p.parts32.lswlo) == 0) + { + if (ix == 0x7fff0000 || ix == 0 || ix == 0x3fff0000) + { + z = ax; /*x is +-0,+-inf,+-1 */ + if (hy < 0) + z = one / z; /* z = (1/|x|) */ + if (hx < 0) + { + if (((ix - 0x3fff0000) | yisint) == 0) + { + z = (z - z) / (z - z); /* (-1)**non-int is NaN */ + } + else if (yisint == 1) + z = -z; /* (x<0)**odd = -(|x|**odd) */ + } + return z; + } + } + + /* (x<0)**(non-int) is NaN */ + if (((((u_int32_t) hx >> 31) - 1) | yisint) == 0) + return (x - x) / (x - x); + + /* |y| is huge. + 2^-16495 = 1/2 of smallest representable value. + If (1 - 1/131072)^y underflows, y > 1.4986e9 */ + if (iy > 0x401d654b) + { + /* if (1 - 2^-113)^y underflows, y > 1.1873e38 */ + if (iy > 0x407d654b) + { + if (ix <= 0x3ffeffff) + return (hy < 0) ? huge * huge : tiny * tiny; + if (ix >= 0x3fff0000) + return (hy > 0) ? huge * huge : tiny * tiny; + } + /* over/underflow if x is not close to one */ + if (ix < 0x3ffeffff) + return (hy < 0) ? huge * huge : tiny * tiny; + if (ix > 0x3fff0000) + return (hy > 0) ? huge * huge : tiny * tiny; + } + + n = 0; + /* take care subnormal number */ + if (ix < 0x00010000) + { + ax *= two113; + n -= 113; + o.value = ax; + ix = o.parts32.mswhi; + } + n += ((ix) >> 16) - 0x3fff; + j = ix & 0x0000ffff; + /* determine interval */ + ix = j | 0x3fff0000; /* normalize ix */ + if (j <= 0x3988) + k = 0; /* |x|<sqrt(3/2) */ + else if (j < 0xbb67) + k = 1; /* |x|<sqrt(3) */ + else + { + k = 0; + n += 1; + ix -= 0x00010000; + } + + o.value = ax; + o.parts32.mswhi = ix; + ax = o.value; + + /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ + u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ + v = one / (ax + bp[k]); + s = u * v; + s_h = s; + + o.value = s_h; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + s_h = o.value; + /* t_h=ax+bp[k] High */ + t_h = ax + bp[k]; + o.value = t_h; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + t_h = o.value; + t_l = ax - (t_h - bp[k]); + s_l = v * ((u - s_h * t_h) - s_h * t_l); + /* compute log(ax) */ + s2 = s * s; + u = LN[0] + s2 * (LN[1] + s2 * (LN[2] + s2 * (LN[3] + s2 * LN[4]))); + v = LD[0] + s2 * (LD[1] + s2 * (LD[2] + s2 * (LD[3] + s2 * (LD[4] + s2)))); + r = s2 * s2 * u / v; + r += s_l * (s_h + s); + s2 = s_h * s_h; + t_h = 3.0 + s2 + r; + o.value = t_h; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + t_h = o.value; + t_l = r - ((t_h - 3.0) - s2); + /* u+v = s*(1+...) */ + u = s_h * t_h; + v = s_l * t_h + t_l * s; + /* 2/(3log2)*(s+...) */ + p_h = u + v; + o.value = p_h; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + p_h = o.value; + p_l = v - (p_h - u); + z_h = cp_h * p_h; /* cp_h+cp_l = 2/(3*log2) */ + z_l = cp_l * p_h + p_l * cp + dp_l[k]; + /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */ + t = (long double) n; + t1 = (((z_h + z_l) + dp_h[k]) + t); + o.value = t1; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + t1 = o.value; + t2 = z_l - (((t1 - t) - dp_h[k]) - z_h); + + /* s (sign of result -ve**odd) = -1 else = 1 */ + s = one; + if (((((u_int32_t) hx >> 31) - 1) | (yisint - 1)) == 0) + s = -one; /* (-ve)**(odd int) */ + + /* split up y into yy1+y2 and compute (yy1+y2)*(t1+t2) */ + yy1 = y; + o.value = yy1; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + yy1 = o.value; + p_l = (y - yy1) * t1 + y * t2; + p_h = yy1 * t1; + z = p_l + p_h; + o.value = z; + j = o.parts32.mswhi; + if (j >= 0x400d0000) /* z >= 16384 */ + { + /* if z > 16384 */ + if (((j - 0x400d0000) | o.parts32.mswlo | o.parts32.lswhi | + o.parts32.lswlo) != 0) + return s * huge * huge; /* overflow */ + else + { + if (p_l + ovt > z - p_h) + return s * huge * huge; /* overflow */ + } + } + else if ((j & 0x7fffffff) >= 0x400d01b9) /* z <= -16495 */ + { + /* z < -16495 */ + if (((j - 0xc00d01bc) | o.parts32.mswlo | o.parts32.lswhi | + o.parts32.lswlo) + != 0) + return s * tiny * tiny; /* underflow */ + else + { + if (p_l <= z - p_h) + return s * tiny * tiny; /* underflow */ + } + } + /* compute 2**(p_h+p_l) */ + i = j & 0x7fffffff; + k = (i >> 16) - 0x3fff; + n = 0; + if (i > 0x3ffe0000) + { /* if |z| > 0.5, set n = [z+0.5] */ + n = floorl (z + 0.5L); + t = n; + p_h -= t; + } + t = p_l + p_h; + o.value = t; + o.parts32.lswlo = 0; + o.parts32.lswhi &= 0xf8000000; + t = o.value; + u = t * lg2_h; + v = (p_l - (t - p_h)) * lg2 + t * lg2_l; + z = u + v; + w = v - (z - u); + /* exp(z) */ + t = z * z; + u = PN[0] + t * (PN[1] + t * (PN[2] + t * (PN[3] + t * PN[4]))); + v = PD[0] + t * (PD[1] + t * (PD[2] + t * (PD[3] + t))); + t1 = z - t * u / v; + r = (z * t1) / (t1 - two) - (w + z * w); + z = one - (r - z); + o.value = z; + j = o.parts32.mswhi; + j += (n << 16); + if ((j >> 16) <= 0) + z = scalbnl (z, n); /* subnormal output */ + else + { + o.parts32.mswhi = j; + z = o.value; + } + return s * z; +} diff --git a/lib/libm/src/ld128/e_sinhl.c b/lib/libm/src/ld128/e_sinhl.c new file mode 100644 index 00000000000..a158d5a7b10 --- /dev/null +++ b/lib/libm/src/ld128/e_sinhl.c @@ -0,0 +1,104 @@ +/* @(#)e_sinh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* sinhl(x) + * Method : + * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 + * 1. Replace x by |x| (sinhl(-x) = -sinhl(x)). + * 2. + * E + E/(E+1) + * 0 <= x <= 25 : sinhl(x) := --------------, E=expm1l(x) + * 2 + * + * 25 <= x <= lnovft : sinhl(x) := expl(x)/2 + * lnovft <= x <= ln2ovft: sinhl(x) := expl(x/2)/2 * expl(x/2) + * ln2ovft < x : sinhl(x) := x*shuge (overflow) + * + * Special cases: + * sinhl(x) is |x| if x is +INF, -INF, or NaN. + * only sinhl(0)=0 is exact for finite x. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0, shuge = 1.0e4931L, +ovf_thresh = 1.1357216553474703894801348310092223067821E4L; + +long double +sinhl(long double x) +{ + long double t, w, h; + u_int32_t jx, ix; + ieee_quad_shape_type u; + + /* Words of |x|. */ + u.value = x; + jx = u.parts32.mswhi; + ix = jx & 0x7fffffff; + + /* x is INF or NaN */ + if (ix >= 0x7fff0000) + return x + x; + + h = 0.5; + if (jx & 0x80000000) + h = -h; + + /* Absolute value of x. */ + u.parts32.mswhi = ix; + + /* |x| in [0,40], return sign(x)*0.5*(E+E/(E+1))) */ + if (ix <= 0x40044000) + { + if (ix < 0x3fc60000) /* |x| < 2^-57 */ + if (shuge + x > one) + return x; /* sinh(tiny) = tiny with inexact */ + t = expm1l (u.value); + if (ix < 0x3fff0000) + return h * (2.0 * t - t * t / (t + one)); + return h * (t + t / (t + one)); + } + + /* |x| in [40, log(maxdouble)] return 0.5*exp(|x|) */ + if (ix <= 0x400c62e3) /* 11356.375 */ + return h * expl (u.value); + + /* |x| in [log(maxdouble), overflowthreshold] + Overflow threshold is log(2 * maxdouble). */ + if (u.value <= ovf_thresh) + { + w = expl (0.5 * u.value); + t = h * w; + return t * w; + } + + /* |x| > overflowthreshold, sinhl(x) overflow */ + return x * shuge; +} diff --git a/lib/libm/src/ld128/e_tgammal.c b/lib/libm/src/ld128/e_tgammal.c new file mode 100644 index 00000000000..2fa800240d6 --- /dev/null +++ b/lib/libm/src/ld128/e_tgammal.c @@ -0,0 +1,45 @@ +/* $OpenBSD: e_tgammal.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2011 Martynas Venckus <martynas@openbsd.org> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#include <math.h> + +#include "math_private.h" + +long double +tgammal(long double x) +{ + int64_t i0,i1; + + GET_LDOUBLE_WORDS64(i0,i1,x); + if (((i0&0x7fffffffffffffffLL)|i1) == 0) { + signgam = 0; + return (1.0/x); + } + + if (i0<0 && (u_int64_t)i0<0xffff000000000000ULL && rintl(x)==x) { + signgam = 0; + return (x-x)/(x-x); + } + + if (i0==0xffff000000000000ULL && i1==0) { + signgam = 0; + return (x-x); + } + + return expl(lgammal(x)); +} diff --git a/lib/libm/src/ld128/s_asinhl.c b/lib/libm/src/ld128/s_asinhl.c new file mode 100644 index 00000000000..12df814061c --- /dev/null +++ b/lib/libm/src/ld128/s_asinhl.c @@ -0,0 +1,69 @@ +/* @(#)s_asinh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* asinhl(x) + * Method : + * Based on + * asinhl(x) = signl(x) * logl [ |x| + sqrtl(x*x+1) ] + * we have + * asinhl(x) := x if 1+x*x=1, + * := signl(x)*(logl(x)+ln2)) for large |x|, else + * := signl(x)*logl(2|x|+1/(|x|+sqrtl(x*x+1))) if|x|>2, else + * := signl(x)*log1pl(|x| + x^2/(1 + sqrtl(1+x^2))) + */ + +#include <math.h> + +#include "math_private.h" + +static const long double + one = 1.0L, + ln2 = 6.931471805599453094172321214581765681e-1L, + huge = 1.0e+4900L; + +long double +asinhl(long double x) +{ + long double t, w; + int32_t ix, sign; + ieee_quad_shape_type u; + + u.value = x; + sign = u.parts32.mswhi; + ix = sign & 0x7fffffff; + if (ix == 0x7fff0000) + return x + x; /* x is inf or NaN */ + if (ix < 0x3fc70000) + { /* |x| < 2^ -56 */ + if (huge + x > one) + return x; /* return x inexact except 0 */ + } + u.parts32.mswhi = ix; + if (ix > 0x40350000) + { /* |x| > 2 ^ 54 */ + w = logl (u.value) + ln2; + } + else if (ix >0x40000000) + { /* 2^ 54 > |x| > 2.0 */ + t = u.value; + w = logl (2.0 * t + one / (sqrtl (x * x + one) + t)); + } + else + { /* 2.0 > |x| > 2 ^ -56 */ + t = x * x; + w = log1pl (u.value + t / (one + sqrtl (one + t))); + } + if (sign & 0x80000000) + return -w; + else + return w; +} diff --git a/lib/libm/src/ld128/s_cbrtl.c b/lib/libm/src/ld128/s_cbrtl.c new file mode 100644 index 00000000000..faa5d4c59f1 --- /dev/null +++ b/lib/libm/src/ld128/s_cbrtl.c @@ -0,0 +1,131 @@ +/*- + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2009-2011, Bruce D. Evans, Steven G. Kargl, David Schultz. + * + * 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. + * ==================================================== + * + * The argument reduction and testing for exceptional cases was + * written by Steven G. Kargl with input from Bruce D. Evans + * and David A. Schultz. + */ + +#include <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_cbrtl.c,v 1.1 2011/03/12 19:37:35 kargl Exp $"); +#endif + +#include <float.h> +#include <ieeefp.h> +#include <math.h> + +#include "math_private.h" + +#define BIAS (LDBL_MAX_EXP - 1) + +static const unsigned + B1 = 709958130; /* B1 = (127-127.0/3-0.03306235651)*2**23 */ + +long double +cbrtl(long double x) +{ + long double v, r, s, t, w; + double dr, dt, dx; + float ft, fx; + uint64_t hx, lx; + uint16_t expsign; + int k; + + GET_LDOUBLE_MSW64(hx,x); + k = (hx>>48)&0x7fff; + + /* + * If x = +-Inf, then cbrt(x) = +-Inf. + * If x = NaN, then cbrt(x) = NaN. + */ + if (k == BIAS + LDBL_MAX_EXP) + return (x + x); + + if (k == 0) { + /* If x = +-0, then cbrt(x) = +-0. */ + GET_LDOUBLE_WORDS64(hx,lx,x); + if (((hx&0x7fffffffffffffffLL)|lx) == 0) { + return (x); + } + /* Adjust subnormal numbers. */ + x *= 0x1.0p514; + GET_LDOUBLE_MSW64(hx,x); + k = (hx>>48)&0x7fff; + k -= BIAS + 514; + } else + k -= BIAS; + GET_LDOUBLE_MSW64(hx,x); + hx = (hx&0x8000ffffffffffffLL)|((uint64_t)BIAS<<48); + SET_LDOUBLE_MSW64(x,hx); + v = 1; + + switch (k % 3) { + case 1: + case -2: + x = 2*x; + k--; + break; + case 2: + case -1: + x = 4*x; + k -= 2; + break; + } + GET_LDOUBLE_MSW64(hx,x); + expsign = (expsign & 0x8000) | (BIAS + k / 3); + hx = (hx&0x8000ffffffffffffLL)|((uint64_t)expsign<<48); + SET_LDOUBLE_MSW64(x,hx); + + /* + * The following is the guts of s_cbrtf, with the handling of + * special values removed and extra care for accuracy not taken, + * but with most of the extra accuracy not discarded. + */ + + /* ~5-bit estimate: */ + fx = x; + GET_FLOAT_WORD(hx, fx); + SET_FLOAT_WORD(ft, ((hx & 0x7fffffff) / 3 + B1)); + + /* ~16-bit estimate: */ + dx = x; + dt = ft; + dr = dt * dt * dt; + dt = dt * (dx + dx + dr) / (dx + dr + dr); + + /* ~47-bit estimate: */ + dr = dt * dt * dt; + dt = dt * (dx + dx + dr) / (dx + dr + dr); + + /* + * Round dt away from zero to 47 bits. Since we don't trust the 47, + * add 2 47-bit ulps instead of 1 to round up. Rounding is slow and + * might be avoidable in this case, since on most machines dt will + * have been evaluated in 53-bit precision and the technical reasons + * for rounding up might not apply to either case in cbrtl() since + * dt is much more accurate than needed. + */ + t = dt + 0x2.0p-46 + 0x1.0p60L - 0x1.0p60; + + /* + * Final step Newton iteration to 64 or 113 bits with + * error < 0.667 ulps + */ + s=t*t; /* t*t is exact */ + r=x/s; /* error <= 0.5 ulps; |r| < |t| */ + w=t+t; /* t+t is exact */ + r=(r-t)/(w+r); /* r-t is exact; w+r ~= 3*t */ + t=t+t*r; /* error <= 0.5 + 0.5/3 + epsilon */ + + t *= v; + return (t); +} diff --git a/lib/libm/src/ld128/s_ceill.c b/lib/libm/src/ld128/s_ceill.c new file mode 100644 index 00000000000..9ee833c2301 --- /dev/null +++ b/lib/libm/src/ld128/s_ceill.c @@ -0,0 +1,69 @@ +/* @(#)s_ceil.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * ceill(x) + * Return x rounded toward -inf to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to ceil(x). + */ + +#include <math.h> + +#include "math_private.h" + +static const long double huge = 1.0e4930L; + +long double +ceill(long double x) +{ + int64_t i0,i1,jj0; + u_int64_t i,j; + GET_LDOUBLE_WORDS64(i0,i1,x); + jj0 = ((i0>>48)&0x7fff)-0x3fff; + if(jj0<48) { + if(jj0<0) { /* raise inexact if x != 0 */ + if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ + if(i0<0) {i0=0x8000000000000000ULL;i1=0;} + else if((i0|i1)!=0) { i0=0x3fff000000000000ULL;i1=0;} + } + } else { + i = (0x0000ffffffffffffULL)>>jj0; + if(((i0&i)|i1)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(i0>0) i0 += (0x0001000000000000LL)>>jj0; + i0 &= (~i); i1=0; + } + } + } else if (jj0>111) { + if(jj0==0x4000) return x+x; /* inf or NaN */ + else return x; /* x is integral */ + } else { + i = -1ULL>>(jj0-48); + if((i1&i)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(i0>0) { + if(jj0==48) i0+=1; + else { + j = i1+(1LL<<(112-jj0)); + if(j<i1) i0 +=1 ; /* got a carry */ + i1=j; + } + } + i1 &= (~i); + } + } + SET_LDOUBLE_WORDS64(x,i0,i1); + return x; +} diff --git a/lib/libm/src/ld128/s_erfl.c b/lib/libm/src/ld128/s_erfl.c new file mode 100644 index 00000000000..c6b3d4d0b3b --- /dev/null +++ b/lib/libm/src/ld128/s_erfl.c @@ -0,0 +1,926 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* double erf(double x) + * double erfc(double x) + * x + * 2 |\ + * erf(x) = --------- | exp(-t*t)dt + * sqrt(pi) \| + * 0 + * + * erfc(x) = 1-erf(x) + * Note that + * erf(-x) = -erf(x) + * erfc(-x) = 2 - erfc(x) + * + * Method: + * 1. erf(x) = x + x*R(x^2) for |x| in [0, 7/8] + * Remark. The formula is derived by noting + * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....) + * and that + * 2/sqrt(pi) = 1.128379167095512573896158903121545171688 + * is close to one. + * + * 1a. erf(x) = 1 - erfc(x), for |x| > 1.0 + * erfc(x) = 1 - erf(x) if |x| < 1/4 + * + * 2. For |x| in [7/8, 1], let s = |x| - 1, and + * c = 0.84506291151 rounded to single (24 bits) + * erf(s + c) = sign(x) * (c + P1(s)/Q1(s)) + * Remark: here we use the taylor series expansion at x=1. + * erf(1+s) = erf(1) + s*Poly(s) + * = 0.845.. + P1(s)/Q1(s) + * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25] + * + * 3. For x in [1/4, 5/4], + * erfc(s + const) = erfc(const) + s P1(s)/Q1(s) + * for const = 1/4, 3/8, ..., 9/8 + * and 0 <= s <= 1/8 . + * + * 4. For x in [5/4, 107], + * erfc(x) = (1/x)*exp(-x*x-0.5625 + R(z)) + * z=1/x^2 + * The interval is partitioned into several segments + * of width 1/8 in 1/x. + * + * Note1: + * To compute exp(-x*x-0.5625+R/S), let s be a single + * precision number and s := x; then + * -x*x = -s*s + (s-x)*(s+x) + * exp(-x*x-0.5626+R/S) = + * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S); + * Note2: + * Here 4 and 5 make use of the asymptotic series + * exp(-x*x) + * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) ) + * x*sqrt(pi) + * + * 5. For inf > x >= 107 + * erf(x) = sign(x) *(1 - tiny) (raise inexact) + * erfc(x) = tiny*tiny (raise underflow) if x > 0 + * = 2 - tiny if x<0 + * + * 7. Special case: + * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, + * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, + * erfc/erf(NaN) is NaN + */ + +#include <math.h> + +#include "math_private.h" + +/* Evaluate P[n] x^n + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +neval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + +/* Evaluate x^n+1 + P[n] x^(n) + P[n-1] x^(n-1) + ... + P[0] */ + +static long double +deval (long double x, const long double *p, int n) +{ + long double y; + + p += n; + y = x + *p--; + do + { + y = y * x + *p--; + } + while (--n > 0); + return y; +} + + + +static const long double +tiny = 1e-4931L, + one = 1.0L, + two = 2.0L, + /* 2/sqrt(pi) - 1 */ + efx = 1.2837916709551257389615890312154517168810E-1L, + /* 8 * (2/sqrt(pi) - 1) */ + efx8 = 1.0270333367641005911692712249723613735048E0L; + + +/* erf(x) = x + x R(x^2) + 0 <= x <= 7/8 + Peak relative error 1.8e-35 */ +#define NTN1 8 +static const long double TN1[NTN1 + 1] = +{ + -3.858252324254637124543172907442106422373E10L, + 9.580319248590464682316366876952214879858E10L, + 1.302170519734879977595901236693040544854E10L, + 2.922956950426397417800321486727032845006E9L, + 1.764317520783319397868923218385468729799E8L, + 1.573436014601118630105796794840834145120E7L, + 4.028077380105721388745632295157816229289E5L, + 1.644056806467289066852135096352853491530E4L, + 3.390868480059991640235675479463287886081E1L +}; +#define NTD1 8 +static const long double TD1[NTD1 + 1] = +{ + -3.005357030696532927149885530689529032152E11L, + -1.342602283126282827411658673839982164042E11L, + -2.777153893355340961288511024443668743399E10L, + -3.483826391033531996955620074072768276974E9L, + -2.906321047071299585682722511260895227921E8L, + -1.653347985722154162439387878512427542691E7L, + -6.245520581562848778466500301865173123136E5L, + -1.402124304177498828590239373389110545142E4L, + -1.209368072473510674493129989468348633579E2L +/* 1.0E0 */ +}; + + +/* erf(z+1) = erf_const + P(z)/Q(z) + -.125 <= z <= 0 + Peak relative error 7.3e-36 */ +static const long double erf_const = 0.845062911510467529296875L; +#define NTN2 8 +static const long double TN2[NTN2 + 1] = +{ + -4.088889697077485301010486931817357000235E1L, + 7.157046430681808553842307502826960051036E3L, + -2.191561912574409865550015485451373731780E3L, + 2.180174916555316874988981177654057337219E3L, + 2.848578658049670668231333682379720943455E2L, + 1.630362490952512836762810462174798925274E2L, + 6.317712353961866974143739396865293596895E0L, + 2.450441034183492434655586496522857578066E1L, + 5.127662277706787664956025545897050896203E-1L +}; +#define NTD2 8 +static const long double TD2[NTD2 + 1] = +{ + 1.731026445926834008273768924015161048885E4L, + 1.209682239007990370796112604286048173750E4L, + 1.160950290217993641320602282462976163857E4L, + 5.394294645127126577825507169061355698157E3L, + 2.791239340533632669442158497532521776093E3L, + 8.989365571337319032943005387378993827684E2L, + 2.974016493766349409725385710897298069677E2L, + 6.148192754590376378740261072533527271947E1L, + 1.178502892490738445655468927408440847480E1L + /* 1.0E0 */ +}; + + +/* erfc(x + 0.25) = erfc(0.25) + x R(x) + 0 <= x < 0.125 + Peak relative error 1.4e-35 */ +#define NRNr13 8 +static const long double RNr13[NRNr13 + 1] = +{ + -2.353707097641280550282633036456457014829E3L, + 3.871159656228743599994116143079870279866E2L, + -3.888105134258266192210485617504098426679E2L, + -2.129998539120061668038806696199343094971E1L, + -8.125462263594034672468446317145384108734E1L, + 8.151549093983505810118308635926270319660E0L, + -5.033362032729207310462422357772568553670E0L, + -4.253956621135136090295893547735851168471E-2L, + -8.098602878463854789780108161581050357814E-2L +}; +#define NRDr13 7 +static const long double RDr13[NRDr13 + 1] = +{ + 2.220448796306693503549505450626652881752E3L, + 1.899133258779578688791041599040951431383E2L, + 1.061906712284961110196427571557149268454E3L, + 7.497086072306967965180978101974566760042E1L, + 2.146796115662672795876463568170441327274E2L, + 1.120156008362573736664338015952284925592E1L, + 2.211014952075052616409845051695042741074E1L, + 6.469655675326150785692908453094054988938E-1L + /* 1.0E0 */ +}; +/* erfc(0.25) = C13a + C13b to extra precision. */ +static const long double C13a = 0.723663330078125L; +static const long double C13b = 1.0279753638067014931732235184287934646022E-5L; + + +/* erfc(x + 0.375) = erfc(0.375) + x R(x) + 0 <= x < 0.125 + Peak relative error 1.2e-35 */ +#define NRNr14 8 +static const long double RNr14[NRNr14 + 1] = +{ + -2.446164016404426277577283038988918202456E3L, + 6.718753324496563913392217011618096698140E2L, + -4.581631138049836157425391886957389240794E2L, + -2.382844088987092233033215402335026078208E1L, + -7.119237852400600507927038680970936336458E1L, + 1.313609646108420136332418282286454287146E1L, + -6.188608702082264389155862490056401365834E0L, + -2.787116601106678287277373011101132659279E-2L, + -2.230395570574153963203348263549700967918E-2L +}; +#define NRDr14 7 +static const long double RDr14[NRDr14 + 1] = +{ + 2.495187439241869732696223349840963702875E3L, + 2.503549449872925580011284635695738412162E2L, + 1.159033560988895481698051531263861842461E3L, + 9.493751466542304491261487998684383688622E1L, + 2.276214929562354328261422263078480321204E2L, + 1.367697521219069280358984081407807931847E1L, + 2.276988395995528495055594829206582732682E1L, + 7.647745753648996559837591812375456641163E-1L + /* 1.0E0 */ +}; +/* erfc(0.375) = C14a + C14b to extra precision. */ +static const long double C14a = 0.5958709716796875L; +static const long double C14b = 1.2118885490201676174914080878232469565953E-5L; + +/* erfc(x + 0.5) = erfc(0.5) + x R(x) + 0 <= x < 0.125 + Peak relative error 4.7e-36 */ +#define NRNr15 8 +static const long double RNr15[NRNr15 + 1] = +{ + -2.624212418011181487924855581955853461925E3L, + 8.473828904647825181073831556439301342756E2L, + -5.286207458628380765099405359607331669027E2L, + -3.895781234155315729088407259045269652318E1L, + -6.200857908065163618041240848728398496256E1L, + 1.469324610346924001393137895116129204737E1L, + -6.961356525370658572800674953305625578903E0L, + 5.145724386641163809595512876629030548495E-3L, + 1.990253655948179713415957791776180406812E-2L +}; +#define NRDr15 7 +static const long double RDr15[NRDr15 + 1] = +{ + 2.986190760847974943034021764693341524962E3L, + 5.288262758961073066335410218650047725985E2L, + 1.363649178071006978355113026427856008978E3L, + 1.921707975649915894241864988942255320833E2L, + 2.588651100651029023069013885900085533226E2L, + 2.628752920321455606558942309396855629459E1L, + 2.455649035885114308978333741080991380610E1L, + 1.378826653595128464383127836412100939126E0L + /* 1.0E0 */ +}; +/* erfc(0.5) = C15a + C15b to extra precision. */ +static const long double C15a = 0.4794921875L; +static const long double C15b = 7.9346869534623172533461080354712635484242E-6L; + +/* erfc(x + 0.625) = erfc(0.625) + x R(x) + 0 <= x < 0.125 + Peak relative error 5.1e-36 */ +#define NRNr16 8 +static const long double RNr16[NRNr16 + 1] = +{ + -2.347887943200680563784690094002722906820E3L, + 8.008590660692105004780722726421020136482E2L, + -5.257363310384119728760181252132311447963E2L, + -4.471737717857801230450290232600243795637E1L, + -4.849540386452573306708795324759300320304E1L, + 1.140885264677134679275986782978655952843E1L, + -6.731591085460269447926746876983786152300E0L, + 1.370831653033047440345050025876085121231E-1L, + 2.022958279982138755020825717073966576670E-2L, +}; +#define NRDr16 7 +static const long double RDr16[NRDr16 + 1] = +{ + 3.075166170024837215399323264868308087281E3L, + 8.730468942160798031608053127270430036627E2L, + 1.458472799166340479742581949088453244767E3L, + 3.230423687568019709453130785873540386217E2L, + 2.804009872719893612081109617983169474655E2L, + 4.465334221323222943418085830026979293091E1L, + 2.612723259683205928103787842214809134746E1L, + 2.341526751185244109722204018543276124997E0L, + /* 1.0E0 */ +}; +/* erfc(0.625) = C16a + C16b to extra precision. */ +static const long double C16a = 0.3767547607421875L; +static const long double C16b = 4.3570693945275513594941232097252997287766E-6L; + +/* erfc(x + 0.75) = erfc(0.75) + x R(x) + 0 <= x < 0.125 + Peak relative error 1.7e-35 */ +#define NRNr17 8 +static const long double RNr17[NRNr17 + 1] = +{ + -1.767068734220277728233364375724380366826E3L, + 6.693746645665242832426891888805363898707E2L, + -4.746224241837275958126060307406616817753E2L, + -2.274160637728782675145666064841883803196E1L, + -3.541232266140939050094370552538987982637E1L, + 6.988950514747052676394491563585179503865E0L, + -5.807687216836540830881352383529281215100E0L, + 3.631915988567346438830283503729569443642E-1L, + -1.488945487149634820537348176770282391202E-2L +}; +#define NRDr17 7 +static const long double RDr17[NRDr17 + 1] = +{ + 2.748457523498150741964464942246913394647E3L, + 1.020213390713477686776037331757871252652E3L, + 1.388857635935432621972601695296561952738E3L, + 3.903363681143817750895999579637315491087E2L, + 2.784568344378139499217928969529219886578E2L, + 5.555800830216764702779238020065345401144E1L, + 2.646215470959050279430447295801291168941E1L, + 2.984905282103517497081766758550112011265E0L, + /* 1.0E0 */ +}; +/* erfc(0.75) = C17a + C17b to extra precision. */ +static const long double C17a = 0.2888336181640625L; +static const long double C17b = 1.0748182422368401062165408589222625794046E-5L; + + +/* erfc(x + 0.875) = erfc(0.875) + x R(x) + 0 <= x < 0.125 + Peak relative error 2.2e-35 */ +#define NRNr18 8 +static const long double RNr18[NRNr18 + 1] = +{ + -1.342044899087593397419622771847219619588E3L, + 6.127221294229172997509252330961641850598E2L, + -4.519821356522291185621206350470820610727E2L, + 1.223275177825128732497510264197915160235E1L, + -2.730789571382971355625020710543532867692E1L, + 4.045181204921538886880171727755445395862E0L, + -4.925146477876592723401384464691452700539E0L, + 5.933878036611279244654299924101068088582E-1L, + -5.557645435858916025452563379795159124753E-2L +}; +#define NRDr18 7 +static const long double RDr18[NRDr18 + 1] = +{ + 2.557518000661700588758505116291983092951E3L, + 1.070171433382888994954602511991940418588E3L, + 1.344842834423493081054489613250688918709E3L, + 4.161144478449381901208660598266288188426E2L, + 2.763670252219855198052378138756906980422E2L, + 5.998153487868943708236273854747564557632E1L, + 2.657695108438628847733050476209037025318E1L, + 3.252140524394421868923289114410336976512E0L, + /* 1.0E0 */ +}; +/* erfc(0.875) = C18a + C18b to extra precision. */ +static const long double C18a = 0.215911865234375L; +static const long double C18b = 1.3073705765341685464282101150637224028267E-5L; + +/* erfc(x + 1.0) = erfc(1.0) + x R(x) + 0 <= x < 0.125 + Peak relative error 1.6e-35 */ +#define NRNr19 8 +static const long double RNr19[NRNr19 + 1] = +{ + -1.139180936454157193495882956565663294826E3L, + 6.134903129086899737514712477207945973616E2L, + -4.628909024715329562325555164720732868263E2L, + 4.165702387210732352564932347500364010833E1L, + -2.286979913515229747204101330405771801610E1L, + 1.870695256449872743066783202326943667722E0L, + -4.177486601273105752879868187237000032364E0L, + 7.533980372789646140112424811291782526263E-1L, + -8.629945436917752003058064731308767664446E-2L +}; +#define NRDr19 7 +static const long double RDr19[NRDr19 + 1] = +{ + 2.744303447981132701432716278363418643778E3L, + 1.266396359526187065222528050591302171471E3L, + 1.466739461422073351497972255511919814273E3L, + 4.868710570759693955597496520298058147162E2L, + 2.993694301559756046478189634131722579643E2L, + 6.868976819510254139741559102693828237440E1L, + 2.801505816247677193480190483913753613630E1L, + 3.604439909194350263552750347742663954481E0L, + /* 1.0E0 */ +}; +/* erfc(1.0) = C19a + C19b to extra precision. */ +static const long double C19a = 0.15728759765625L; +static const long double C19b = 1.1609394035130658779364917390740703933002E-5L; + +/* erfc(x + 1.125) = erfc(1.125) + x R(x) + 0 <= x < 0.125 + Peak relative error 3.6e-36 */ +#define NRNr20 8 +static const long double RNr20[NRNr20 + 1] = +{ + -9.652706916457973956366721379612508047640E2L, + 5.577066396050932776683469951773643880634E2L, + -4.406335508848496713572223098693575485978E2L, + 5.202893466490242733570232680736966655434E1L, + -1.931311847665757913322495948705563937159E1L, + -9.364318268748287664267341457164918090611E-2L, + -3.306390351286352764891355375882586201069E0L, + 7.573806045289044647727613003096916516475E-1L, + -9.611744011489092894027478899545635991213E-2L +}; +#define NRDr20 7 +static const long double RDr20[NRDr20 + 1] = +{ + 3.032829629520142564106649167182428189014E3L, + 1.659648470721967719961167083684972196891E3L, + 1.703545128657284619402511356932569292535E3L, + 6.393465677731598872500200253155257708763E2L, + 3.489131397281030947405287112726059221934E2L, + 8.848641738570783406484348434387611713070E1L, + 3.132269062552392974833215844236160958502E1L, + 4.430131663290563523933419966185230513168E0L + /* 1.0E0 */ +}; +/* erfc(1.125) = C20a + C20b to extra precision. */ +static const long double C20a = 0.111602783203125L; +static const long double C20b = 8.9850951672359304215530728365232161564636E-6L; + +/* erfc(1/x) = 1/x exp (-1/x^2 - 0.5625 + R(1/x^2)) + 7/8 <= 1/x < 1 + Peak relative error 1.4e-35 */ +#define NRNr8 9 +static const long double RNr8[NRNr8 + 1] = +{ + 3.587451489255356250759834295199296936784E1L, + 5.406249749087340431871378009874875889602E2L, + 2.931301290625250886238822286506381194157E3L, + 7.359254185241795584113047248898753470923E3L, + 9.201031849810636104112101947312492532314E3L, + 5.749697096193191467751650366613289284777E3L, + 1.710415234419860825710780802678697889231E3L, + 2.150753982543378580859546706243022719599E2L, + 8.740953582272147335100537849981160931197E0L, + 4.876422978828717219629814794707963640913E-2L +}; +#define NRDr8 8 +static const long double RDr8[NRDr8 + 1] = +{ + 6.358593134096908350929496535931630140282E1L, + 9.900253816552450073757174323424051765523E2L, + 5.642928777856801020545245437089490805186E3L, + 1.524195375199570868195152698617273739609E4L, + 2.113829644500006749947332935305800887345E4L, + 1.526438562626465706267943737310282977138E4L, + 5.561370922149241457131421914140039411782E3L, + 9.394035530179705051609070428036834496942E2L, + 6.147019596150394577984175188032707343615E1L + /* 1.0E0 */ +}; + +/* erfc(1/x) = 1/x exp (-1/x^2 - 0.5625 + R(1/x^2)) + 0.75 <= 1/x <= 0.875 + Peak relative error 2.0e-36 */ +#define NRNr7 9 +static const long double RNr7[NRNr7 + 1] = +{ + 1.686222193385987690785945787708644476545E1L, + 1.178224543567604215602418571310612066594E3L, + 1.764550584290149466653899886088166091093E4L, + 1.073758321890334822002849369898232811561E5L, + 3.132840749205943137619839114451290324371E5L, + 4.607864939974100224615527007793867585915E5L, + 3.389781820105852303125270837910972384510E5L, + 1.174042187110565202875011358512564753399E5L, + 1.660013606011167144046604892622504338313E4L, + 6.700393957480661937695573729183733234400E2L +}; +#define NRDr7 9 +static const long double RDr7[NRDr7 + 1] = +{ +-1.709305024718358874701575813642933561169E3L, +-3.280033887481333199580464617020514788369E4L, +-2.345284228022521885093072363418750835214E5L, +-8.086758123097763971926711729242327554917E5L, +-1.456900414510108718402423999575992450138E6L, +-1.391654264881255068392389037292702041855E6L, +-6.842360801869939983674527468509852583855E5L, +-1.597430214446573566179675395199807533371E5L, +-1.488876130609876681421645314851760773480E4L, +-3.511762950935060301403599443436465645703E2L + /* 1.0E0 */ +}; + +/* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) + 5/8 <= 1/x < 3/4 + Peak relative error 1.9e-35 */ +#define NRNr6 9 +static const long double RNr6[NRNr6 + 1] = +{ + 1.642076876176834390623842732352935761108E0L, + 1.207150003611117689000664385596211076662E2L, + 2.119260779316389904742873816462800103939E3L, + 1.562942227734663441801452930916044224174E4L, + 5.656779189549710079988084081145693580479E4L, + 1.052166241021481691922831746350942786299E5L, + 9.949798524786000595621602790068349165758E4L, + 4.491790734080265043407035220188849562856E4L, + 8.377074098301530326270432059434791287601E3L, + 4.506934806567986810091824791963991057083E2L +}; +#define NRDr6 9 +static const long double RDr6[NRDr6 + 1] = +{ +-1.664557643928263091879301304019826629067E2L, +-3.800035902507656624590531122291160668452E3L, +-3.277028191591734928360050685359277076056E4L, +-1.381359471502885446400589109566587443987E5L, +-3.082204287382581873532528989283748656546E5L, +-3.691071488256738343008271448234631037095E5L, +-2.300482443038349815750714219117566715043E5L, +-6.873955300927636236692803579555752171530E4L, +-8.262158817978334142081581542749986845399E3L, +-2.517122254384430859629423488157361983661E2L + /* 1.00 */ +}; + +/* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) + 1/2 <= 1/x < 5/8 + Peak relative error 4.6e-36 */ +#define NRNr5 10 +static const long double RNr5[NRNr5 + 1] = +{ +-3.332258927455285458355550878136506961608E-3L, +-2.697100758900280402659586595884478660721E-1L, +-6.083328551139621521416618424949137195536E0L, +-6.119863528983308012970821226810162441263E1L, +-3.176535282475593173248810678636522589861E2L, +-8.933395175080560925809992467187963260693E2L, +-1.360019508488475978060917477620199499560E3L, +-1.075075579828188621541398761300910213280E3L, +-4.017346561586014822824459436695197089916E2L, +-5.857581368145266249509589726077645791341E1L, +-2.077715925587834606379119585995758954399E0L +}; +#define NRDr5 9 +static const long double RDr5[NRDr5 + 1] = +{ + 3.377879570417399341550710467744693125385E-1L, + 1.021963322742390735430008860602594456187E1L, + 1.200847646592942095192766255154827011939E2L, + 7.118915528142927104078182863387116942836E2L, + 2.318159380062066469386544552429625026238E3L, + 4.238729853534009221025582008928765281620E3L, + 4.279114907284825886266493994833515580782E3L, + 2.257277186663261531053293222591851737504E3L, + 5.570475501285054293371908382916063822957E2L, + 5.142189243856288981145786492585432443560E1L + /* 1.0E0 */ +}; + +/* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) + 3/8 <= 1/x < 1/2 + Peak relative error 2.0e-36 */ +#define NRNr4 10 +static const long double RNr4[NRNr4 + 1] = +{ + 3.258530712024527835089319075288494524465E-3L, + 2.987056016877277929720231688689431056567E-1L, + 8.738729089340199750734409156830371528862E0L, + 1.207211160148647782396337792426311125923E2L, + 8.997558632489032902250523945248208224445E2L, + 3.798025197699757225978410230530640879762E3L, + 9.113203668683080975637043118209210146846E3L, + 1.203285891339933238608683715194034900149E4L, + 8.100647057919140328536743641735339740855E3L, + 2.383888249907144945837976899822927411769E3L, + 2.127493573166454249221983582495245662319E2L +}; +#define NRDr4 10 +static const long double RDr4[NRDr4 + 1] = +{ +-3.303141981514540274165450687270180479586E-1L, +-1.353768629363605300707949368917687066724E1L, +-2.206127630303621521950193783894598987033E2L, +-1.861800338758066696514480386180875607204E3L, +-8.889048775872605708249140016201753255599E3L, +-2.465888106627948210478692168261494857089E4L, +-3.934642211710774494879042116768390014289E4L, +-3.455077258242252974937480623730228841003E4L, +-1.524083977439690284820586063729912653196E4L, +-2.810541887397984804237552337349093953857E3L, +-1.343929553541159933824901621702567066156E2L + /* 1.0E0 */ +}; + +/* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) + 1/4 <= 1/x < 3/8 + Peak relative error 8.4e-37 */ +#define NRNr3 11 +static const long double RNr3[NRNr3 + 1] = +{ +-1.952401126551202208698629992497306292987E-6L, +-2.130881743066372952515162564941682716125E-4L, +-8.376493958090190943737529486107282224387E-3L, +-1.650592646560987700661598877522831234791E-1L, +-1.839290818933317338111364667708678163199E0L, +-1.216278715570882422410442318517814388470E1L, +-4.818759344462360427612133632533779091386E1L, +-1.120994661297476876804405329172164436784E2L, +-1.452850765662319264191141091859300126931E2L, +-9.485207851128957108648038238656777241333E1L, +-2.563663855025796641216191848818620020073E1L, +-1.787995944187565676837847610706317833247E0L +}; +#define NRDr3 10 +static const long double RDr3[NRDr3 + 1] = +{ + 1.979130686770349481460559711878399476903E-4L, + 1.156941716128488266238105813374635099057E-2L, + 2.752657634309886336431266395637285974292E-1L, + 3.482245457248318787349778336603569327521E0L, + 2.569347069372696358578399521203959253162E1L, + 1.142279000180457419740314694631879921561E2L, + 3.056503977190564294341422623108332700840E2L, + 4.780844020923794821656358157128719184422E2L, + 4.105972727212554277496256802312730410518E2L, + 1.724072188063746970865027817017067646246E2L, + 2.815939183464818198705278118326590370435E1L + /* 1.0E0 */ +}; + +/* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) + 1/8 <= 1/x < 1/4 + Peak relative error 1.5e-36 */ +#define NRNr2 11 +static const long double RNr2[NRNr2 + 1] = +{ +-2.638914383420287212401687401284326363787E-8L, +-3.479198370260633977258201271399116766619E-6L, +-1.783985295335697686382487087502222519983E-4L, +-4.777876933122576014266349277217559356276E-3L, +-7.450634738987325004070761301045014986520E-2L, +-7.068318854874733315971973707247467326619E-1L, +-4.113919921935944795764071670806867038732E0L, +-1.440447573226906222417767283691888875082E1L, +-2.883484031530718428417168042141288943905E1L, +-2.990886974328476387277797361464279931446E1L, +-1.325283914915104866248279787536128997331E1L, +-1.572436106228070195510230310658206154374E0L +}; +#define NRDr2 10 +static const long double RDr2[NRDr2 + 1] = +{ + 2.675042728136731923554119302571867799673E-6L, + 2.170997868451812708585443282998329996268E-4L, + 7.249969752687540289422684951196241427445E-3L, + 1.302040375859768674620410563307838448508E-1L, + 1.380202483082910888897654537144485285549E0L, + 8.926594113174165352623847870299170069350E0L, + 3.521089584782616472372909095331572607185E1L, + 8.233547427533181375185259050330809105570E1L, + 1.072971579885803033079469639073292840135E2L, + 6.943803113337964469736022094105143158033E1L, + 1.775695341031607738233608307835017282662E1L + /* 1.0E0 */ +}; + +/* erfc(1/x) = 1/x exp(-1/x^2 - 0.5625 + R(1/x^2)) + 1/128 <= 1/x < 1/8 + Peak relative error 2.2e-36 */ +#define NRNr1 9 +static const long double RNr1[NRNr1 + 1] = +{ +-4.250780883202361946697751475473042685782E-8L, +-5.375777053288612282487696975623206383019E-6L, +-2.573645949220896816208565944117382460452E-4L, +-6.199032928113542080263152610799113086319E-3L, +-8.262721198693404060380104048479916247786E-2L, +-6.242615227257324746371284637695778043982E-1L, +-2.609874739199595400225113299437099626386E0L, +-5.581967563336676737146358534602770006970E0L, +-5.124398923356022609707490956634280573882E0L, +-1.290865243944292370661544030414667556649E0L +}; +#define NRDr1 8 +static const long double RDr1[NRDr1 + 1] = +{ + 4.308976661749509034845251315983612976224E-6L, + 3.265390126432780184125233455960049294580E-4L, + 9.811328839187040701901866531796570418691E-3L, + 1.511222515036021033410078631914783519649E-1L, + 1.289264341917429958858379585970225092274E0L, + 6.147640356182230769548007536914983522270E0L, + 1.573966871337739784518246317003956180750E1L, + 1.955534123435095067199574045529218238263E1L, + 9.472613121363135472247929109615785855865E0L + /* 1.0E0 */ +}; + + +long double +erfl(long double x) +{ + long double a, y, z; + int32_t i, ix, sign; + ieee_quad_shape_type u; + + u.value = x; + sign = u.parts32.mswhi; + ix = sign & 0x7fffffff; + + if (ix >= 0x7fff0000) + { /* erf(nan)=nan */ + i = ((sign & 0xffff0000) >> 31) << 1; + return (long double) (1 - i) + one / x; /* erf(+-inf)=+-1 */ + } + + if (ix >= 0x3fff0000) /* |x| >= 1.0 */ + { + y = erfcl (x); + return (one - y); + /* return (one - erfcl (x)); */ + } + u.parts32.mswhi = ix; + a = u.value; + z = x * x; + if (ix < 0x3ffec000) /* a < 0.875 */ + { + if (ix < 0x3fc60000) /* |x|<2**-57 */ + { + if (ix < 0x00080000) + return 0.125 * (8.0 * x + efx8 * x); /*avoid underflow */ + return x + efx * x; + } + y = a + a * neval (z, TN1, NTN1) / deval (z, TD1, NTD1); + } + else + { + a = a - one; + y = erf_const + neval (a, TN2, NTN2) / deval (a, TD2, NTD2); + } + + if (sign & 0x80000000) /* x < 0 */ + y = -y; + return( y ); +} + +long double +erfcl(long double x) +{ + long double y, z, p, r; + int32_t i, ix, sign; + ieee_quad_shape_type u; + + u.value = x; + sign = u.parts32.mswhi; + ix = sign & 0x7fffffff; + u.parts32.mswhi = ix; + + if (ix >= 0x7fff0000) + { /* erfc(nan)=nan */ + /* erfc(+-inf)=0,2 */ + return (long double) (((u_int32_t) sign >> 31) << 1) + one / x; + } + + if (ix < 0x3ffd0000) /* |x| <1/4 */ + { + if (ix < 0x3f8d0000) /* |x|<2**-114 */ + return one - x; + return one - erfl (x); + } + if (ix < 0x3fff4000) /* 1.25 */ + { + x = u.value; + i = 8.0 * x; + switch (i) + { + case 2: + z = x - 0.25L; + y = C13b + z * neval (z, RNr13, NRNr13) / deval (z, RDr13, NRDr13); + y += C13a; + break; + case 3: + z = x - 0.375L; + y = C14b + z * neval (z, RNr14, NRNr14) / deval (z, RDr14, NRDr14); + y += C14a; + break; + case 4: + z = x - 0.5L; + y = C15b + z * neval (z, RNr15, NRNr15) / deval (z, RDr15, NRDr15); + y += C15a; + break; + case 5: + z = x - 0.625L; + y = C16b + z * neval (z, RNr16, NRNr16) / deval (z, RDr16, NRDr16); + y += C16a; + break; + case 6: + z = x - 0.75L; + y = C17b + z * neval (z, RNr17, NRNr17) / deval (z, RDr17, NRDr17); + y += C17a; + break; + case 7: + z = x - 0.875L; + y = C18b + z * neval (z, RNr18, NRNr18) / deval (z, RDr18, NRDr18); + y += C18a; + break; + case 8: + z = x - 1.0L; + y = C19b + z * neval (z, RNr19, NRNr19) / deval (z, RDr19, NRDr19); + y += C19a; + break; + case 9: + z = x - 1.125L; + y = C20b + z * neval (z, RNr20, NRNr20) / deval (z, RDr20, NRDr20); + y += C20a; + break; + } + if (sign & 0x80000000) + y = 2.0L - y; + return y; + } + /* 1.25 < |x| < 107 */ + if (ix < 0x4005ac00) + { + /* x < -9 */ + if ((ix >= 0x40022000) && (sign & 0x80000000)) + return two - tiny; + + x = fabsl (x); + z = one / (x * x); + i = 8.0 / x; + switch (i) + { + default: + case 0: + p = neval (z, RNr1, NRNr1) / deval (z, RDr1, NRDr1); + break; + case 1: + p = neval (z, RNr2, NRNr2) / deval (z, RDr2, NRDr2); + break; + case 2: + p = neval (z, RNr3, NRNr3) / deval (z, RDr3, NRDr3); + break; + case 3: + p = neval (z, RNr4, NRNr4) / deval (z, RDr4, NRDr4); + break; + case 4: + p = neval (z, RNr5, NRNr5) / deval (z, RDr5, NRDr5); + break; + case 5: + p = neval (z, RNr6, NRNr6) / deval (z, RDr6, NRDr6); + break; + case 6: + p = neval (z, RNr7, NRNr7) / deval (z, RDr7, NRDr7); + break; + case 7: + p = neval (z, RNr8, NRNr8) / deval (z, RDr8, NRDr8); + break; + } + u.value = x; + u.parts32.lswlo = 0; + u.parts32.lswhi &= 0xfe000000; + z = u.value; + r = expl (-z * z - 0.5625) * + expl ((z - x) * (z + x) + p); + if ((sign & 0x80000000) == 0) + return r / x; + else + return two - r / x; + } + else + { + if ((sign & 0x80000000) == 0) + return tiny * tiny; + else + return two - tiny; + } +} diff --git a/lib/libm/src/ld128/s_expm1l.c b/lib/libm/src/ld128/s_expm1l.c new file mode 100644 index 00000000000..eb58b3ee209 --- /dev/null +++ b/lib/libm/src/ld128/s_expm1l.c @@ -0,0 +1,162 @@ +/* $OpenBSD: s_expm1l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* expm1l.c + * + * Exponential function, minus 1 + * 128-bit long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, expm1l(); + * + * y = expm1l( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power, minus one. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * An expansion x + .5 x^2 + x^3 R(x) approximates exp(f) - 1 + * in the basic range [-0.5 ln 2, 0.5 ln 2]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -79,+MAXLOG 100,000 1.7e-34 4.5e-35 + * + */ + +#include <errno.h> +#include <math.h> + +#include "math_private.h" + +/* exp(x) - 1 = x + 0.5 x^2 + x^3 P(x)/Q(x) + -.5 ln 2 < x < .5 ln 2 + Theoretical peak relative error = 8.1e-36 */ + +static const long double + P0 = 2.943520915569954073888921213330863757240E8L, + P1 = -5.722847283900608941516165725053359168840E7L, + P2 = 8.944630806357575461578107295909719817253E6L, + P3 = -7.212432713558031519943281748462837065308E5L, + P4 = 4.578962475841642634225390068461943438441E4L, + P5 = -1.716772506388927649032068540558788106762E3L, + P6 = 4.401308817383362136048032038528753151144E1L, + P7 = -4.888737542888633647784737721812546636240E-1L, + Q0 = 1.766112549341972444333352727998584753865E9L, + Q1 = -7.848989743695296475743081255027098295771E8L, + Q2 = 1.615869009634292424463780387327037251069E8L, + Q3 = -2.019684072836541751428967854947019415698E7L, + Q4 = 1.682912729190313538934190635536631941751E6L, + Q5 = -9.615511549171441430850103489315371768998E4L, + Q6 = 3.697714952261803935521187272204485251835E3L, + Q7 = -8.802340681794263968892934703309274564037E1L, + /* Q8 = 1.000000000000000000000000000000000000000E0 */ +/* C1 + C2 = ln 2 */ + + C1 = 6.93145751953125E-1L, + C2 = 1.428606820309417232121458176568075500134E-6L, +/* ln (2^16384 * (1 - 2^-113)) */ + maxlog = 1.1356523406294143949491931077970764891253E4L, +/* ln 2^-114 */ + minarg = -7.9018778583833765273564461846232128760607E1L, big = 1e4932L; + + +long double +expm1l(long double x) +{ + long double px, qx, xx; + int32_t ix, sign; + ieee_quad_shape_type u; + int k; + + /* Detect infinity and NaN. */ + u.value = x; + ix = u.parts32.mswhi; + sign = ix & 0x80000000; + ix &= 0x7fffffff; + if (ix >= 0x7fff0000) + { + /* Infinity. */ + if (((ix & 0xffff) | u.parts32.mswlo | u.parts32.lswhi | + u.parts32.lswlo) == 0) + { + if (sign) + return -1.0L; + else + return x; + } + /* NaN. No invalid exception. */ + return x; + } + + /* expm1(+- 0) = +- 0. */ + if ((ix == 0) && (u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) + return x; + + /* Overflow. */ + if (x > maxlog) + return (big * big); + + /* Minimum value. */ + if (x < minarg) + return (4.0/big - 1.0L); + + /* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */ + xx = C1 + C2; /* ln 2. */ + px = floorl (0.5 + x / xx); + k = px; + /* remainder times ln 2 */ + x -= px * C1; + x -= px * C2; + + /* Approximate exp(remainder ln 2). */ + px = (((((((P7 * x + + P6) * x + + P5) * x + P4) * x + P3) * x + P2) * x + P1) * x + P0) * x; + + qx = (((((((x + + Q7) * x + + Q6) * x + Q5) * x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0; + + xx = x * x; + qx = x + (0.5 * xx + xx * px / qx); + + /* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2). + + We have qx = exp(remainder ln 2) - 1, so + exp(x) - 1 = 2^k (qx + 1) - 1 + = 2^k qx + 2^k - 1. */ + + px = ldexpl (1.0L, k); + x = px * qx + (px - 1.0); + return x; +} diff --git a/lib/libm/src/ld128/s_floorl.c b/lib/libm/src/ld128/s_floorl.c new file mode 100644 index 00000000000..e3c05d1c914 --- /dev/null +++ b/lib/libm/src/ld128/s_floorl.c @@ -0,0 +1,70 @@ +/* @(#)s_floor.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * floorl(x) + * Return x rounded toward -inf to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to floor(x). + */ + +#include <math.h> + +#include "math_private.h" + +static const long double huge = 1.0e4930L; + +long double +floorl(long double x) +{ + int64_t i0,i1,jj0; + u_int64_t i,j; + GET_LDOUBLE_WORDS64(i0,i1,x); + jj0 = ((i0>>48)&0x7fff)-0x3fff; + if(jj0<48) { + if(jj0<0) { /* raise inexact if x != 0 */ + if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ + if(i0>=0) {i0=i1=0;} + else if(((i0&0x7fffffffffffffffLL)|i1)!=0) + { i0=0xbfff000000000000ULL;i1=0;} + } + } else { + i = (0x0000ffffffffffffULL)>>jj0; + if(((i0&i)|i1)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(i0<0) i0 += (0x0001000000000000LL)>>jj0; + i0 &= (~i); i1=0; + } + } + } else if (jj0>111) { + if(jj0==0x4000) return x+x; /* inf or NaN */ + else return x; /* x is integral */ + } else { + i = -1ULL>>(jj0-48); + if((i1&i)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(i0<0) { + if(jj0==48) i0+=1; + else { + j = i1+(1LL<<(112-jj0)); + if(j<i1) i0 +=1 ; /* got a carry */ + i1=j; + } + } + i1 &= (~i); + } + } + SET_LDOUBLE_WORDS64(x,i0,i1); + return x; +} diff --git a/lib/libm/src/ld128/s_log1pl.c b/lib/libm/src/ld128/s_log1pl.c new file mode 100644 index 00000000000..673bf6a1617 --- /dev/null +++ b/lib/libm/src/ld128/s_log1pl.c @@ -0,0 +1,247 @@ +/* $OpenBSD: s_log1pl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* log1pl.c + * + * Relative error logarithm + * Natural logarithm of 1+x, 128-bit long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, log1pl(); + * + * y = log1pl( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of 1+x. + * + * The argument 1+x is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). + * + * Otherwise, setting z = 2(w-1)/(w+1), + * + * log(w) = z + z^3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1, 8 100000 1.9e-34 4.3e-35 + */ + +#include <math.h> + +#include "math_private.h" + +/* Coefficients for log(1+x) = x - x^2 / 2 + x^3 P(x)/Q(x) + * 1/sqrt(2) <= 1+x < sqrt(2) + * Theoretical peak relative error = 5.3e-37, + * relative peak error spread = 2.3e-14 + */ +static const long double + P12 = 1.538612243596254322971797716843006400388E-6L, + P11 = 4.998469661968096229986658302195402690910E-1L, + P10 = 2.321125933898420063925789532045674660756E1L, + P9 = 4.114517881637811823002128927449878962058E2L, + P8 = 3.824952356185897735160588078446136783779E3L, + P7 = 2.128857716871515081352991964243375186031E4L, + P6 = 7.594356839258970405033155585486712125861E4L, + P5 = 1.797628303815655343403735250238293741397E5L, + P4 = 2.854829159639697837788887080758954924001E5L, + P3 = 3.007007295140399532324943111654767187848E5L, + P2 = 2.014652742082537582487669938141683759923E5L, + P1 = 7.771154681358524243729929227226708890930E4L, + P0 = 1.313572404063446165910279910527789794488E4L, + /* Q12 = 1.000000000000000000000000000000000000000E0L, */ + Q11 = 4.839208193348159620282142911143429644326E1L, + Q10 = 9.104928120962988414618126155557301584078E2L, + Q9 = 9.147150349299596453976674231612674085381E3L, + Q8 = 5.605842085972455027590989944010492125825E4L, + Q7 = 2.248234257620569139969141618556349415120E5L, + Q6 = 6.132189329546557743179177159925690841200E5L, + Q5 = 1.158019977462989115839826904108208787040E6L, + Q4 = 1.514882452993549494932585972882995548426E6L, + Q3 = 1.347518538384329112529391120390701166528E6L, + Q2 = 7.777690340007566932935753241556479363645E5L, + Q1 = 2.626900195321832660448791748036714883242E5L, + Q0 = 3.940717212190338497730839731583397586124E4L; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 1.1e-35, + * relative peak error spread 1.1e-9 + */ +static const long double + R5 = -8.828896441624934385266096344596648080902E-1L, + R4 = 8.057002716646055371965756206836056074715E1L, + R3 = -2.024301798136027039250415126250455056397E3L, + R2 = 2.048819892795278657810231591630928516206E4L, + R1 = -8.977257995689735303686582344659576526998E4L, + R0 = 1.418134209872192732479751274970992665513E5L, + /* S6 = 1.000000000000000000000000000000000000000E0L, */ + S5 = -1.186359407982897997337150403816839480438E2L, + S4 = 3.998526750980007367835804959888064681098E3L, + S3 = -5.748542087379434595104154610899551484314E4L, + S2 = 4.001557694070773974936904547424676279307E5L, + S1 = -1.332535117259762928288745111081235577029E6L, + S0 = 1.701761051846631278975701529965589676574E6L; + +/* C1 + C2 = ln 2 */ +static const long double C1 = 6.93145751953125E-1L; +static const long double C2 = 1.428606820309417232121458176568075500134E-6L; + +static const long double sqrth = 0.7071067811865475244008443621048490392848L; +/* ln (2^16384 * (1 - 2^-113)) */ +static const long double zero = 0.0L; + +long double +log1pl(long double xm1) +{ + long double x, y, z, r, s; + ieee_quad_shape_type u; + int32_t hx; + int e; + + /* Test for NaN or infinity input. */ + u.value = xm1; + hx = u.parts32.mswhi; + if (hx >= 0x7fff0000) + return xm1; + + /* log1p(+- 0) = +- 0. */ + if (((hx & 0x7fffffff) == 0) + && (u.parts32.mswlo | u.parts32.lswhi | u.parts32.lswlo) == 0) + return xm1; + + x = xm1 + 1.0L; + + /* log1p(-1) = -inf */ + if (x <= 0.0L) + { + if (x == 0.0L) + return (-1.0L / (x - x)); + else + return (zero / (x - x)); + } + + /* Separate mantissa from exponent. */ + + /* Use frexp used so that denormal numbers will be handled properly. */ + x = frexpl (x, &e); + + /* Logarithm using log(x) = z + z^3 P(z^2)/Q(z^2), + where z = 2(x-1)/x+1). */ + if ((e > 2) || (e < -2)) + { + if (x < sqrth) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } + else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x * x; + r = ((((R5 * z + + R4) * z + + R3) * z + + R2) * z + + R1) * z + + R0; + s = (((((z + + S5) * z + + S4) * z + + S3) * z + + S2) * z + + S1) * z + + S0; + z = x * (z * r / s); + z = z + e * C2; + z = z + x; + z = z + e * C1; + return (z); + } + + + /* Logarithm using log(1+x) = x - .5x^2 + x^3 P(x)/Q(x). */ + + if (x < sqrth) + { + e -= 1; + if (e != 0) + x = 2.0L * x - 1.0L; /* 2x - 1 */ + else + x = xm1; + } + else + { + if (e != 0) + x = x - 1.0L; + else + x = xm1; + } + z = x * x; + r = (((((((((((P12 * x + + P11) * x + + P10) * x + + P9) * x + + P8) * x + + P7) * x + + P6) * x + + P5) * x + + P4) * x + + P3) * x + + P2) * x + + P1) * x + + P0; + s = (((((((((((x + + Q11) * x + + Q10) * x + + Q9) * x + + Q8) * x + + Q7) * x + + Q6) * x + + Q5) * x + + Q4) * x + + Q3) * x + + Q2) * x + + Q1) * x + + Q0; + y = x * (z * r / s); + y = y + e * C2; + z = y - 0.5L * z; + z = z + x; + z = z + e * C1; + return (z); +} diff --git a/lib/libm/src/ld128/s_modfl.c b/lib/libm/src/ld128/s_modfl.c new file mode 100644 index 00000000000..0ca4a354631 --- /dev/null +++ b/lib/libm/src/ld128/s_modfl.c @@ -0,0 +1,73 @@ +/* @(#)s_modf.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * modfl(long double x, long double *iptr) + * return fraction part of x, and return x's integral part in *iptr. + * Method: + * Bit twiddling. + * + * Exception: + * No exception. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0; + +long double +modfl(long double x, long double *iptr) +{ + int64_t i0,i1,jj0; + u_int64_t i; + GET_LDOUBLE_WORDS64(i0,i1,x); + jj0 = ((i0>>48)&0x7fff)-0x3fff; /* exponent of x */ + if(jj0<48) { /* integer part in high x */ + if(jj0<0) { /* |x|<1 */ + /* *iptr = +-0 */ + SET_LDOUBLE_WORDS64(*iptr,i0&0x8000000000000000ULL,0); + return x; + } else { + i = (0x0000ffffffffffffLL)>>jj0; + if(((i0&i)|i1)==0) { /* x is integral */ + *iptr = x; + /* return +-0 */ + SET_LDOUBLE_WORDS64(x,i0&0x8000000000000000ULL,0); + return x; + } else { + SET_LDOUBLE_WORDS64(*iptr,i0&(~i),0); + return x - *iptr; + } + } + } else if (jj0>111) { /* no fraction part */ + *iptr = x*one; + /* We must handle NaNs separately. */ + if (jj0 == 0x4000 && ((i0 & 0x0000ffffffffffffLL) | i1)) + return x*one; + /* return +-0 */ + SET_LDOUBLE_WORDS64(x,i0&0x8000000000000000ULL,0); + return x; + } else { /* fraction part in low x */ + i = -1ULL>>(jj0-48); + if((i1&i)==0) { /* x is integral */ + *iptr = x; + /* return +-0 */ + SET_LDOUBLE_WORDS64(x,i0&0x8000000000000000ULL,0); + return x; + } else { + SET_LDOUBLE_WORDS64(*iptr,i0,i1&(~i)); + return x - *iptr; + } + } +} diff --git a/lib/libm/src/ld128/s_nextafterl.c b/lib/libm/src/ld128/s_nextafterl.c new file mode 100644 index 00000000000..2ef84bcc9c0 --- /dev/null +++ b/lib/libm/src/ld128/s_nextafterl.c @@ -0,0 +1,73 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* IEEE functions + * nextafterl(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include <sys/cdefs.h> +#include <math.h> + +#include "math_private.h" + +long double +nextafterl(long double x, long double y) +{ + int64_t hx,hy,ix,iy; + u_int64_t lx,ly; + + GET_LDOUBLE_WORDS64(hx,lx,x); + GET_LDOUBLE_WORDS64(hy,ly,y); + ix = hx&0x7fffffffffffffffLL; /* |x| */ + iy = hy&0x7fffffffffffffffLL; /* |y| */ + + if(((ix>=0x7fff000000000000LL)&&((ix-0x7fff000000000000LL)|lx)!=0) || /* x is nan */ + ((iy>=0x7fff000000000000LL)&&((iy-0x7fff000000000000LL)|ly)!=0)) /* y is nan */ + return x+y; + if(x==y) return y; /* x=y, return y */ + if((ix|lx)==0) { /* x == 0 */ + volatile long double u; + SET_LDOUBLE_WORDS64(x,hy&0x8000000000000000ULL,1);/* return +-minsubnormal */ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */ + if(lx==0) hx--; + lx--; + } else { /* x < y, x += ulp */ + lx++; + if(lx==0) hx++; + } + } else { /* x < 0 */ + if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */ + if(lx==0) hx--; + lx--; + } else { /* x > y, x += ulp */ + lx++; + if(lx==0) hx++; + } + } + hy = hx&0x7fff000000000000LL; + if(hy==0x7fff000000000000LL) return x+x;/* overflow */ + if(hy==0) { + volatile long double u = x*x; /* underflow */ + } + SET_LDOUBLE_WORDS64(x,hx,lx); + return x; +} + +__weak_alias(nexttowardl, nextafterl); diff --git a/lib/libm/src/ld128/s_nexttoward.c b/lib/libm/src/ld128/s_nexttoward.c new file mode 100644 index 00000000000..adbbb22ce00 --- /dev/null +++ b/lib/libm/src/ld128/s_nexttoward.c @@ -0,0 +1,85 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* IEEE functions + * nexttoward(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include <math.h> +#include <float.h> + +#include "math_private.h" + +double +nexttoward(double x, long double y) +{ + int32_t hx,ix; + int64_t hy,iy; + u_int32_t lx; + u_int64_t ly; + + EXTRACT_WORDS(hx,lx,x); + GET_LDOUBLE_WORDS64(hy,ly,y); + ix = hx&0x7fffffff; /* |x| */ + iy = hy&0x7fffffffffffffffLL; /* |y| */ + + if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ + ((iy>=0x7fff000000000000LL)&&((iy-0x7fff000000000000LL)|ly)!=0)) + /* y is nan */ + return x+y; + if((long double) x==y) return y; /* x=y, return y */ + if((ix|lx)==0) { /* x == 0 */ + volatile double u; + INSERT_WORDS(x,(u_int32_t)((hy>>32)&0x80000000),1);/* return +-minsub */ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if (hy<0||(ix>>20)>(iy>>48)-0x3c00 + || ((ix>>20)==(iy>>48)-0x3c00 + && (((((int64_t)hx)<<28)|(lx>>4))>(hy&0x0000ffffffffffffLL) + || (((((int64_t)hx)<<28)|(lx>>4))==(hy&0x0000ffffffffffffLL) + && (lx&0xf)>(ly>>60))))) { /* x > y, x -= ulp */ + if(lx==0) hx -= 1; + lx -= 1; + } else { /* x < y, x += ulp */ + lx += 1; + if(lx==0) hx += 1; + } + } else { /* x < 0 */ + if (hy>=0||(ix>>20)>(iy>>48)-0x3c00 + || ((ix>>20)==(iy>>48)-0x3c00 + && (((((int64_t)hx)<<28)|(lx>>4))>(hy&0x0000ffffffffffffLL) + || (((((int64_t)hx)<<28)|(lx>>4))==(hy&0x0000ffffffffffffLL) + && (lx&0xf)>(ly>>60))))) { /* x < y, x -= ulp */ + if(lx==0) hx -= 1; + lx -= 1; + } else { /* x > y, x += ulp */ + lx += 1; + if(lx==0) hx += 1; + } + } + hy = hx&0x7ff00000; + if(hy>=0x7ff00000) { + x = x+x; /* overflow */ + return x; + } + if(hy<0x00100000) { + volatile double u = x*x; /* underflow */ + } + INSERT_WORDS(x,hx,lx); + return x; +} diff --git a/lib/libm/src/ld128/s_nexttowardf.c b/lib/libm/src/ld128/s_nexttowardf.c new file mode 100644 index 00000000000..e63a165a5b6 --- /dev/null +++ b/lib/libm/src/ld128/s_nexttowardf.c @@ -0,0 +1,65 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include <math.h> + +#include "math_private.h" + +float +nexttowardf(float x, long double y) +{ + int32_t hx,ix; + int64_t hy,iy; + u_int64_t ly; + + GET_FLOAT_WORD(hx,x); + GET_LDOUBLE_WORDS64(hy,ly,y); + ix = hx&0x7fffffff; /* |x| */ + iy = hy&0x7fffffffffffffffLL; /* |y| */ + + if((ix>0x7f800000) || /* x is nan */ + ((iy>=0x7fff000000000000LL)&&((iy-0x7fff000000000000LL)|ly)!=0)) + /* y is nan */ + return x+y; + if((long double) x==y) return y; /* x=y, return y */ + if(ix==0) { /* x == 0 */ + volatile float u; + SET_FLOAT_WORD(x,(u_int32_t)((hy>>32)&0x80000000)|1);/* return +-minsub*/ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if(hy<0||(ix>>23)>(iy>>48)-0x3f80 + || ((ix>>23)==(iy>>48)-0x3f80 + && (ix&0x7fffff)>((hy>>25)&0x7fffff))) {/* x > y, x -= ulp */ + hx -= 1; + } else { /* x < y, x += ulp */ + hx += 1; + } + } else { /* x < 0 */ + if(hy>=0||(ix>>23)>(iy>>48)-0x3f80 + || ((ix>>23)==(iy>>48)-0x3f80 + && (ix&0x7fffff)>((hy>>25)&0x7fffff))) {/* x < y, x -= ulp */ + hx -= 1; + } else { /* x > y, x += ulp */ + hx += 1; + } + } + hy = hx&0x7f800000; + if(hy>=0x7f800000) return x+x; /* overflow */ + if(hy<0x00800000) { + volatile float u = x*x; /* underflow */ + } + SET_FLOAT_WORD(x,hx); + return x; +} diff --git a/lib/libm/src/ld128/s_remquol.c b/lib/libm/src/ld128/s_remquol.c new file mode 100644 index 00000000000..3a5087b46b2 --- /dev/null +++ b/lib/libm/src/ld128/s_remquol.c @@ -0,0 +1,173 @@ +/* @(#)e_fmod.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 <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_remquol.c,v 1.2 2008/07/31 20:09:47 das Exp $"); +#endif + +#include <sys/types.h> +#include <machine/ieee.h> + +#include <float.h> +#include <math.h> +#include <stdint.h> + +#include "math_private.h" + +#define BIAS (LDBL_MAX_EXP - 1) + +/* + * These macros add and remove an explicit integer bit in front of the + * fractional mantissa, if the architecture doesn't have such a bit by + * default already. + */ +#ifdef LDBL_IMPLICIT_NBIT +#define LDBL_NBIT 0 +#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) +#define HFRAC_BITS (EXT_FRACHBITS + EXT_FRACHMBITS) +#else +#define LDBL_NBIT 0x80000000 +#define SET_NBIT(hx) (hx) +#define HFRAC_BITS (EXT_FRACHBITS + EXT_FRACHMBITS - 1) +#endif + +#define MANL_SHIFT (EXT_FRACLMBITS + EXT_FRACLBITS - 1) + +static const long double Zero[] = {0.0L, -0.0L}; + +/* + * Return the IEEE remainder and set *quo to the last n bits of the + * quotient, rounded to the nearest integer. We choose n=31 because + * we wind up computing all the integer bits of the quotient anyway as + * a side-effect of computing the remainder by the shift and subtract + * method. In practice, this is far more bits than are needed to use + * remquo in reduction algorithms. + * + * Assumptions: + * - The low part of the mantissa fits in a manl_t exactly. + * - The high part of the mantissa fits in an int64_t with enough room + * for an explicit integer bit in front of the fractional bits. + */ +long double +remquol(long double x, long double y, int *quo) +{ + int64_t hx,hz,hy,_hx; + uint64_t lx,ly,lz; + uint64_t sx,sxy; + int ix,iy,n,q; + + GET_LDOUBLE_WORDS64(hx,lx,x); + GET_LDOUBLE_WORDS64(hy,ly,y); + sx = (hx>>48)&0x8000; + sxy = sx ^ ((hy>>48)&0x8000); + hx &= 0x7fffffffffffffffLL; /* |x| */ + hy &= 0x7fffffffffffffffLL; /* |y| */ + SET_LDOUBLE_WORDS64(x,hx,lx); + SET_LDOUBLE_WORDS64(y,hy,ly); + + /* purge off exception values */ + if((hy|ly)==0 || /* y=0 */ + ((hx>>48) == BIAS + LDBL_MAX_EXP) || /* or x not finite */ + ((hy>>48) == BIAS + LDBL_MAX_EXP && + (((hy&0x0000ffffffffffffLL)&~LDBL_NBIT)|ly)!=0)) /* or y is NaN */ + return (x*y)/(x*y); + if((hx>>48)<=(hy>>48)) { + if(((hx>>48)<(hy>>48)) || + ((hx&0x0000ffffffffffffLL)<=(hy&0x0000ffffffffffffLL) && + ((hx&0x0000ffffffffffffLL)<(hy&0x0000ffffffffffffLL) || + lx<ly))) { + q = 0; + goto fixup; /* |x|<|y| return x or x-y */ + } + if((hx&0x0000ffffffffffffLL)==(hy&0x0000ffffffffffffLL) && + lx==ly) { + *quo = 1; + return Zero[sx!=0]; /* |x|=|y| return x*0*/ + } + } + + /* determine ix = ilogb(x) */ + if((hx>>48) == 0) { /* subnormal x */ + x *= 0x1.0p512; + GET_LDOUBLE_WORDS64(hx,lx,x); + ix = (hx>>48) - (BIAS + 512); + } else { + ix = (hx>>48) - BIAS; + } + + /* determine iy = ilogb(y) */ + if((hy>>48) == 0) { /* subnormal y */ + y *= 0x1.0p512; + GET_LDOUBLE_WORDS64(hy,ly,y); + iy = (hy>>48) - (BIAS + 512); + } else { + iy = (hy>>48) - BIAS; + } + + /* set up {hx,lx}, {hy,ly} and align y to x */ + _hx = SET_NBIT(hx) & 0x0000ffffffffffffLL; + hy = SET_NBIT(hy); + + /* fix point fmod */ + n = ix - iy; + q = 0; + + while(n--) { + hz=_hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz<0){_hx = _hx+_hx+(lx>>MANL_SHIFT); lx = lx+lx;} + else {_hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; q++;} + q <<= 1; + } + hz=_hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz>=0) {_hx=hz;lx=lz;q++;} + + /* convert back to floating value and restore the sign */ + if((_hx|lx)==0) { /* return sign(x)*0 */ + *quo = (sxy ? -q : q); + return Zero[sx!=0]; + } + while(_hx<(1ULL<<HFRAC_BITS)) { /* normalize x */ + _hx = _hx+_hx+(lx>>MANL_SHIFT); lx = lx+lx; + iy -= 1; + } + hx = (hx&0xffff000000000000LL) | (_hx&0x0000ffffffffffffLL); + if (iy < LDBL_MIN_EXP) { + hx = (hx&0x0000ffffffffffffLL) | (uint64_t)(iy + BIAS + 512)<<48; + SET_LDOUBLE_WORDS64(x,hx,lx); + x *= 0x1p-512; + GET_LDOUBLE_WORDS64(hx,lx,x); + } else { + hx = (hx&0x0000ffffffffffffLL) | (uint64_t)(iy + BIAS)<<48; + } + hx &= 0x7fffffffffffffffLL; + SET_LDOUBLE_WORDS64(x,hx,lx); +fixup: + y = fabsl(y); + if (y < LDBL_MIN * 2) { + if (x+x>y || (x+x==y && (q & 1))) { + q++; + x-=y; + } + } else if (x>0.5*y || (x==0.5*y && (q & 1))) { + q++; + x-=y; + } + + GET_LDOUBLE_MSW64(hx,x); + hx ^= sx; + SET_LDOUBLE_MSW64(x,hx); + + q &= 0x7fffffff; + *quo = (sxy ? -q : q); + return x; +} diff --git a/lib/libm/src/ld128/s_tanhl.c b/lib/libm/src/ld128/s_tanhl.c new file mode 100644 index 00000000000..78707a0ac21 --- /dev/null +++ b/lib/libm/src/ld128/s_tanhl.c @@ -0,0 +1,104 @@ +/* @(#)s_tanh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* tanhl(x) + * Return the Hyperbolic Tangent of x + * + * Method : + * x -x + * e - e + * 0. tanhl(x) is defined to be ----------- + * x -x + * e + e + * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x). + * 2. 0 <= x <= 2**-57 : tanhl(x) := x*(one+x) + * -t + * 2**-57 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x) + * t + 2 + * 2 + * 1 <= x <= 40.0 : tanhl(x) := 1- ----- ; t=expm1l(2x) + * t + 2 + * 40.0 < x <= INF : tanhl(x) := 1. + * + * Special cases: + * tanhl(NaN) is NaN; + * only tanhl(0)=0 is exact for finite argument. + */ + +#include "math.h" +#include "math_private.h" + +static const long double one = 1.0, two = 2.0, tiny = 1.0e-4900L; + +long double +tanhl(long double x) +{ + long double t, z; + u_int32_t jx, ix; + ieee_quad_shape_type u; + + /* Words of |x|. */ + u.value = x; + jx = u.parts32.mswhi; + ix = jx & 0x7fffffff; + /* x is INF or NaN */ + if (ix >= 0x7fff0000) + { + /* for NaN it's not important which branch: tanhl(NaN) = NaN */ + if (jx & 0x80000000) + return one / x - one; /* tanhl(-inf)= -1; */ + else + return one / x + one; /* tanhl(+inf)=+1 */ + } + + /* |x| < 40 */ + if (ix < 0x40044000) + { + if (u.value == 0) + return x; /* x == +- 0 */ + if (ix < 0x3fc60000) /* |x| < 2^-57 */ + return x * (one + tiny); /* tanh(small) = small */ + u.parts32.mswhi = ix; /* Absolute value of x. */ + if (ix >= 0x3fff0000) + { /* |x| >= 1 */ + t = expm1l (two * u.value); + z = one - two / (t + two); + } + else + { + t = expm1l (-two * u.value); + z = -t / (t + two); + } + /* |x| > 40, return +-1 */ + } + else + { + z = one - tiny; /* raised inexact flag */ + } + return (jx & 0x80000000) ? -z : z; +} diff --git a/lib/libm/src/ld128/s_truncl.c b/lib/libm/src/ld128/s_truncl.c new file mode 100644 index 00000000000..435d527a480 --- /dev/null +++ b/lib/libm/src/ld128/s_truncl.c @@ -0,0 +1,77 @@ +/* + * ==================================================== + * 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: @(#)s_floor.c 5.1 93/09/24 + */ + +#include <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_truncl.c,v 1.9 2008/02/14 15:10:34 bde Exp $"); +#endif + +/* + * truncl(x) + * Return x rounded toward 0 to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to truncl(x). + */ + +#include <sys/types.h> +#include <machine/ieee.h> + +#include <float.h> +#include <math.h> +#include <stdint.h> + +#include "math_private.h" + +#ifdef LDBL_IMPLICIT_NBIT +#define MANH_SIZE (EXT_FRACHBITS + EXT_FRACHMBITS + 1) +#else +#define MANH_SIZE (EXT_FRACHBITS + EXT_FRACHMBITS) +#endif + +static const long double huge = 1.0e300; +static const float zero[] = { 0.0, -0.0 }; + +long double +truncl(long double x) +{ + int e; + int64_t ix0, ix1; + + GET_LDOUBLE_WORDS64(ix0,ix1,x); + e = ((ix0>>48)&0x7fff) - LDBL_MAX_EXP + 1; + + if (e < MANH_SIZE - 1) { + if (e < 0) { /* raise inexact if x != 0 */ + if (huge + x > 0.0) + return (zero[((ix0>>48)&0x8000)!=0]); + } else { + uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); + if (((ix0 & m) | ix1) == 0) + return (x); /* x is integral */ + if (huge + x > 0.0) { /* raise inexact flag */ + ix0 &= ~m; + ix1 = 0; + } + } + } else if (e < LDBL_MANT_DIG - 1) { + uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); + if ((ix1 & m) == 0) + return (x); /* x is integral */ + if (huge + x > 0.0) /* raise inexact flag */ + ix1 &= ~m; + } + SET_LDOUBLE_WORDS64(x,ix0,ix1); + return (x); +} diff --git a/lib/libm/src/ld80/e_acoshl.c b/lib/libm/src/ld80/e_acoshl.c new file mode 100644 index 00000000000..0756fad68af --- /dev/null +++ b/lib/libm/src/ld80/e_acoshl.c @@ -0,0 +1,57 @@ +/* @(#)e_acosh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* acoshl(x) + * Method : + * Based on + * acoshl(x) = logl [ x + sqrtl(x*x-1) ] + * we have + * acoshl(x) := logl(x)+ln2, if x is large; else + * acoshl(x) := logl(2x-1/(sqrtl(x*x-1)+x)) if x>2; else + * acoshl(x) := log1pl(t+sqrtl(2.0*t+t*t)); where t=x-1. + * + * Special cases: + * acoshl(x) is NaN with signal if x<1. + * acoshl(NaN) is NaN without signal. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double +one = 1.0, +ln2 = 6.931471805599453094287e-01L; /* 0x3FFE, 0xB17217F7, 0xD1CF79AC */ + +long double +acoshl(long double x) +{ + long double t; + u_int32_t se,i0,i1; + GET_LDOUBLE_WORDS(se,i0,i1,x); + if(se<0x3fff || se & 0x8000) { /* x < 1 */ + return (x-x)/(x-x); + } else if(se >=0x401d) { /* x > 2**30 */ + if(se >=0x7fff) { /* x is inf of NaN */ + return x+x; + } else + return logl(x)+ln2; /* acoshl(huge)=logl(2x) */ + } else if(((se-0x3fff)|i0|i1)==0) { + return 0.0; /* acosh(1) = 0 */ + } else if (se > 0x4000) { /* 2**28 > x > 2 */ + t=x*x; + return logl(2.0*x-one/(x+sqrtl(t-one))); + } else { /* 1<x<2 */ + t = x-one; + return log1pl(t+sqrtl(2.0*t+t*t)); + } +} diff --git a/lib/libm/src/ld80/e_atanhl.c b/lib/libm/src/ld80/e_atanhl.c new file mode 100644 index 00000000000..d75a757f3b6 --- /dev/null +++ b/lib/libm/src/ld80/e_atanhl.c @@ -0,0 +1,60 @@ +/* @(#)e_atanh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* atanhl(x) + * Method : + * 1.Reduced x to positive by atanh(-x) = -atanh(x) + * 2.For x>=0.5 + * 1 2x x + * atanhl(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) + * 2 1 - x 1 - x + * + * For x<0.5 + * atanhl(x) = 0.5*log1pl(2x+2x*x/(1-x)) + * + * Special cases: + * atanhl(x) is NaN if |x| > 1 with signal; + * atanhl(NaN) is that NaN with no signal; + * atanhl(+-1) is +-INF with signal. + * + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0, huge = 1e4900L; + +static const long double zero = 0.0; + +long double +atanhl(long double x) +{ + long double t; + int32_t ix; + u_int32_t se,i0,i1; + GET_LDOUBLE_WORDS(se,i0,i1,x); + ix = se&0x7fff; + if ((ix+((((i0&0x7fffffff)|i1)|(-((i0&0x7fffffff)|i1)))>>31))>0x3fff) + /* |x|>1 */ + return (x-x)/(x-x); + if(ix==0x3fff) + return x/zero; + if(ix<0x3fe3&&(huge+x)>zero) return x; /* x<2**-28 */ + SET_LDOUBLE_EXP(x,ix); + if(ix<0x3ffe) { /* x < 0.5 */ + t = x+x; + t = 0.5*log1pl(t+t*x/(one-x)); + } else + t = 0.5*log1pl((x+x)/(one-x)); + if(se<=0x7fff) return t; else return -t; +} diff --git a/lib/libm/src/ld80/e_coshl.c b/lib/libm/src/ld80/e_coshl.c new file mode 100644 index 00000000000..25349dbb39a --- /dev/null +++ b/lib/libm/src/ld80/e_coshl.c @@ -0,0 +1,82 @@ +/* @(#)e_cosh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* coshl(x) + * Method : + * mathematically coshl(x) if defined to be (exp(x)+exp(-x))/2 + * 1. Replace x by |x| (coshl(x) = coshl(-x)). + * 2. + * [ exp(x) - 1 ]^2 + * 0 <= x <= ln2/2 : coshl(x) := 1 + ------------------- + * 2*exp(x) + * + * exp(x) + 1/exp(x) + * ln2/2 <= x <= 22 : coshl(x) := ------------------- + * 2 + * 22 <= x <= lnovft : coshl(x) := expl(x)/2 + * lnovft <= x <= ln2ovft: coshl(x) := expl(x/2)/2 * expl(x/2) + * ln2ovft < x : coshl(x) := huge*huge (overflow) + * + * Special cases: + * coshl(x) is |x| if x is +INF, -INF, or NaN. + * only coshl(0)=1 is exact for finite x. + */ + +#include "math.h" +#include "math_private.h" + +static const long double one = 1.0, half=0.5, huge = 1.0e4900L; + +long double +coshl(long double x) +{ + long double t,w; + int32_t ex; + u_int32_t mx,lx; + + /* High word of |x|. */ + GET_LDOUBLE_WORDS(ex,mx,lx,x); + ex &= 0x7fff; + + /* x is INF or NaN */ + if(ex==0x7fff) return x*x; + + /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */ + if(ex < 0x3ffd || (ex == 0x3ffd && mx < 0xb17217f7u)) { + t = expm1l(fabsl(x)); + w = one+t; + if (ex<0x3fbc) return w; /* cosh(tiny) = 1 */ + return one+(t*t)/(w+w); + } + + /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ + if (ex < 0x4003 || (ex == 0x4003 && mx < 0xb0000000u)) { + t = expl(fabsl(x)); + return half*t+half/t; + } + + /* |x| in [22, ln(maxdouble)] return half*exp(|x|) */ + if (ex < 0x400c || (ex == 0x400c && mx < 0xb1700000u)) + return half*expl(fabsl(x)); + + /* |x| in [log(maxdouble), log(2*maxdouble)) */ + if (ex == 0x400c && (mx < 0xb174ddc0u + || (mx == 0xb174ddc0u && lx < 0x31aec0ebu))) + { + w = expl(half*fabsl(x)); + t = half*w; + return t*w; + } + + /* |x| >= log(2*maxdouble), cosh(x) overflow */ + return huge*huge; +} diff --git a/lib/libm/src/ld80/e_expl.c b/lib/libm/src/ld80/e_expl.c new file mode 100644 index 00000000000..119971f2df4 --- /dev/null +++ b/lib/libm/src/ld80/e_expl.c @@ -0,0 +1,131 @@ +/* $OpenBSD: e_expl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* expl.c + * + * Exponential function, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, expl(); + * + * y = expl( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * A Pade' form of degree 2/3 is used to approximate exp(f) - 1 + * in the basic range [-0.5 ln 2, 0.5 ln 2]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-10000 50000 1.12e-19 2.81e-20 + * + * + * Error amplification in the exponential function can be + * a serious matter. The error propagation involves + * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), + * which shows that a 1 lsb error in representing X produces + * a relative error of X times 1 lsb in the function. + * While the routine gives an accurate result for arguments + * that are exactly represented by a long double precision + * computer number, the result contains amplified roundoff + * error for large arguments not exactly represented. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * exp underflow x < MINLOG 0.0 + * exp overflow x > MAXLOG MAXNUM + * + */ + +/* Exponential function */ + +#include <math.h> + +static long double P[3] = { + 1.2617719307481059087798E-4L, + 3.0299440770744196129956E-2L, + 9.9999999999999999991025E-1L, +}; +static long double Q[4] = { + 3.0019850513866445504159E-6L, + 2.5244834034968410419224E-3L, + 2.2726554820815502876593E-1L, + 2.0000000000000000000897E0L, +}; +static long double C1 = 6.9314575195312500000000E-1L; +static long double C2 = 1.4286068203094172321215E-6L; +static long double MAXLOGL = 1.1356523406294143949492E4L; +static long double MINLOGL = -1.13994985314888605586758E4L; +static long double LOG2EL = 1.4426950408889634073599E0L; + +extern long double __polevll(long double, void *, int); + +long double +expl(long double x) +{ +long double px, xx; +int n; + +if( isnan(x) ) + return(x); +if( x > MAXLOGL) + return( INFINITY ); + +if( x < MINLOGL ) + return(0.0L); + +/* Express e**x = e**g 2**n + * = e**g e**( n loge(2) ) + * = e**( g + n loge(2) ) + */ +px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */ +n = px; +x -= px * C1; +x -= px * C2; + + +/* rational approximation for exponential + * of the fractional part: + * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) + */ +xx = x * x; +px = x * __polevll( xx, P, 2 ); +x = px/( __polevll( xx, Q, 3 ) - px ); +x = 1.0L + ldexpl( x, 1 ); + +x = ldexpl( x, n ); +return(x); +} diff --git a/lib/libm/src/ld80/e_fmodl.c b/lib/libm/src/ld80/e_fmodl.c new file mode 100644 index 00000000000..68034cb771e --- /dev/null +++ b/lib/libm/src/ld80/e_fmodl.c @@ -0,0 +1,147 @@ +/* @(#)e_fmod.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 <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/e_fmodl.c,v 1.2 2008/07/31 20:09:47 das Exp $"); +#endif + +#include <sys/types.h> +#include <machine/ieee.h> + +#include <float.h> +#include <math.h> +#include <stdint.h> + +#include "math_private.h" + +#define BIAS (LDBL_MAX_EXP - 1) + +/* + * These macros add and remove an explicit integer bit in front of the + * fractional mantissa, if the architecture doesn't have such a bit by + * default already. + */ +#ifdef LDBL_IMPLICIT_NBIT +#define LDBL_NBIT 0 +#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) +#define HFRAC_BITS EXT_FRACHBITS +#else +#define LDBL_NBIT 0x80000000 +#define SET_NBIT(hx) (hx) +#define HFRAC_BITS (EXT_FRACHBITS - 1) +#endif + +#define MANL_SHIFT (EXT_FRACLBITS - 1) + +static const long double one = 1.0, Zero[] = {0.0, -0.0,}; + +/* + * fmodl(x,y) + * Return x mod y in exact arithmetic + * Method: shift and subtract + * + * Assumptions: + * - The low part of the mantissa fits in a manl_t exactly. + * - The high part of the mantissa fits in an int64_t with enough room + * for an explicit integer bit in front of the fractional bits. + */ +long double +fmodl(long double x, long double y) +{ + union { + long double e; + struct ieee_ext bits; + } ux, uy; + int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ + uint32_t hy; + uint32_t lx,ly,lz; + int ix,iy,n,sx; + + ux.e = x; + uy.e = y; + sx = ux.bits.ext_sign; + + /* purge off exception values */ + if((uy.bits.ext_exp|uy.bits.ext_frach|uy.bits.ext_fracl)==0 || /* y=0 */ + (ux.bits.ext_exp == BIAS + LDBL_MAX_EXP) || /* or x not finite */ + (uy.bits.ext_exp == BIAS + LDBL_MAX_EXP && + ((uy.bits.ext_frach&~LDBL_NBIT)|uy.bits.ext_fracl)!=0)) /* or y is NaN */ + return (x*y)/(x*y); + if(ux.bits.ext_exp<=uy.bits.ext_exp) { + if((ux.bits.ext_exp<uy.bits.ext_exp) || + (ux.bits.ext_frach<=uy.bits.ext_frach && + (ux.bits.ext_frach<uy.bits.ext_frach || + ux.bits.ext_fracl<uy.bits.ext_fracl))) { + return x; /* |x|<|y| return x or x-y */ + } + if(ux.bits.ext_frach==uy.bits.ext_frach && + ux.bits.ext_fracl==uy.bits.ext_fracl) { + return Zero[sx]; /* |x|=|y| return x*0*/ + } + } + + /* determine ix = ilogb(x) */ + if(ux.bits.ext_exp == 0) { /* subnormal x */ + ux.e *= 0x1.0p512; + ix = ux.bits.ext_exp - (BIAS + 512); + } else { + ix = ux.bits.ext_exp - BIAS; + } + + /* determine iy = ilogb(y) */ + if(uy.bits.ext_exp == 0) { /* subnormal y */ + uy.e *= 0x1.0p512; + iy = uy.bits.ext_exp - (BIAS + 512); + } else { + iy = uy.bits.ext_exp - BIAS; + } + + /* set up {hx,lx}, {hy,ly} and align y to x */ + hx = SET_NBIT(ux.bits.ext_frach); + hy = SET_NBIT(uy.bits.ext_frach); + lx = ux.bits.ext_fracl; + ly = uy.bits.ext_fracl; + + /* fix point fmod */ + n = ix - iy; + + while(n--) { + hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz<0){hx = hx+hx+(lx>>MANL_SHIFT); lx = lx+lx;} + else { + if ((hz|lz)==0) /* return sign(x)*0 */ + return Zero[sx]; + hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; + } + } + hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz>=0) {hx=hz;lx=lz;} + + /* convert back to floating value and restore the sign */ + if((hx|lx)==0) /* return sign(x)*0 */ + return Zero[sx]; + while(hx<(1ULL<<HFRAC_BITS)) { /* normalize x */ + hx = hx+hx+(lx>>MANL_SHIFT); lx = lx+lx; + iy -= 1; + } + ux.bits.ext_frach = hx; /* The mantissa is truncated here if needed. */ + ux.bits.ext_fracl = lx; + if (iy < LDBL_MIN_EXP) { + ux.bits.ext_exp = iy + (BIAS + 512); + ux.e *= 0x1p-512; + } else { + ux.bits.ext_exp = iy + BIAS; + } + x = ux.e * one; /* create necessary signal */ + return x; /* exact output */ +} diff --git a/lib/libm/src/ld80/e_hypotl.c b/lib/libm/src/ld80/e_hypotl.c new file mode 100644 index 00000000000..e70d2b1d104 --- /dev/null +++ b/lib/libm/src/ld80/e_hypotl.c @@ -0,0 +1,122 @@ +/* @(#)e_hypot.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* hypotl(x,y) + * + * Method : + * If (assume round-to-nearest) z=x*x+y*y + * has error less than sqrt(2)/2 ulp, than + * sqrt(z) has error less than 1 ulp (exercise). + * + * So, compute sqrt(x*x+y*y) with some care as + * follows to get the error below 1 ulp: + * + * Assume x>y>0; + * (if possible, set rounding to round-to-nearest) + * 1. if x > 2y use + * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y + * where x1 = x with lower 32 bits cleared, x2 = x-x1; else + * 2. if x <= 2y use + * t1*yy1+((x-y)*(x-y)+(t1*y2+t2*y)) + * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, + * yy1= y with lower 32 bits chopped, y2 = y-yy1. + * + * NOTE: scaling may be necessary if some argument is too + * large or too tiny + * + * Special cases: + * hypot(x,y) is INF if x or y is +INF or -INF; else + * hypot(x,y) is NAN if x or y is NAN. + * + * Accuracy: + * hypot(x,y) returns sqrt(x^2+y^2) with error less + * than 1 ulps (units in the last place) + */ + +#include <math.h> + +#include "math_private.h" + +long double +hypotl(long double x, long double y) +{ + long double a,b,t1,t2,yy1,y2,w; + u_int32_t j,k,ea,eb; + + GET_LDOUBLE_EXP(ea,x); + ea &= 0x7fff; + GET_LDOUBLE_EXP(eb,y); + eb &= 0x7fff; + if(eb > ea) {a=y;b=x;j=ea; ea=eb;eb=j;} else {a=x;b=y;} + SET_LDOUBLE_EXP(a,ea); /* a <- |a| */ + SET_LDOUBLE_EXP(b,eb); /* b <- |b| */ + if((ea-eb)>0x46) {return a+b;} /* x/y > 2**70 */ + k=0; + if(ea > 0x5f3f) { /* a>2**8000 */ + if(ea == 0x7fff) { /* Inf or NaN */ + u_int32_t es,high,low; + w = a+b; /* for sNaN */ + GET_LDOUBLE_WORDS(es,high,low,a); + if(((high&0x7fffffff)|low)==0) w = a; + GET_LDOUBLE_WORDS(es,high,low,b); + if(((eb^0x7fff)|(high&0x7fffffff)|low)==0) w = b; + return w; + } + /* scale a and b by 2**-9600 */ + ea -= 0x2580; eb -= 0x2580; k += 9600; + SET_LDOUBLE_EXP(a,ea); + SET_LDOUBLE_EXP(b,eb); + } + if(eb < 0x20bf) { /* b < 2**-8000 */ + if(eb == 0) { /* subnormal b or 0 */ + u_int32_t es,high,low; + GET_LDOUBLE_WORDS(es,high,low,b); + if((high|low)==0) return a; + SET_LDOUBLE_WORDS(t1, 0x7ffd, 0, 0); /* t1=2^16382 */ + b *= t1; + a *= t1; + k -= 16382; + } else { /* scale a and b by 2^9600 */ + ea += 0x2580; /* a *= 2^9600 */ + eb += 0x2580; /* b *= 2^9600 */ + k -= 9600; + SET_LDOUBLE_EXP(a,ea); + SET_LDOUBLE_EXP(b,eb); + } + } + /* medium size a and b */ + w = a-b; + if (w>b) { + u_int32_t high; + GET_LDOUBLE_MSW(high,a); + SET_LDOUBLE_WORDS(t1,ea,high,0); + t2 = a-t1; + w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); + } else { + u_int32_t high; + GET_LDOUBLE_MSW(high,b); + a = a+a; + SET_LDOUBLE_WORDS(yy1,eb,high,0); + y2 = b - yy1; + GET_LDOUBLE_MSW(high,a); + SET_LDOUBLE_WORDS(t1,ea+1,high,0); + t2 = a - t1; + w = sqrtl(t1*yy1-(w*(-w)-(t1*y2+t2*b))); + } + if(k!=0) { + u_int32_t es; + t1 = 1.0; + GET_LDOUBLE_EXP(es,t1); + SET_LDOUBLE_EXP(t1,es+k); + return t1*w; + } else return w; +} diff --git a/lib/libm/src/ld80/e_lgammal.c b/lib/libm/src/ld80/e_lgammal.c new file mode 100644 index 00000000000..04c0aef84c5 --- /dev/null +++ b/lib/libm/src/ld80/e_lgammal.c @@ -0,0 +1,425 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* lgammal(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 + * 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) + * 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) + * 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 + * + * 4. For negative x, since (G is gamma function) + * -x*G(-x)*G(x) = pi/sin(pi*x), + * we have + * G(x) = pi/(sin(pi*x)*(-x)*G(-x)) + * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0 + * Hence, for x<0, signgam = sign(sin(pi*x)) and + * lgamma(x) = log(|Gamma(x)|) + * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x); + * Note: one should avoid compute pi*(-x) directly in the + * computation of sin(pi*(-x)). + * + * 5. Special Cases + * lgamma(2+s) ~ s*(1-Euler) for tiny s + * lgamma(1)=lgamma(2)=0 + * lgamma(x) ~ -log(x) for tiny x + * lgamma(0) = lgamma(inf) = inf + * lgamma(-integer) = +-inf + * + */ + +#include <math.h> + +#include "math_private.h" + +static const long double + half = 0.5L, + one = 1.0L, + pi = 3.14159265358979323846264L, + two63 = 9.223372036854775808e18L, + + /* lgam(1+x) = 0.5 x + x a(x)/b(x) + -0.268402099609375 <= x <= 0 + peak relative error 6.6e-22 */ + a0 = -6.343246574721079391729402781192128239938E2L, + a1 = 1.856560238672465796768677717168371401378E3L, + a2 = 2.404733102163746263689288466865843408429E3L, + a3 = 8.804188795790383497379532868917517596322E2L, + a4 = 1.135361354097447729740103745999661157426E2L, + a5 = 3.766956539107615557608581581190400021285E0L, + + b0 = 8.214973713960928795704317259806842490498E3L, + b1 = 1.026343508841367384879065363925870888012E4L, + b2 = 4.553337477045763320522762343132210919277E3L, + b3 = 8.506975785032585797446253359230031874803E2L, + b4 = 6.042447899703295436820744186992189445813E1L, + /* b5 = 1.000000000000000000000000000000000000000E0 */ + + + tc = 1.4616321449683623412626595423257213284682E0L, + tf = -1.2148629053584961146050602565082954242826E-1,/* double precision */ +/* tt = (tail of tf), i.e. tf + tt has extended precision. */ + tt = 3.3649914684731379602768989080467587736363E-18L, + /* lgam ( 1.4616321449683623412626595423257213284682E0 ) = +-1.2148629053584960809551455717769158215135617312999903886372437313313530E-1 */ + + /* lgam (x + tc) = tf + tt + x g(x)/h(x) + - 0.230003726999612341262659542325721328468 <= x + <= 0.2699962730003876587373404576742786715318 + peak relative error 2.1e-21 */ + g0 = 3.645529916721223331888305293534095553827E-18L, + g1 = 5.126654642791082497002594216163574795690E3L, + g2 = 8.828603575854624811911631336122070070327E3L, + g3 = 5.464186426932117031234820886525701595203E3L, + g4 = 1.455427403530884193180776558102868592293E3L, + g5 = 1.541735456969245924860307497029155838446E2L, + g6 = 4.335498275274822298341872707453445815118E0L, + + h0 = 1.059584930106085509696730443974495979641E4L, + h1 = 2.147921653490043010629481226937850618860E4L, + h2 = 1.643014770044524804175197151958100656728E4L, + h3 = 5.869021995186925517228323497501767586078E3L, + h4 = 9.764244777714344488787381271643502742293E2L, + h5 = 6.442485441570592541741092969581997002349E1L, + /* h6 = 1.000000000000000000000000000000000000000E0 */ + + + /* lgam (x+1) = -0.5 x + x u(x)/v(x) + -0.100006103515625 <= x <= 0.231639862060546875 + peak relative error 1.3e-21 */ + u0 = -8.886217500092090678492242071879342025627E1L, + u1 = 6.840109978129177639438792958320783599310E2L, + u2 = 2.042626104514127267855588786511809932433E3L, + u3 = 1.911723903442667422201651063009856064275E3L, + u4 = 7.447065275665887457628865263491667767695E2L, + u5 = 1.132256494121790736268471016493103952637E2L, + u6 = 4.484398885516614191003094714505960972894E0L, + + v0 = 1.150830924194461522996462401210374632929E3L, + v1 = 3.399692260848747447377972081399737098610E3L, + v2 = 3.786631705644460255229513563657226008015E3L, + v3 = 1.966450123004478374557778781564114347876E3L, + v4 = 4.741359068914069299837355438370682773122E2L, + v5 = 4.508989649747184050907206782117647852364E1L, + /* v6 = 1.000000000000000000000000000000000000000E0 */ + + + /* lgam (x+2) = .5 x + x s(x)/r(x) + 0 <= x <= 1 + peak relative error 7.2e-22 */ + s0 = 1.454726263410661942989109455292824853344E6L, + s1 = -3.901428390086348447890408306153378922752E6L, + s2 = -6.573568698209374121847873064292963089438E6L, + s3 = -3.319055881485044417245964508099095984643E6L, + s4 = -7.094891568758439227560184618114707107977E5L, + s5 = -6.263426646464505837422314539808112478303E4L, + s6 = -1.684926520999477529949915657519454051529E3L, + + r0 = -1.883978160734303518163008696712983134698E7L, + r1 = -2.815206082812062064902202753264922306830E7L, + r2 = -1.600245495251915899081846093343626358398E7L, + r3 = -4.310526301881305003489257052083370058799E6L, + r4 = -5.563807682263923279438235987186184968542E5L, + r5 = -3.027734654434169996032905158145259713083E4L, + r6 = -4.501995652861105629217250715790764371267E2L, + /* r6 = 1.000000000000000000000000000000000000000E0 */ + + +/* lgam(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x w(1/x^2) + x >= 8 + Peak relative error 1.51e-21 + w0 = LS2PI - 0.5 */ + w0 = 4.189385332046727417803e-1L, + w1 = 8.333333333333331447505E-2L, + w2 = -2.777777777750349603440E-3L, + w3 = 7.936507795855070755671E-4L, + w4 = -5.952345851765688514613E-4L, + w5 = 8.412723297322498080632E-4L, + w6 = -1.880801938119376907179E-3L, + w7 = 4.885026142432270781165E-3L; + +static const long double zero = 0.0L; + +static long double +sin_pi(long double x) +{ + long double y, z; + int n, ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + ix = (ix << 16) | (i0 >> 16); + if (ix < 0x3ffd8000) /* 0.25 */ + return sinl (pi * x); + y = -x; /* x is assume negative */ + + /* + * argument reduction, make sure inexact flag not raised if input + * is an integer + */ + z = floorl (y); + if (z != y) + { /* inexact anyway */ + y *= 0.5; + y = 2.0*(y - floorl(y)); /* y = |x| mod 2.0 */ + n = (int) (y*4.0); + } + else + { + if (ix >= 0x403f8000) /* 2^64 */ + { + y = zero; n = 0; /* y must be even */ + } + else + { + if (ix < 0x403e8000) /* 2^63 */ + z = y + two63; /* exact */ + GET_LDOUBLE_WORDS (se, i0, i1, z); + n = i1 & 1; + y = n; + n <<= 2; + } + } + + switch (n) + { + case 0: + y = sinl (pi * y); + break; + case 1: + case 2: + y = cosl (pi * (half - y)); + break; + case 3: + case 4: + y = sinl (pi * (one - y)); + break; + case 5: + case 6: + y = -cosl (pi * (y - 1.5)); + break; + default: + y = sinl (pi * (y - 2.0)); + break; + } + return -y; +} + + +long double +lgammal(long double x) +{ + long double t, y, z, nadj, p, p1, p2, q, r, w; + int i, ix; + u_int32_t se, i0, i1; + + signgam = 1; + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + + if ((ix | i0 | i1) == 0) + { + if (se & 0x8000) + signgam = -1; + return one / fabsl (x); + } + + ix = (ix << 16) | (i0 >> 16); + + /* purge off +-inf, NaN, +-0, and negative arguments */ + if (ix >= 0x7fff0000) + return x * x; + + if (ix < 0x3fc08000) /* 2^-63 */ + { /* |x|<2**-63, return -log(|x|) */ + if (se & 0x8000) + { + signgam = -1; + return -logl (-x); + } + else + return -logl (x); + } + if (se & 0x8000) + { + t = sin_pi (x); + if (t == zero) + return one / fabsl (t); /* -integer */ + nadj = logl (pi / fabsl (t * x)); + if (t < zero) + signgam = -1; + x = -x; + } + + /* purge off 1 and 2 */ + if ((((ix - 0x3fff8000) | i0 | i1) == 0) + || (((ix - 0x40008000) | i0 | i1) == 0)) + r = 0; + else if (ix < 0x40008000) /* 2.0 */ + { + /* x < 2.0 */ + if (ix <= 0x3ffee666) /* 8.99993896484375e-1 */ + { + /* lgamma(x) = lgamma(x+1) - log(x) */ + r = -logl (x); + if (ix >= 0x3ffebb4a) /* 7.31597900390625e-1 */ + { + y = x - one; + i = 0; + } + else if (ix >= 0x3ffced33)/* 2.31639862060546875e-1 */ + { + y = x - (tc - one); + i = 1; + } + else + { + /* x < 0.23 */ + y = x; + i = 2; + } + } + else + { + r = zero; + if (ix >= 0x3fffdda6) /* 1.73162841796875 */ + { + /* [1.7316,2] */ + y = x - 2.0; + i = 0; + } + else if (ix >= 0x3fff9da6)/* 1.23162841796875 */ + { + /* [1.23,1.73] */ + y = x - tc; + i = 1; + } + else + { + /* [0.9, 1.23] */ + y = x - one; + i = 2; + } + } + switch (i) + { + case 0: + p1 = a0 + y * (a1 + y * (a2 + y * (a3 + y * (a4 + y * a5)))); + p2 = b0 + y * (b1 + y * (b2 + y * (b3 + y * (b4 + y)))); + r += half * y + y * p1/p2; + break; + case 1: + p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6))))); + p2 = h0 + y * (h1 + y * (h2 + y * (h3 + y * (h4 + y * (h5 + y))))); + p = tt + y * p1/p2; + r += (tf + p); + break; + case 2: + p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * (u5 + y * u6)))))); + p2 = v0 + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * (v5 + y))))); + r += (-half * y + p1 / p2); + } + } + else if (ix < 0x40028000) /* 8.0 */ + { + /* x < 8.0 */ + i = (int) x; + t = zero; + y = x - (double) i; + p = y * + (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6)))))); + q = r0 + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * (r6 + y)))))); + r = half * y + p / q; + z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ + switch (i) + { + case 7: + z *= (y + 6.0); /* FALLTHRU */ + case 6: + z *= (y + 5.0); /* FALLTHRU */ + case 5: + z *= (y + 4.0); /* FALLTHRU */ + case 4: + z *= (y + 3.0); /* FALLTHRU */ + case 3: + z *= (y + 2.0); /* FALLTHRU */ + r += logl (z); + break; + } + } + else if (ix < 0x40418000) /* 2^66 */ + { + /* 8.0 <= x < 2**66 */ + 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)))))); + r = (x - half) * (t - one) + w; + } + else + /* 2**66 <= x <= inf */ + r = x * (logl (x) - one); + if (se & 0x8000) + r = nadj - r; + return r; +} diff --git a/lib/libm/src/ld80/e_log10l.c b/lib/libm/src/ld80/e_log10l.c new file mode 100644 index 00000000000..906c464c9ba --- /dev/null +++ b/lib/libm/src/ld80/e_log10l.c @@ -0,0 +1,206 @@ +/* $OpenBSD: e_log10l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* log10l.c + * + * Common logarithm, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, log10l(); + * + * y = log10l( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 10 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 9.0e-20 2.6e-20 + * IEEE exp(+-10000) 30000 6.0e-20 2.3e-20 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns MINLOG + * log domain: x < 0; returns MINLOG + */ + +#include <math.h> + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.2e-22 + */ +static long double P[] = { + 4.9962495940332550844739E-1L, + 1.0767376367209449010438E1L, + 7.7671073698359539859595E1L, + 2.5620629828144409632571E2L, + 4.2401812743503691187826E2L, + 3.4258224542413922935104E2L, + 1.0747524399916215149070E2L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 2.3479774160285863271658E1L, + 1.9444210022760132894510E2L, + 7.7952888181207260646090E2L, + 1.6911722418503949084863E3L, + 2.0307734695595183428202E3L, + 1.2695660352705325274404E3L, + 3.2242573199748645407652E2L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ + +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +/* log10(2) */ +#define L102A 0.3125L +#define L102B -1.1470004336018804786261e-2L +/* log10(e) */ +#define L10EA 0.5L +#define L10EB -6.5705518096748172348871e-2L + +#define SQRTH 0.70710678118654752440L + +extern long double __polevll(long double, void *, int); +extern long double __p1evll(long double, void *, int); + +long double +log10l(long double x) +{ +long double y; +volatile long double z; +int e; + +if( isnan(x) ) + return(x); +/* Test for domain */ +if( x <= 0.0L ) + { + if( x == 0.0L ) + return (-1.0L / (x - x)); + else + return (x - x) / (x - x); + } +if( x == INFINITY ) + return(INFINITY); +/* separate mantissa from exponent */ + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ +x = frexpl( x, &e ); + + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ +if( (e > 2) || (e < -2) ) +{ +if( x < SQRTH ) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } +else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } +x = z / y; +z = x*x; +y = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); +goto done; +} + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ + } +else + { + x = x - 1.0L; + } +z = x*x; +y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 7 ) ); +y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */ + +done: + +/* Multiply log of fraction by log10(e) + * and base 2 exponent by log10(2). + * + * ***CAUTION*** + * + * This sequence of operations is critical and it may + * be horribly defeated by some compiler optimizers. + */ +z = y * (L10EB); +z += x * (L10EB); +z += e * (L102B); +z += y * (L10EA); +z += x * (L10EA); +z += e * (L102A); + +return( z ); +} diff --git a/lib/libm/src/ld80/e_log2l.c b/lib/libm/src/ld80/e_log2l.c new file mode 100644 index 00000000000..d25b5dd2459 --- /dev/null +++ b/lib/libm/src/ld80/e_log2l.c @@ -0,0 +1,199 @@ +/* $OpenBSD: e_log2l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* log2l.c + * + * Base 2 logarithm, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, log2l(); + * + * y = log2l( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 2 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the (natural) + * logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 9.8e-20 2.7e-20 + * IEEE exp(+-10000) 70000 5.4e-20 2.3e-20 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns -INFINITY + * log domain: x < 0; returns NAN + */ + +#include <math.h> + +/* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.2e-22 + */ +static long double P[] = { + 4.9962495940332550844739E-1L, + 1.0767376367209449010438E1L, + 7.7671073698359539859595E1L, + 2.5620629828144409632571E2L, + 4.2401812743503691187826E2L, + 3.4258224542413922935104E2L, + 1.0747524399916215149070E2L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 2.3479774160285863271658E1L, + 1.9444210022760132894510E2L, + 7.7952888181207260646090E2L, + 1.6911722418503949084863E3L, + 2.0307734695595183428202E3L, + 1.2695660352705325274404E3L, + 3.2242573199748645407652E2L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +/* log2(e) - 1 */ +#define LOG2EA 4.4269504088896340735992e-1L + +#define SQRTH 0.70710678118654752440L +extern long double __polevll(long double, void *, int); +extern long double __p1evll(long double, void *, int); + +long double +log2l(long double x) +{ +volatile long double z; +long double y; +int e; + +if( isnan(x) ) + return(x); +if( x == INFINITY ) + return(x); +/* Test for domain */ +if( x <= 0.0L ) + { + if( x == 0.0L ) + return( -INFINITY ); + else + return( NAN ); + } + +/* separate mantissa from exponent */ + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ +x = frexpl( x, &e ); + + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ +if( (e > 2) || (e < -2) ) +{ +if( x < SQRTH ) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } +else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } +x = z / y; +z = x*x; +y = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); +goto done; +} + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ + } +else + { + x = x - 1.0L; + } +z = x*x; +y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 7 ) ); +y = y - ldexpl( z, -1 ); /* -0.5x^2 + ... */ + +done: + +/* Multiply log of fraction by log2(e) + * and base 2 exponent by 1 + * + * ***CAUTION*** + * + * This sequence of operations is critical and it may + * be horribly defeated by some compiler optimizers. + */ +z = y * LOG2EA; +z += x * LOG2EA; +z += y; +z += x; +z += e; +return( z ); +} diff --git a/lib/libm/src/ld80/e_logl.c b/lib/libm/src/ld80/e_logl.c new file mode 100644 index 00000000000..d345a59aa5d --- /dev/null +++ b/lib/libm/src/ld80/e_logl.c @@ -0,0 +1,191 @@ +/* $OpenBSD: e_logl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* logl.c + * + * Natural logarithm, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, logl(); + * + * y = logl( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 150000 8.71e-20 2.75e-20 + * IEEE exp(+-10000) 100000 5.39e-20 2.34e-20 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns -INFINITY + * log domain: x < 0; returns NAN + */ + +#include <math.h> + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 2.32e-20 + */ +static long double P[] = { + 4.5270000862445199635215E-5L, + 4.9854102823193375972212E-1L, + 6.5787325942061044846969E0L, + 2.9911919328553073277375E1L, + 6.0949667980987787057556E1L, + 5.7112963590585538103336E1L, + 2.0039553499201281259648E1L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 1.5062909083469192043167E1L, + 8.3047565967967209469434E1L, + 2.2176239823732856465394E2L, + 3.0909872225312059774938E2L, + 2.1642788614495947685003E2L, + 6.0118660497603843919306E1L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ + +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +static long double C1 = 6.9314575195312500000000E-1L; +static long double C2 = 1.4286068203094172321215E-6L; + +#define SQRTH 0.70710678118654752440L + +extern long double __polevll(long double, void *, int); +extern long double __p1evll(long double, void *, int); + +long double +logl(long double x) +{ +long double y, z; +int e; + +if( isnan(x) ) + return(x); +if( x == INFINITY ) + return(x); +/* Test for domain */ +if( x <= 0.0L ) + { + if( x == 0.0L ) + return( -INFINITY ); + else + return( NAN ); + } + +/* separate mantissa from exponent */ + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ +x = frexpl( x, &e ); + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ +if( (e > 2) || (e < -2) ) +{ +if( x < SQRTH ) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } +else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } +x = z / y; +z = x*x; +z = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); +z = z + e * C2; +z = z + x; +z = z + e * C1; +return( z ); +} + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = ldexpl( x, 1 ) - 1.0L; /* 2x - 1 */ + } +else + { + x = x - 1.0L; + } +z = x*x; +y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 6 ) ); +y = y + e * C2; +z = y - ldexpl( z, -1 ); /* y - 0.5 * z */ +/* Note, the sum of above terms does not exceed x/4, + * so it contributes at most about 1/4 lsb to the error. + */ +z = z + x; +z = z + e * C1; /* This sum has an error of 1/2 lsb. */ +return( z ); +} diff --git a/lib/libm/src/ld80/e_powl.c b/lib/libm/src/ld80/e_powl.c new file mode 100644 index 00000000000..2d9f7239cb8 --- /dev/null +++ b/lib/libm/src/ld80/e_powl.c @@ -0,0 +1,615 @@ +/* $OpenBSD: e_powl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* powl.c + * + * Power function, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, z, powl(); + * + * z = powl( x, y ); + * + * + * + * DESCRIPTION: + * + * Computes x raised to the yth power. Analytically, + * + * x**y = exp( y log(x) ). + * + * Following Cody and Waite, this program uses a lookup table + * of 2**-i/32 and pseudo extended precision arithmetic to + * obtain several extra bits of accuracy in both the logarithm + * and the exponential. + * + * + * + * ACCURACY: + * + * The relative error of pow(x,y) can be estimated + * by y dl ln(2), where dl is the absolute error of + * the internally computed base 2 logarithm. At the ends + * of the approximation interval the logarithm equal 1/32 + * and its relative error is about 1 lsb = 1.1e-19. Hence + * the predicted relative error in the result is 2.3e-21 y . + * + * Relative error: + * arithmetic domain # trials peak rms + * + * IEEE +-1000 40000 2.8e-18 3.7e-19 + * .001 < x < 1000, with log(x) uniformly distributed. + * -1000 < y < 1000, y uniformly distributed. + * + * IEEE 0,8700 60000 6.5e-18 1.0e-18 + * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * pow overflow x**y > MAXNUM INFINITY + * pow underflow x**y < 1/MAXNUM 0.0 + * pow domain x<0 and y noninteger 0.0 + * + */ + +#include <float.h> +#include <math.h> + +/* Table size */ +#define NXT 32 +/* log2(Table size) */ +#define LNXT 5 + +/* log(1+x) = x - .5x^2 + x^3 * P(z)/Q(z) + * on the domain 2^(-1/32) - 1 <= x <= 2^(1/32) - 1 + */ +static long double P[] = { + 8.3319510773868690346226E-4L, + 4.9000050881978028599627E-1L, + 1.7500123722550302671919E0L, + 1.4000100839971580279335E0L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0L,*/ + 5.2500282295834889175431E0L, + 8.4000598057587009834666E0L, + 4.2000302519914740834728E0L, +}; +/* A[i] = 2^(-i/32), rounded to IEEE long double precision. + * If i is even, A[i] + B[i/2] gives additional accuracy. + */ +static long double A[33] = { + 1.0000000000000000000000E0L, + 9.7857206208770013448287E-1L, + 9.5760328069857364691013E-1L, + 9.3708381705514995065011E-1L, + 9.1700404320467123175367E-1L, + 8.9735453750155359320742E-1L, + 8.7812608018664974155474E-1L, + 8.5930964906123895780165E-1L, + 8.4089641525371454301892E-1L, + 8.2287773907698242225554E-1L, + 8.0524516597462715409607E-1L, + 7.8799042255394324325455E-1L, + 7.7110541270397041179298E-1L, + 7.5458221379671136985669E-1L, + 7.3841307296974965571198E-1L, + 7.2259040348852331001267E-1L, + 7.0710678118654752438189E-1L, + 6.9195494098191597746178E-1L, + 6.7712777346844636413344E-1L, + 6.6261832157987064729696E-1L, + 6.4841977732550483296079E-1L, + 6.3452547859586661129850E-1L, + 6.2092890603674202431705E-1L, + 6.0762367999023443907803E-1L, + 5.9460355750136053334378E-1L, + 5.8186242938878875689693E-1L, + 5.6939431737834582684856E-1L, + 5.5719337129794626814472E-1L, + 5.4525386633262882960438E-1L, + 5.3357020033841180906486E-1L, + 5.2213689121370692017331E-1L, + 5.1094857432705833910408E-1L, + 5.0000000000000000000000E-1L, +}; +static long double B[17] = { + 0.0000000000000000000000E0L, + 2.6176170809902549338711E-20L, +-1.0126791927256478897086E-20L, + 1.3438228172316276937655E-21L, + 1.2207982955417546912101E-20L, +-6.3084814358060867200133E-21L, + 1.3164426894366316434230E-20L, +-1.8527916071632873716786E-20L, + 1.8950325588932570796551E-20L, + 1.5564775779538780478155E-20L, + 6.0859793637556860974380E-21L, +-2.0208749253662532228949E-20L, + 1.4966292219224761844552E-20L, + 3.3540909728056476875639E-21L, +-8.6987564101742849540743E-22L, +-1.2327176863327626135542E-20L, + 0.0000000000000000000000E0L, +}; + +/* 2^x = 1 + x P(x), + * on the interval -1/32 <= x <= 0 + */ +static long double R[] = { + 1.5089970579127659901157E-5L, + 1.5402715328927013076125E-4L, + 1.3333556028915671091390E-3L, + 9.6181291046036762031786E-3L, + 5.5504108664798463044015E-2L, + 2.4022650695910062854352E-1L, + 6.9314718055994530931447E-1L, +}; + +#define douba(k) A[k] +#define doubb(k) B[k] +#define MEXP (NXT*16384.0L) +/* The following if denormal numbers are supported, else -MEXP: */ +#define MNEXP (-NXT*(16384.0L+64.0L)) +/* log2(e) - 1 */ +#define LOG2EA 0.44269504088896340735992L + +#define F W +#define Fa Wa +#define Fb Wb +#define G W +#define Ga Wa +#define Gb u +#define H W +#define Ha Wb +#define Hb Wb + +static long double MAXLOGL = 1.1356523406294143949492E4L; +static long double MINLOGL = -1.13994985314888605586758E4L; +static long double LOGE2L = 6.9314718055994530941723E-1L; +static volatile long double z; +static long double w, W, Wa, Wb, ya, yb, u; +static const long double huge = 0x1p10000L; +#if 0 /* XXX Prevent gcc from erroneously constant folding this. */ +static const long double twom10000 = 0x1p-10000L; +#else +static volatile long double twom10000 = 0x1p-10000L; +#endif + +extern long double __polevll(long double, void *, int); +extern long double __p1evll(long double, void *, int); +static long double reducl( long double ); +static long double powil ( long double, int ); + +long double +powl(long double x, long double y) +{ +/* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ +int i, nflg, iyflg, yoddint; +long e; + +if( y == 0.0L ) + return( 1.0L ); + +if( isnan(x) ) + return( x ); +if( isnan(y) ) + return( y ); + +if( y == 1.0L ) + return( x ); + +if( !isfinite(y) && (x == -1.0L || x == 1.0L) ) + return y - y; /* +-1**inf is NaN */ + +if( x == 1.0L ) + return( 1.0L ); + +if( y >= LDBL_MAX ) + { + if( x > 1.0L ) + return( INFINITY ); + if( x > 0.0L && x < 1.0L ) + return( 0.0L ); + if( x < -1.0L ) + return( INFINITY ); + if( x > -1.0L && x < 0.0L ) + return( 0.0L ); + } +if( y <= -LDBL_MAX ) + { + if( x > 1.0L ) + return( 0.0L ); + if( x > 0.0L && x < 1.0L ) + return( INFINITY ); + if( x < -1.0L ) + return( 0.0L ); + if( x > -1.0L && x < 0.0L ) + return( INFINITY ); + } +if( x >= LDBL_MAX ) + { + if( y > 0.0L ) + return( INFINITY ); + return( 0.0L ); + } + +w = floorl(y); +/* Set iyflg to 1 if y is an integer. */ +iyflg = 0; +if( w == y ) + iyflg = 1; + +/* Test for odd integer y. */ +yoddint = 0; +if( iyflg ) + { + ya = fabsl(y); + ya = floorl(0.5L * ya); + yb = 0.5L * fabsl(w); + if( ya != yb ) + yoddint = 1; + } + +if( x <= -LDBL_MAX ) + { + if( y > 0.0L ) + { + if( yoddint ) + return( -INFINITY ); + return( INFINITY ); + } + if( y < 0.0L ) + { + if( yoddint ) + return( -0.0L ); + return( 0.0 ); + } + } + + +nflg = 0; /* flag = 1 if x<0 raised to integer power */ +if( x <= 0.0L ) + { + if( x == 0.0L ) + { + if( y < 0.0 ) + { + if( signbit(x) && yoddint ) + return( -INFINITY ); + return( INFINITY ); + } + if( y > 0.0 ) + { + if( signbitl(x) && yoddint ) + return( -0.0L ); + return( 0.0 ); + } + if( y == 0.0L ) + return( 1.0L ); /* 0**0 */ + else + return( 0.0L ); /* 0**y */ + } + else + { + if( iyflg == 0 ) + return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */ + nflg = 1; + } + } + +/* Integer power of an integer. */ + +if( iyflg ) + { + i = w; + w = floorl(x); + if( (w == x) && (fabsl(y) < 32768.0) ) + { + w = powil( x, (int) y ); + return( w ); + } + } + + +if( nflg ) + x = fabsl(x); + +/* separate significand from exponent */ +x = frexpl( x, &i ); +e = i; + +/* find significand in antilog table A[] */ +i = 1; +if( x <= douba(17) ) + i = 17; +if( x <= douba(i+8) ) + i += 8; +if( x <= douba(i+4) ) + i += 4; +if( x <= douba(i+2) ) + i += 2; +if( x >= douba(1) ) + i = -1; +i += 1; + + +/* Find (x - A[i])/A[i] + * in order to compute log(x/A[i]): + * + * log(x) = log( a x/a ) = log(a) + log(x/a) + * + * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a + */ +x -= douba(i); +x -= doubb(i/2); +x /= douba(i); + + +/* rational approximation for log(1+v): + * + * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v) + */ +z = x*x; +w = x * ( z * __polevll( x, P, 3 ) / __p1evll( x, Q, 3 ) ); +w = w - ldexpl( z, -1 ); /* w - 0.5 * z */ + +/* Convert to base 2 logarithm: + * multiply by log2(e) = 1 + LOG2EA + */ +z = LOG2EA * w; +z += w; +z += LOG2EA * x; +z += x; + +/* Compute exponent term of the base 2 logarithm. */ +w = -i; +w = ldexpl( w, -LNXT ); /* divide by NXT */ +w += e; +/* Now base 2 log of x is w + z. */ + +/* Multiply base 2 log by y, in extended precision. */ + +/* separate y into large part ya + * and small part yb less than 1/NXT + */ +ya = reducl(y); +yb = y - ya; + +/* (w+z)(ya+yb) + * = w*ya + w*yb + z*y + */ +F = z * y + w * yb; +Fa = reducl(F); +Fb = F - Fa; + +G = Fa + w * ya; +Ga = reducl(G); +Gb = G - Ga; + +H = Fb + Gb; +Ha = reducl(H); +w = ldexpl( Ga+Ha, LNXT ); + +/* Test the power of 2 for overflow */ +if( w > MEXP ) + return (huge * huge); /* overflow */ + +if( w < MNEXP ) + return (twom10000 * twom10000); /* underflow */ + +e = w; +Hb = H - Ha; + +if( Hb > 0.0L ) + { + e += 1; + Hb -= (1.0L/NXT); /*0.0625L;*/ + } + +/* Now the product y * log2(x) = Hb + e/NXT. + * + * Compute base 2 exponential of Hb, + * where -0.0625 <= Hb <= 0. + */ +z = Hb * __polevll( Hb, R, 6 ); /* z = 2**Hb - 1 */ + +/* Express e/NXT as an integer plus a negative number of (1/NXT)ths. + * Find lookup table entry for the fractional power of 2. + */ +if( e < 0 ) + i = 0; +else + i = 1; +i = e/NXT + i; +e = NXT*i - e; +w = douba( e ); +z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ +z = z + w; +z = ldexpl( z, i ); /* multiply by integer power of 2 */ + +if( nflg ) + { +/* For negative x, + * find out if the integer exponent + * is odd or even. + */ + w = ldexpl( y, -1 ); + w = floorl(w); + w = ldexpl( w, 1 ); + if( w != y ) + z = -z; /* odd exponent */ + } + +return( z ); +} + + +/* Find a multiple of 1/NXT that is within 1/NXT of x. */ +static long double +reducl(long double x) +{ +long double t; + +t = ldexpl( x, LNXT ); +t = floorl( t ); +t = ldexpl( t, -LNXT ); +return(t); +} + +/* powil.c + * + * Real raised to integer power, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, powil(); + * int n; + * + * y = powil( x, n ); + * + * + * + * DESCRIPTION: + * + * Returns argument x raised to the nth power. + * The routine efficiently decomposes n as a sum of powers of + * two. The desired power is a product of two-to-the-kth + * powers of x. Thus to compute the 32767 power of x requires + * 28 multiplications instead of 32767 multiplications. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic x domain n domain # trials peak rms + * IEEE .001,1000 -1022,1023 50000 4.3e-17 7.8e-18 + * IEEE 1,2 -1022,1023 20000 3.9e-17 7.6e-18 + * IEEE .99,1.01 0,8700 10000 3.6e-16 7.2e-17 + * + * Returns MAXNUM on overflow, zero on underflow. + * + */ + +static long double +powil(long double x, int nn) +{ +long double ww, y; +long double s; +int n, e, sign, asign, lx; + +if( x == 0.0L ) + { + if( nn == 0 ) + return( 1.0L ); + else if( nn < 0 ) + return( LDBL_MAX ); + else + return( 0.0L ); + } + +if( nn == 0 ) + return( 1.0L ); + + +if( x < 0.0L ) + { + asign = -1; + x = -x; + } +else + asign = 0; + + +if( nn < 0 ) + { + sign = -1; + n = -nn; + } +else + { + sign = 1; + n = nn; + } + +/* Overflow detection */ + +/* Calculate approximate logarithm of answer */ +s = x; +s = frexpl( s, &lx ); +e = (lx - 1)*n; +if( (e == 0) || (e > 64) || (e < -64) ) + { + s = (s - 7.0710678118654752e-1L) / (s + 7.0710678118654752e-1L); + s = (2.9142135623730950L * s - 0.5L + lx) * nn * LOGE2L; + } +else + { + s = LOGE2L * e; + } + +if( s > MAXLOGL ) + return (huge * huge); /* overflow */ + +if( s < MINLOGL ) + return (twom10000 * twom10000); /* underflow */ +/* Handle tiny denormal answer, but with less accuracy + * since roundoff error in 1.0/x will be amplified. + * The precise demarcation should be the gradual underflow threshold. + */ +if( s < (-MAXLOGL+2.0L) ) + { + x = 1.0L/x; + sign = -sign; + } + +/* First bit of the power */ +if( n & 1 ) + y = x; + +else + { + y = 1.0L; + asign = 0; + } + +ww = x; +n >>= 1; +while( n ) + { + ww = ww * ww; /* arg to the 2-to-the-kth power */ + if( n & 1 ) /* if that bit is set, then include in product */ + y *= ww; + n >>= 1; + } + +if( asign ) + y = -y; /* odd power of negative number */ +if( sign < 0 ) + y = 1.0L/y; +return(y); +} diff --git a/lib/libm/src/ld80/e_sinhl.c b/lib/libm/src/ld80/e_sinhl.c new file mode 100644 index 00000000000..b5b0be79006 --- /dev/null +++ b/lib/libm/src/ld80/e_sinhl.c @@ -0,0 +1,76 @@ +/* @(#)e_sinh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* sinhl(x) + * Method : + * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 + * 1. Replace x by |x| (sinhl(-x) = -sinhl(x)). + * 2. + * E + E/(E+1) + * 0 <= x <= 25 : sinhl(x) := --------------, E=expm1l(x) + * 2 + * + * 25 <= x <= lnovft : sinhl(x) := expl(x)/2 + * lnovft <= x <= ln2ovft: sinhl(x) := expl(x/2)/2 * expl(x/2) + * ln2ovft < x : sinhl(x) := x*shuge (overflow) + * + * Special cases: + * sinhl(x) is |x| if x is +INF, -INF, or NaN. + * only sinhl(0)=0 is exact for finite x. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0, shuge = 1.0e4931L; + +long double +sinhl(long double x) +{ + long double t,w,h; + u_int32_t jx,ix,i0,i1; + + /* Words of |x|. */ + GET_LDOUBLE_WORDS(jx,i0,i1,x); + ix = jx&0x7fff; + + /* x is INF or NaN */ + if(ix==0x7fff) return x+x; + + h = 0.5; + if (jx & 0x8000) h = -h; + /* |x| in [0,25], return sign(x)*0.5*(E+E/(E+1))) */ + if (ix < 0x4003 || (ix == 0x4003 && i0 <= 0xc8000000)) { /* |x|<25 */ + if (ix<0x3fdf) /* |x|<2**-32 */ + if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ + t = expm1l(fabsl(x)); + if(ix<0x3fff) return h*(2.0*t-t*t/(t+one)); + return h*(t+t/(t+one)); + } + + /* |x| in [25, log(maxdouble)] return 0.5*exp(|x|) */ + if (ix < 0x400c || (ix == 0x400c && i0 < 0xb17217f7)) + return h*expl(fabsl(x)); + + /* |x| in [log(maxdouble), overflowthreshold] */ + if (ix<0x400c || (ix == 0x400c && (i0 < 0xb174ddc0 + || (i0 == 0xb174ddc0 + && i1 <= 0x31aec0ea)))) { + w = expl(0.5*fabsl(x)); + t = h*w; + return t*w; + } + + /* |x| > overflowthreshold, sinhl(x) overflow */ + return x*shuge; +} diff --git a/lib/libm/src/ld80/e_tgammal.c b/lib/libm/src/ld80/e_tgammal.c new file mode 100644 index 00000000000..adc38a515e2 --- /dev/null +++ b/lib/libm/src/ld80/e_tgammal.c @@ -0,0 +1,316 @@ +/* $OpenBSD: e_tgammal.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* tgammal.c + * + * Gamma function + * + * + * + * SYNOPSIS: + * + * long double x, y, tgammal(); + * extern int signgam; + * + * y = tgammal( x ); + * + * + * + * DESCRIPTION: + * + * Returns gamma function of the argument. The result is + * correctly signed, and the sign (+1 or -1) is also + * returned in a global (extern) variable named signgam. + * This variable is also filled in by the logarithmic gamma + * function lgamma(). + * + * Arguments |x| <= 13 are reduced by recurrence and the function + * approximated by a rational function of degree 7/8 in the + * interval (2,3). Large arguments are handled by Stirling's + * formula. Large negative arguments are made positive using + * a reflection formula. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -40,+40 10000 3.6e-19 7.9e-20 + * IEEE -1755,+1755 10000 4.8e-18 6.5e-19 + * + * Accuracy for large arguments is dominated by error in powl(). + * + */ + +#include <float.h> +#include <math.h> + +/* +tgamma(x+2) = tgamma(x+2) P(x)/Q(x) +0 <= x <= 1 +Relative error +n=7, d=8 +Peak error = 1.83e-20 +Relative error spread = 8.4e-23 +*/ + +static long double P[8] = { + 4.212760487471622013093E-5L, + 4.542931960608009155600E-4L, + 4.092666828394035500949E-3L, + 2.385363243461108252554E-2L, + 1.113062816019361559013E-1L, + 3.629515436640239168939E-1L, + 8.378004301573126728826E-1L, + 1.000000000000000000009E0L, +}; +static long double Q[9] = { +-1.397148517476170440917E-5L, + 2.346584059160635244282E-4L, +-1.237799246653152231188E-3L, +-7.955933682494738320586E-4L, + 2.773706565840072979165E-2L, +-4.633887671244534213831E-2L, +-2.243510905670329164562E-1L, + 4.150160950588455434583E-1L, + 9.999999999999999999908E-1L, +}; + +/* +static long double P[] = { +-3.01525602666895735709e0L, +-3.25157411956062339893e1L, +-2.92929976820724030353e2L, +-1.70730828800510297666e3L, +-7.96667499622741999770e3L, +-2.59780216007146401957e4L, +-5.99650230220855581642e4L, +-7.15743521530849602425e4L +}; +static long double Q[] = { + 1.00000000000000000000e0L, +-1.67955233807178858919e1L, + 8.85946791747759881659e1L, + 5.69440799097468430177e1L, +-1.98526250512761318471e3L, + 3.31667508019495079814e3L, + 1.60577839621734713377e4L, +-2.97045081369399940529e4L, +-7.15743521530849602412e4L +}; +*/ +#define MAXGAML 1755.455L +/*static long double LOGPI = 1.14472988584940017414L;*/ + +/* Stirling's formula for the gamma function +tgamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x)) +z(x) = x +13 <= x <= 1024 +Relative error +n=8, d=0 +Peak error = 9.44e-21 +Relative error spread = 8.8e-4 +*/ + +static long double STIR[9] = { + 7.147391378143610789273E-4L, +-2.363848809501759061727E-5L, +-5.950237554056330156018E-4L, + 6.989332260623193171870E-5L, + 7.840334842744753003862E-4L, +-2.294719747873185405699E-4L, +-2.681327161876304418288E-3L, + 3.472222222230075327854E-3L, + 8.333333333333331800504E-2L, +}; + +#define MAXSTIR 1024.0L +static long double SQTPI = 2.50662827463100050242E0L; + +/* 1/tgamma(x) = z P(z) + * z(x) = 1/x + * 0 < x < 0.03125 + * Peak relative error 4.2e-23 + */ + +static long double S[9] = { +-1.193945051381510095614E-3L, + 7.220599478036909672331E-3L, +-9.622023360406271645744E-3L, +-4.219773360705915470089E-2L, + 1.665386113720805206758E-1L, +-4.200263503403344054473E-2L, +-6.558780715202540684668E-1L, + 5.772156649015328608253E-1L, + 1.000000000000000000000E0L, +}; + +/* 1/tgamma(-x) = z P(z) + * z(x) = 1/x + * 0 < x < 0.03125 + * Peak relative error 5.16e-23 + * Relative error spread = 2.5e-24 + */ + +static long double SN[9] = { + 1.133374167243894382010E-3L, + 7.220837261893170325704E-3L, + 9.621911155035976733706E-3L, +-4.219773343731191721664E-2L, +-1.665386113944413519335E-1L, +-4.200263503402112910504E-2L, + 6.558780715202536547116E-1L, + 5.772156649015328608727E-1L, +-1.000000000000000000000E0L, +}; + +static long double PIL = 3.1415926535897932384626L; + +extern long double __polevll(long double, void *, int); +static long double stirf ( long double ); + +/* Gamma function computed by Stirling's formula. + */ +static long double stirf(long double x) +{ +long double y, w, v; + +w = 1.0L/x; +/* For large x, use rational coefficients from the analytical expansion. */ +if( x > 1024.0L ) + w = (((((6.97281375836585777429E-5L * w + + 7.84039221720066627474E-4L) * w + - 2.29472093621399176955E-4L) * w + - 2.68132716049382716049E-3L) * w + + 3.47222222222222222222E-3L) * w + + 8.33333333333333333333E-2L) * w + + 1.0L; +else + w = 1.0L + w * __polevll( w, STIR, 8 ); +y = expl(x); +if( x > MAXSTIR ) + { /* Avoid overflow in pow() */ + v = powl( x, 0.5L * x - 0.25L ); + y = v * (v / y); + } +else + { + y = powl( x, x - 0.5L ) / y; + } +y = SQTPI * y * w; +return( y ); +} + +long double +tgammal(long double x) +{ +long double p, q, z; +int i; + +signgam = 1; +if( isnan(x) ) + return(NAN); +if(x == INFINITY) + return(INFINITY); +if(x == -INFINITY) + return(x - x); +q = fabsl(x); + +if( q > 13.0L ) + { + if( q > MAXGAML ) + goto goverf; + if( x < 0.0L ) + { + p = floorl(q); + if( p == q ) + return (x - x) / (x - x); + i = p; + if( (i & 1) == 0 ) + signgam = -1; + z = q - p; + if( z > 0.5L ) + { + p += 1.0L; + z = q - p; + } + z = q * sinl( PIL * z ); + z = fabsl(z) * stirf(q); + if( z <= PIL/LDBL_MAX ) + { +goverf: + return( signgam * INFINITY); + } + z = PIL/z; + } + else + { + z = stirf(x); + } + return( signgam * z ); + } + +z = 1.0L; +while( x >= 3.0L ) + { + x -= 1.0L; + z *= x; + } + +while( x < -0.03125L ) + { + z /= x; + x += 1.0L; + } + +if( x <= 0.03125L ) + goto small; + +while( x < 2.0L ) + { + z /= x; + x += 1.0L; + } + +if( x == 2.0L ) + return(z); + +x -= 2.0L; +p = __polevll( x, P, 7 ); +q = __polevll( x, Q, 8 ); +z = z * p / q; +if( z < 0 ) + signgam = -1; +return z; + +small: +if( x == 0.0L ) + return (x - x) / (x - x); +else + { + if( x < 0.0L ) + { + x = -x; + q = z / (x * __polevll( x, SN, 8 )); + signgam = -1; + } + else + q = z / (x * __polevll( x, S, 8 )); + } +return q; +} diff --git a/lib/libm/src/ld80/s_asinhl.c b/lib/libm/src/ld80/s_asinhl.c new file mode 100644 index 00000000000..1dc804b11ae --- /dev/null +++ b/lib/libm/src/ld80/s_asinhl.c @@ -0,0 +1,54 @@ +/* @(#)s_asinh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* asinhl(x) + * Method : + * Based on + * asinhl(x) = signl(x) * logl [ |x| + sqrtl(x*x+1) ] + * we have + * asinhl(x) := x if 1+x*x=1, + * := signl(x)*(logl(x)+ln2)) for large |x|, else + * := signl(x)*logl(2|x|+1/(|x|+sqrtl(x*x+1))) if|x|>2, else + * := signl(x)*log1pl(|x| + x^2/(1 + sqrtl(1+x^2))) + */ + +#include <math.h> + +#include "math_private.h" + +static const long double +one = 1.000000000000000000000e+00L, /* 0x3FFF, 0x00000000, 0x00000000 */ +ln2 = 6.931471805599453094287e-01L, /* 0x3FFE, 0xB17217F7, 0xD1CF79AC */ +huge= 1.000000000000000000e+4900L; + +long double +asinhl(long double x) +{ + long double t,w; + int32_t hx,ix; + GET_LDOUBLE_EXP(hx,x); + ix = hx&0x7fff; + if(ix==0x7fff) return x+x; /* x is inf or NaN */ + if(ix< 0x3fde) { /* |x|<2**-34 */ + if(huge+x>one) return x; /* return x inexact except 0 */ + } + if(ix>0x4020) { /* |x| > 2**34 */ + w = logl(fabsl(x))+ln2; + } else if (ix>0x4000) { /* 2**34 > |x| > 2.0 */ + t = fabsl(x); + w = logl(2.0*t+one/(sqrtl(x*x+one)+t)); + } else { /* 2.0 > |x| > 2**-28 */ + t = x*x; + w =log1pl(fabsl(x)+t/(one+sqrtl(one+t))); + } + if(hx&0x8000) return -w; else return w; +} diff --git a/lib/libm/src/ld80/s_cbrtl.c b/lib/libm/src/ld80/s_cbrtl.c new file mode 100644 index 00000000000..ae06387a94b --- /dev/null +++ b/lib/libm/src/ld80/s_cbrtl.c @@ -0,0 +1,128 @@ +/*- + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2009-2011, Bruce D. Evans, Steven G. Kargl, David Schultz. + * + * 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. + * ==================================================== + * + * The argument reduction and testing for exceptional cases was + * written by Steven G. Kargl with input from Bruce D. Evans + * and David A. Schultz. + */ + +#include <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_cbrtl.c,v 1.1 2011/03/12 19:37:35 kargl Exp $"); +#endif + +#include <float.h> +#include <ieeefp.h> +#include <math.h> + +#include "math_private.h" + +#define BIAS (LDBL_MAX_EXP - 1) + +static const unsigned + B1 = 709958130; /* B1 = (127-127.0/3-0.03306235651)*2**23 */ + +long double +cbrtl(long double x) +{ + long double v, r, s, t, w; + double dr, dt, dx; + float ft, fx; + uint32_t hx, lx; + uint16_t expsign, es; + int k; + volatile double vd1, vd2; + + GET_LDOUBLE_EXP(expsign,x); + k = expsign & 0x7fff; + + /* + * If x = +-Inf, then cbrt(x) = +-Inf. + * If x = NaN, then cbrt(x) = NaN. + */ + if (k == BIAS + LDBL_MAX_EXP) + return (x + x); + + if (k == 0) { + /* If x = +-0, then cbrt(x) = +-0. */ + GET_LDOUBLE_WORDS(es,hx,lx,x); + if ((hx|lx) == 0) { + return (x); + } + /* Adjust subnormal numbers. */ + x *= 0x1.0p514; + GET_LDOUBLE_EXP(k,x); + k &= 0x7fff; + k -= BIAS + 514; + } else + k -= BIAS; + SET_LDOUBLE_EXP(x,BIAS); + v = 1; + + switch (k % 3) { + case 1: + case -2: + x = 2*x; + k--; + break; + case 2: + case -1: + x = 4*x; + k -= 2; + break; + } + SET_LDOUBLE_EXP(v, (expsign & 0x8000) | (BIAS + k / 3)); + + /* + * The following is the guts of s_cbrtf, with the handling of + * special values removed and extra care for accuracy not taken, + * but with most of the extra accuracy not discarded. + */ + + /* ~5-bit estimate: */ + fx = x; + GET_FLOAT_WORD(hx, fx); + SET_FLOAT_WORD(ft, ((hx & 0x7fffffff) / 3 + B1)); + + /* ~16-bit estimate: */ + dx = x; + dt = ft; + dr = dt * dt * dt; + dt = dt * (dx + dx + dr) / (dx + dr + dr); + + /* ~47-bit estimate: */ + dr = dt * dt * dt; + dt = dt * (dx + dx + dr) / (dx + dr + dr); + + /* + * dt is cbrtl(x) to ~47 bits (after x has been reduced to 1 <= x < 8). + * Round it away from zero to 32 bits (32 so that t*t is exact, and + * away from zero for technical reasons). + */ + vd2 = 0x1.0p32; + vd1 = 0x1.0p-31; + #define vd ((long double)vd2 + vd1) + + t = dt + vd - 0x1.0p32; + + /* + * Final step Newton iteration to 64 or 113 bits with + * error < 0.667 ulps + */ + s=t*t; /* t*t is exact */ + r=x/s; /* error <= 0.5 ulps; |r| < |t| */ + w=t+t; /* t+t is exact */ + r=(r-t)/(w+r); /* r-t is exact; w+r ~= 3*t */ + t=t+t*r; /* error <= 0.5 + 0.5/3 + epsilon */ + + t *= v; + return (t); +} diff --git a/lib/libm/src/ld80/s_ceill.c b/lib/libm/src/ld80/s_ceill.c new file mode 100644 index 00000000000..5ad3d39dcac --- /dev/null +++ b/lib/libm/src/ld80/s_ceill.c @@ -0,0 +1,78 @@ +/* @(#)s_ceil.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * ceill(x) + * Return x rounded toward -inf to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to ceil(x). + */ + +#include <math.h> + +#include "math_private.h" + +static const long double huge = 1.0e4930; + +long double +ceill(long double x) +{ + int32_t i1,j0; + u_int32_t i,j,se,i0,sx; + GET_LDOUBLE_WORDS(se,i0,i1,x); + sx = (se>>15)&1; + j0 = (se&0x7fff)-0x3fff; + if(j0<31) { + if(j0<0) { /* raise inexact if x != 0 */ + if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ + if(sx) {se=0x8000;i0=0;i1=0;} + else if((i0|i1)!=0) { se=0x3fff;i0=0;i1=0;} + } + } else { + i = (0x7fffffff)>>j0; + if(((i0&i)|i1)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(sx==0) { + if (j0>0 && (i0+(0x80000000>>j0))>i0) + i0+=0x80000000>>j0; + else + { + i = 0x7fffffff; + ++se; + } + } + i0 &= (~i); i1=0; + } + } + } else if (j0>62) { + if(j0==0x4000) return x+x; /* inf or NaN */ + else return x; /* x is integral */ + } else { + i = ((u_int32_t)(0xffffffff))>>(j0-31); + if((i1&i)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(sx==0) { + if(j0==31) i0+=1; + else { + j = i1 + (1<<(63-j0)); + if(j<i1) i0+=1; /* got a carry */ + i1 = j; + } + } + i1 &= (~i); + } + } + SET_LDOUBLE_WORDS(x,se,i0,i1); + return x; +} diff --git a/lib/libm/src/ld80/s_erfl.c b/lib/libm/src/ld80/s_erfl.c new file mode 100644 index 00000000000..0bb8931aa32 --- /dev/null +++ b/lib/libm/src/ld80/s_erfl.c @@ -0,0 +1,430 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* double erf(double x) + * double erfc(double x) + * x + * 2 |\ + * erf(x) = --------- | exp(-t*t)dt + * sqrt(pi) \| + * 0 + * + * erfc(x) = 1-erf(x) + * Note that + * erf(-x) = -erf(x) + * erfc(-x) = 2 - erfc(x) + * + * Method: + * 1. For |x| in [0, 0.84375] + * erf(x) = x + x*R(x^2) + * erfc(x) = 1 - erf(x) if x in [-.84375,0.25] + * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375] + * Remark. The formula is derived by noting + * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....) + * and that + * 2/sqrt(pi) = 1.128379167095512573896158903121545171688 + * is close to one. The interval is chosen because the fix + * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is + * near 0.6174), and by some experiment, 0.84375 is chosen to + * guarantee the error is less than one ulp for erf. + * + * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and + * c = 0.84506291151 rounded to single (24 bits) + * erf(x) = sign(x) * (c + P1(s)/Q1(s)) + * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0 + * 1+(c+P1(s)/Q1(s)) if x < 0 + * Remark: here we use the taylor series expansion at x=1. + * erf(1+s) = erf(1) + s*Poly(s) + * = 0.845.. + P1(s)/Q1(s) + * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25] + * + * 3. For x in [1.25,1/0.35(~2.857143)], + * erfc(x) = (1/x)*exp(-x*x-0.5625+R1(z)/S1(z)) + * z=1/x^2 + * erf(x) = 1 - erfc(x) + * + * 4. For x in [1/0.35,107] + * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0 + * = 2.0 - (1/x)*exp(-x*x-0.5625+R2(z)/S2(z)) + * if -6.666<x<0 + * = 2.0 - tiny (if x <= -6.666) + * z=1/x^2 + * erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6.666, else + * erf(x) = sign(x)*(1.0 - tiny) + * Note1: + * To compute exp(-x*x-0.5625+R/S), let s be a single + * precision number and s := x; then + * -x*x = -s*s + (s-x)*(s+x) + * exp(-x*x-0.5626+R/S) = + * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S); + * Note2: + * Here 4 and 5 make use of the asymptotic series + * exp(-x*x) + * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) ) + * x*sqrt(pi) + * + * 5. For inf > x >= 107 + * erf(x) = sign(x) *(1 - tiny) (raise inexact) + * erfc(x) = tiny*tiny (raise underflow) if x > 0 + * = 2 - tiny if x<0 + * + * 7. Special case: + * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, + * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, + * erfc/erf(NaN) is NaN + */ + + +#include <math.h> + +#include "math_private.h" + +static const long double +tiny = 1e-4931L, + half = 0.5L, + one = 1.0L, + two = 2.0L, + /* c = (float)0.84506291151 */ + erx = 0.845062911510467529296875L, +/* + * Coefficients for approximation to erf on [0,0.84375] + */ + /* 2/sqrt(pi) - 1 */ + efx = 1.2837916709551257389615890312154517168810E-1L, + /* 8 * (2/sqrt(pi) - 1) */ + efx8 = 1.0270333367641005911692712249723613735048E0L, + + pp[6] = { + 1.122751350964552113068262337278335028553E6L, + -2.808533301997696164408397079650699163276E6L, + -3.314325479115357458197119660818768924100E5L, + -6.848684465326256109712135497895525446398E4L, + -2.657817695110739185591505062971929859314E3L, + -1.655310302737837556654146291646499062882E2L, + }, + + qq[6] = { + 8.745588372054466262548908189000448124232E6L, + 3.746038264792471129367533128637019611485E6L, + 7.066358783162407559861156173539693900031E5L, + 7.448928604824620999413120955705448117056E4L, + 4.511583986730994111992253980546131408924E3L, + 1.368902937933296323345610240009071254014E2L, + /* 1.000000000000000000000000000000000000000E0 */ + }, + +/* + * Coefficients for approximation to erf in [0.84375,1.25] + */ +/* erf(x+1) = 0.845062911510467529296875 + pa(x)/qa(x) + -0.15625 <= x <= +.25 + Peak relative error 8.5e-22 */ + + pa[8] = { + -1.076952146179812072156734957705102256059E0L, + 1.884814957770385593365179835059971587220E2L, + -5.339153975012804282890066622962070115606E1L, + 4.435910679869176625928504532109635632618E1L, + 1.683219516032328828278557309642929135179E1L, + -2.360236618396952560064259585299045804293E0L, + 1.852230047861891953244413872297940938041E0L, + 9.394994446747752308256773044667843200719E-2L, + }, + + qa[7] = { + 4.559263722294508998149925774781887811255E2L, + 3.289248982200800575749795055149780689738E2L, + 2.846070965875643009598627918383314457912E2L, + 1.398715859064535039433275722017479994465E2L, + 6.060190733759793706299079050985358190726E1L, + 2.078695677795422351040502569964299664233E1L, + 4.641271134150895940966798357442234498546E0L, + /* 1.000000000000000000000000000000000000000E0 */ + }, + +/* + * Coefficients for approximation to erfc in [1.25,1/0.35] + */ +/* erfc(1/x) = x exp (-1/x^2 - 0.5625 + ra(x^2)/sa(x^2)) + 1/2.85711669921875 < 1/x < 1/1.25 + Peak relative error 3.1e-21 */ + + ra[] = { + 1.363566591833846324191000679620738857234E-1L, + 1.018203167219873573808450274314658434507E1L, + 1.862359362334248675526472871224778045594E2L, + 1.411622588180721285284945138667933330348E3L, + 5.088538459741511988784440103218342840478E3L, + 8.928251553922176506858267311750789273656E3L, + 7.264436000148052545243018622742770549982E3L, + 2.387492459664548651671894725748959751119E3L, + 2.220916652813908085449221282808458466556E2L, + }, + + sa[] = { + -1.382234625202480685182526402169222331847E1L, + -3.315638835627950255832519203687435946482E2L, + -2.949124863912936259747237164260785326692E3L, + -1.246622099070875940506391433635999693661E4L, + -2.673079795851665428695842853070996219632E4L, + -2.880269786660559337358397106518918220991E4L, + -1.450600228493968044773354186390390823713E4L, + -2.874539731125893533960680525192064277816E3L, + -1.402241261419067750237395034116942296027E2L, + /* 1.000000000000000000000000000000000000000E0 */ + }, +/* + * Coefficients for approximation to erfc in [1/.35,107] + */ +/* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rb(x^2)/sb(x^2)) + 1/6.6666259765625 < 1/x < 1/2.85711669921875 + Peak relative error 4.2e-22 */ + rb[] = { + -4.869587348270494309550558460786501252369E-5L, + -4.030199390527997378549161722412466959403E-3L, + -9.434425866377037610206443566288917589122E-2L, + -9.319032754357658601200655161585539404155E-1L, + -4.273788174307459947350256581445442062291E0L, + -8.842289940696150508373541814064198259278E0L, + -7.069215249419887403187988144752613025255E0L, + -1.401228723639514787920274427443330704764E0L, + }, + + sb[] = { + 4.936254964107175160157544545879293019085E-3L, + 1.583457624037795744377163924895349412015E-1L, + 1.850647991850328356622940552450636420484E0L, + 9.927611557279019463768050710008450625415E0L, + 2.531667257649436709617165336779212114570E1L, + 2.869752886406743386458304052862814690045E1L, + 1.182059497870819562441683560749192539345E1L, + /* 1.000000000000000000000000000000000000000E0 */ + }, +/* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rc(x^2)/sc(x^2)) + 1/107 <= 1/x <= 1/6.6666259765625 + Peak relative error 1.1e-21 */ + rc[] = { + -8.299617545269701963973537248996670806850E-5L, + -6.243845685115818513578933902532056244108E-3L, + -1.141667210620380223113693474478394397230E-1L, + -7.521343797212024245375240432734425789409E-1L, + -1.765321928311155824664963633786967602934E0L, + -1.029403473103215800456761180695263439188E0L, + }, + + sc[] = { + 8.413244363014929493035952542677768808601E-3L, + 2.065114333816877479753334599639158060979E-1L, + 1.639064941530797583766364412782135680148E0L, + 4.936788463787115555582319302981666347450E0L, + 5.005177727208955487404729933261347679090E0L, + /* 1.000000000000000000000000000000000000000E0 */ + }; + +long double +erfl(long double x) +{ + long double R, S, P, Q, s, y, z, r; + int32_t ix, i; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + + if (ix >= 0x7fff) + { /* erf(nan)=nan */ + i = ((se & 0xffff) >> 15) << 1; + return (long double) (1 - i) + one / x; /* erf(+-inf)=+-1 */ + } + + ix = (ix << 16) | (i0 >> 16); + if (ix < 0x3ffed800) /* |x|<0.84375 */ + { + if (ix < 0x3fde8000) /* |x|<2**-33 */ + { + if (ix < 0x00080000) + return 0.125 * (8.0 * x + efx8 * x); /*avoid underflow */ + return x + efx * x; + } + z = x * x; + r = pp[0] + z * (pp[1] + + z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); + s = qq[0] + z * (qq[1] + + z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); + y = r / s; + return x + x * y; + } + if (ix < 0x3fffa000) /* 1.25 */ + { /* 0.84375 <= |x| < 1.25 */ + s = fabsl (x) - one; + P = pa[0] + s * (pa[1] + s * (pa[2] + + s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7])))))); + Q = qa[0] + s * (qa[1] + s * (qa[2] + + s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s)))))); + if ((se & 0x8000) == 0) + return erx + P / Q; + else + return -erx - P / Q; + } + if (ix >= 0x4001d555) /* 6.6666259765625 */ + { /* inf>|x|>=6.666 */ + if ((se & 0x8000) == 0) + return one - tiny; + else + return tiny - one; + } + x = fabsl (x); + s = one / (x * x); + if (ix < 0x4000b6db) /* 2.85711669921875 */ + { + R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] + + s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8]))))))); + S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] + + s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s)))))))); + } + else + { /* |x| >= 1/0.35 */ + R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] + + s * (rb[5] + s * (rb[6] + s * rb[7])))))); + S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] + + s * (sb[5] + s * (sb[6] + s)))))); + } + z = x; + GET_LDOUBLE_WORDS (i, i0, i1, z); + i1 = 0; + SET_LDOUBLE_WORDS (z, i, i0, i1); + r = + expl (-z * z - 0.5625) * expl ((z - x) * (z + x) + R / S); + if ((se & 0x8000) == 0) + return one - r / x; + else + return r / x - one; +} + +long double +erfcl(long double x) +{ + int32_t hx, ix; + long double R, S, P, Q, s, y, z, r; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + if (ix >= 0x7fff) + { /* erfc(nan)=nan */ + /* erfc(+-inf)=0,2 */ + return (long double) (((se & 0xffff) >> 15) << 1) + one / x; + } + + ix = (ix << 16) | (i0 >> 16); + if (ix < 0x3ffed800) /* |x|<0.84375 */ + { + if (ix < 0x3fbe0000) /* |x|<2**-65 */ + return one - x; + z = x * x; + r = pp[0] + z * (pp[1] + + z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); + s = qq[0] + z * (qq[1] + + z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); + y = r / s; + if (ix < 0x3ffd8000) /* x<1/4 */ + { + return one - (x + x * y); + } + else + { + r = x * y; + r += (x - half); + return half - r; + } + } + if (ix < 0x3fffa000) /* 1.25 */ + { /* 0.84375 <= |x| < 1.25 */ + s = fabsl (x) - one; + P = pa[0] + s * (pa[1] + s * (pa[2] + + s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7])))))); + Q = qa[0] + s * (qa[1] + s * (qa[2] + + s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s)))))); + if ((se & 0x8000) == 0) + { + z = one - erx; + return z - P / Q; + } + else + { + z = erx + P / Q; + return one + z; + } + } + if (ix < 0x4005d600) /* 107 */ + { /* |x|<107 */ + x = fabsl (x); + s = one / (x * x); + if (ix < 0x4000b6db) /* 2.85711669921875 */ + { /* |x| < 1/.35 ~ 2.857143 */ + R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] + + s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8]))))))); + S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] + + s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s)))))))); + } + else if (ix < 0x4001d555) /* 6.6666259765625 */ + { /* 6.666 > |x| >= 1/.35 ~ 2.857143 */ + R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] + + s * (rb[5] + s * (rb[6] + s * rb[7])))))); + S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] + + s * (sb[5] + s * (sb[6] + s)))))); + } + else + { /* |x| >= 6.666 */ + if (se & 0x8000) + return two - tiny; /* x < -6.666 */ + + R = rc[0] + s * (rc[1] + s * (rc[2] + s * (rc[3] + + s * (rc[4] + s * rc[5])))); + S = sc[0] + s * (sc[1] + s * (sc[2] + s * (sc[3] + + s * (sc[4] + s)))); + } + z = x; + GET_LDOUBLE_WORDS (hx, i0, i1, z); + i1 = 0; + i0 &= 0xffffff00; + SET_LDOUBLE_WORDS (z, hx, i0, i1); + r = expl (-z * z - 0.5625) * + expl ((z - x) * (z + x) + R / S); + if ((se & 0x8000) == 0) + return r / x; + else + return two - r / x; + } + else + { + if ((se & 0x8000) == 0) + return tiny * tiny; + else + return two - tiny; + } +} diff --git a/lib/libm/src/ld80/s_expm1l.c b/lib/libm/src/ld80/s_expm1l.c new file mode 100644 index 00000000000..b9397494129 --- /dev/null +++ b/lib/libm/src/ld80/s_expm1l.c @@ -0,0 +1,138 @@ +/* $OpenBSD: s_expm1l.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* expm1l.c + * + * Exponential function, minus 1 + * Long double precision + * + * + * SYNOPSIS: + * + * long double x, y, expm1l(); + * + * y = expm1l( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power, minus 1. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * An expansion x + .5 x^2 + x^3 R(x) approximates exp(f) - 1 + * in the basic range [-0.5 ln 2, 0.5 ln 2]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -45,+MAXLOG 200,000 1.2e-19 2.5e-20 + * + * ERROR MESSAGES: + * + * message condition value returned + * expm1l overflow x > MAXLOG MAXNUM + * + */ + +#include <math.h> + +static long double MAXLOGL = 1.1356523406294143949492E4L; + +/* exp(x) - 1 = x + 0.5 x^2 + x^3 P(x)/Q(x) + -.5 ln 2 < x < .5 ln 2 + Theoretical peak relative error = 3.4e-22 */ + +static long double + P0 = -1.586135578666346600772998894928250240826E4L, + P1 = 2.642771505685952966904660652518429479531E3L, + P2 = -3.423199068835684263987132888286791620673E2L, + P3 = 1.800826371455042224581246202420972737840E1L, + P4 = -5.238523121205561042771939008061958820811E-1L, + + Q0 = -9.516813471998079611319047060563358064497E4L, + Q1 = 3.964866271411091674556850458227710004570E4L, + Q2 = -7.207678383830091850230366618190187434796E3L, + Q3 = 7.206038318724600171970199625081491823079E2L, + Q4 = -4.002027679107076077238836622982900945173E1L, + /* Q5 = 1.000000000000000000000000000000000000000E0 */ + +/* C1 + C2 = ln 2 */ +C1 = 6.93145751953125E-1L, +C2 = 1.428606820309417232121458176568075500134E-6L, +/* ln 2^-65 */ +minarg = -4.5054566736396445112120088E1L; +static const long double huge = 0x1p10000L; + +long double +expm1l(long double x) +{ +long double px, qx, xx; +int k; + +/* Overflow. */ +if (x > MAXLOGL) + return (huge*huge); /* overflow */ + +if (x == 0.0) + return x; + +/* Minimum value. */ +if (x < minarg) + return -1.0L; + +xx = C1 + C2; + +/* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */ +px = floorl (0.5 + x / xx); +k = px; +/* remainder times ln 2 */ +x -= px * C1; +x -= px * C2; + +/* Approximate exp(remainder ln 2). */ +px = (((( P4 * x + + P3) * x + + P2) * x + + P1) * x + + P0) * x; + +qx = (((( x + + Q4) * x + + Q3) * x + + Q2) * x + + Q1) * x + + Q0; + +xx = x * x; +qx = x + (0.5 * xx + xx * px / qx); + +/* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2). + We have qx = exp(remainder ln 2) - 1, so + exp(x) - 1 = 2^k (qx + 1) - 1 = 2^k qx + 2^k - 1. */ +px = ldexpl(1.0L, k); +x = px * qx + (px - 1.0); +return x; +} diff --git a/lib/libm/src/ld80/s_floorl.c b/lib/libm/src/ld80/s_floorl.c new file mode 100644 index 00000000000..d9f6ab08734 --- /dev/null +++ b/lib/libm/src/ld80/s_floorl.c @@ -0,0 +1,79 @@ +/* @(#)s_floor.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * floorl(x) + * Return x rounded toward -inf to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to floor(x). + */ + +#include <math.h> + +#include "math_private.h" + +static const long double huge = 1.0e4930; + +long double +floorl(long double x) +{ + int32_t i1,j0; + u_int32_t i,j,se,i0,sx; + GET_LDOUBLE_WORDS(se,i0,i1,x); + sx = (se>>15)&1; + j0 = (se&0x7fff)-0x3fff; + if(j0<31) { + if(j0<0) { /* raise inexact if x != 0 */ + if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ + if(sx==0) {se=0;i0=i1=0;} + else if(((se&0x7fff)|i0|i1)!=0) + { se=0xbfff;i0=i1=0;} + } + } else { + i = (0x7fffffff)>>j0; + if(((i0&i)|i1)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(sx) { + if (j0>0 && (i0+(0x80000000>>j0))>i0) + i0 += (0x80000000)>>j0; + else + { + i = 0x7fffffff; + ++se; + } + } + i0 &= (~i); i1=0; + } + } + } else if (j0>62) { + if(j0==0x4000) return x+x; /* inf or NaN */ + else return x; /* x is integral */ + } else { + i = ((u_int32_t)(0xffffffff))>>(j0-31); + if((i1&i)==0) return x; /* x is integral */ + if(huge+x>0.0) { /* raise inexact flag */ + if(sx) { + if(j0==31) i0+=1; + else { + j = i1+(1<<(63-j0)); + if(j<i1) i0 +=1 ; /* got a carry */ + i1=j; + } + } + i1 &= (~i); + } + } + SET_LDOUBLE_WORDS(x,se,i0,i1); + return x; +} diff --git a/lib/libm/src/ld80/s_log1pl.c b/lib/libm/src/ld80/s_log1pl.c new file mode 100644 index 00000000000..d60ea31e20b --- /dev/null +++ b/lib/libm/src/ld80/s_log1pl.c @@ -0,0 +1,191 @@ +/* $OpenBSD: s_log1pl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* log1pl.c + * + * Relative error logarithm + * Natural logarithm of 1+x, long double precision + * + * + * + * SYNOPSIS: + * + * long double x, y, log1pl(); + * + * y = log1pl( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of 1+x. + * + * The argument 1+x is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z^3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1.0, 9.0 100000 8.2e-20 2.5e-20 + * + * ERROR MESSAGES: + * + * log singularity: x-1 = 0; returns -INFINITY + * log domain: x-1 < 0; returns NAN + */ + +#include <math.h> + +/* Coefficients for log(1+x) = x - x^2 / 2 + x^3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 2.32e-20 + */ + +static long double P[] = { + 4.5270000862445199635215E-5L, + 4.9854102823193375972212E-1L, + 6.5787325942061044846969E0L, + 2.9911919328553073277375E1L, + 6.0949667980987787057556E1L, + 5.7112963590585538103336E1L, + 2.0039553499201281259648E1L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 1.5062909083469192043167E1L, + 8.3047565967967209469434E1L, + 2.2176239823732856465394E2L, + 3.0909872225312059774938E2L, + 2.1642788614495947685003E2L, + 6.0118660497603843919306E1L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ + +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +static long double C1 = 6.9314575195312500000000E-1L; +static long double C2 = 1.4286068203094172321215E-6L; + +#define SQRTH 0.70710678118654752440L +extern long double __polevll(long double, void *, int); +extern long double __p1evll(long double, void *, int); + +long double +log1pl(long double xm1) +{ +long double x, y, z; +int e; + +if( isnan(xm1) ) + return(xm1); +if( xm1 == INFINITY ) + return(xm1); +if(xm1 == 0.0) + return(xm1); + +x = xm1 + 1.0L; + +/* Test for domain errors. */ +if( x <= 0.0L ) + { + if( x == 0.0L ) + return( -INFINITY ); + else + return( NAN ); + } + +/* Separate mantissa from exponent. + Use frexp so that denormal numbers will be handled properly. */ +x = frexpl( x, &e ); + +/* logarithm using log(x) = z + z^3 P(z)/Q(z), + where z = 2(x-1)/x+1) */ +if( (e > 2) || (e < -2) ) +{ +if( x < SQRTH ) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } +else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } +x = z / y; +z = x*x; +z = x * ( z * __polevll( z, R, 3 ) / __p1evll( z, S, 3 ) ); +z = z + e * C2; +z = z + x; +z = z + e * C1; +return( z ); +} + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + if (e != 0) + x = 2.0 * x - 1.0L; + else + x = xm1; + } +else + { + if (e != 0) + x = x - 1.0L; + else + x = xm1; + } +z = x*x; +y = x * ( z * __polevll( x, P, 6 ) / __p1evll( x, Q, 6 ) ); +y = y + e * C2; +z = y - 0.5 * z; +z = z + x; +z = z + e * C1; +return( z ); +} diff --git a/lib/libm/src/ld80/s_modfl.c b/lib/libm/src/ld80/s_modfl.c new file mode 100644 index 00000000000..ebfca4b7385 --- /dev/null +++ b/lib/libm/src/ld80/s_modfl.c @@ -0,0 +1,69 @@ +/* @(#)s_modf.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * modfl(long double x, long double *iptr) + * return fraction part of x, and return x's integral part in *iptr. + * Method: + * Bit twiddling. + * + * Exception: + * No exception. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one = 1.0; + +long double +modfl(long double x, long double *iptr) +{ + int32_t i0,i1,jj0; + u_int32_t i,se; + GET_LDOUBLE_WORDS(se,i0,i1,x); + jj0 = (se&0x7fff)-0x3fff; /* exponent of x */ + if(jj0<32) { /* integer part in high x */ + if(jj0<0) { /* |x|<1 */ + SET_LDOUBLE_WORDS(*iptr,se&0x8000,0,0); /* *iptr = +-0 */ + return x; + } else { + i = (0x7fffffff)>>jj0; + if(((i0&i)|i1)==0) { /* x is integral */ + *iptr = x; + SET_LDOUBLE_WORDS(x,se&0x8000,0,0); /* return +-0 */ + return x; + } else { + SET_LDOUBLE_WORDS(*iptr,se,i0&(~i),0); + return x - *iptr; + } + } + } else if (jj0>63) { /* no fraction part */ + *iptr = x*one; + /* We must handle NaNs separately. */ + if (jj0 == 0x4000 && ((i0 & 0x7fffffff) | i1)) + return x*one; + SET_LDOUBLE_WORDS(x,se&0x8000,0,0); /* return +-0 */ + return x; + } else { /* fraction part in low x */ + i = ((u_int32_t)(0x7fffffff))>>(jj0-32); + if((i1&i)==0) { /* x is integral */ + *iptr = x; + SET_LDOUBLE_WORDS(x,se&0x8000,0,0); /* return +-0 */ + return x; + } else { + SET_LDOUBLE_WORDS(*iptr,se,i0,i1&(~i)); + return x - *iptr; + } + } +} diff --git a/lib/libm/src/ld80/s_nextafterl.c b/lib/libm/src/ld80/s_nextafterl.c new file mode 100644 index 00000000000..80f0118c178 --- /dev/null +++ b/lib/libm/src/ld80/s_nextafterl.c @@ -0,0 +1,88 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* IEEE functions + * nextafterl(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include <sys/cdefs.h> +#include <math.h> + +#include "math_private.h" + +long double +nextafterl(long double x, long double y) +{ + int32_t hx,hy,ix,iy; + u_int32_t lx,ly,esx,esy; + + GET_LDOUBLE_WORDS(esx,hx,lx,x); + GET_LDOUBLE_WORDS(esy,hy,ly,y); + ix = esx&0x7fff; /* |x| */ + iy = esy&0x7fff; /* |y| */ + + if (((ix==0x7fff)&&((hx|lx)!=0)) || /* x is nan */ + ((iy==0x7fff)&&((hy|ly)!=0))) /* y is nan */ + return x+y; + if(x==y) return y; /* x=y, return y */ + if((ix|hx|lx)==0) { /* x == 0 */ + volatile long double u; + SET_LDOUBLE_WORDS(x,esy&0x8000,0,1);/* return +-minsubnormal */ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(esx<0x8000) { /* x > 0 */ + if(ix>iy||((ix==iy) && (hx>hy||((hx==hy)&&(lx>ly))))) { + /* x > y, x -= ulp */ + if(lx==0) { + if (hx==0) esx -= 1; + hx -= 1; + } + lx -= 1; + } else { /* x < y, x += ulp */ + lx += 1; + if(lx==0) { + hx += 1; + if (hx==0) + esx += 1; + } + } + } else { /* x < 0 */ + if(esy>=0||(ix>iy||((ix==iy)&&(hx>hy||((hx==hy)&&(lx>ly)))))){ + /* x < y, x -= ulp */ + if(lx==0) { + if (hx==0) esx -= 1; + hx -= 1; + } + lx -= 1; + } else { /* x > y, x += ulp */ + lx += 1; + if(lx==0) { + hx += 1; + if (hx==0) esx += 1; + } + } + } + esy = esx&0x7fff; + if(esy==0x7fff) return x+x; /* overflow */ + if(esy==0) { + volatile long double u = x*x; /* underflow */ + } + SET_LDOUBLE_WORDS(x,esx,hx,lx); + return x; +} + +__weak_alias(nexttowardl, nextafterl); diff --git a/lib/libm/src/ld80/s_nexttoward.c b/lib/libm/src/ld80/s_nexttoward.c new file mode 100644 index 00000000000..d85c97ef61a --- /dev/null +++ b/lib/libm/src/ld80/s_nexttoward.c @@ -0,0 +1,82 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* IEEE functions + * nexttoward(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include <math.h> +#include <float.h> + +#include "math_private.h" + +double +nexttoward(double x, long double y) +{ + int32_t hx,ix,iy; + u_int32_t lx,hy,ly,esy; + + EXTRACT_WORDS(hx,lx,x); + GET_LDOUBLE_WORDS(esy,hy,ly,y); + ix = hx&0x7fffffff; /* |x| */ + iy = esy&0x7fff; /* |y| */ + + if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ + ((iy>=0x7fff)&&(hy|ly)!=0)) /* y is nan */ + return x+y; + if((long double) x==y) return y; /* x=y, return y */ + if((ix|lx)==0) { /* x == 0 */ + volatile double u; + INSERT_WORDS(x,(esy&0x8000)<<16,1); /* return +-minsub */ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if (esy>=0x8000||((ix>>20)&0x7ff)>iy-0x3c00 + || (((ix>>20)&0x7ff)==iy-0x3c00 + && (((hx<<11)|(lx>>21))>(hy&0x7fffffff) + || (((hx<<11)|(lx>>21))==(hy&0x7fffffff) + && (lx<<11)>ly)))) { /* x > y, x -= ulp */ + if(lx==0) hx -= 1; + lx -= 1; + } else { /* x < y, x += ulp */ + lx += 1; + if(lx==0) hx += 1; + } + } else { /* x < 0 */ + if (esy<0x8000||((ix>>20)&0x7ff)>iy-0x3c00 + || (((ix>>20)&0x7ff)==iy-0x3c00 + && (((hx<<11)|(lx>>21))>(hy&0x7fffffff) + || (((hx<<11)|(lx>>21))==(hy&0x7fffffff) + && (lx<<11)>ly)))) {/* x < y, x -= ulp */ + if(lx==0) hx -= 1; + lx -= 1; + } else { /* x > y, x += ulp */ + lx += 1; + if(lx==0) hx += 1; + } + } + hy = hx&0x7ff00000; + if(hy>=0x7ff00000) { + x = x+x; /* overflow */ + return x; + } + if(hy<0x00100000) { + volatile double u = x*x; /* underflow */ + } + INSERT_WORDS(x,hx,lx); + return x; +} diff --git a/lib/libm/src/ld80/s_nexttowardf.c b/lib/libm/src/ld80/s_nexttowardf.c new file mode 100644 index 00000000000..3e0a2af8778 --- /dev/null +++ b/lib/libm/src/ld80/s_nexttowardf.c @@ -0,0 +1,67 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include <math.h> +#include <float.h> + +#include "math_private.h" + +float +nexttowardf(float x, long double y) +{ + int32_t hx,ix,iy; + u_int32_t hy,ly,esy; + + GET_FLOAT_WORD(hx,x); + GET_LDOUBLE_WORDS(esy,hy,ly,y); + ix = hx&0x7fffffff; /* |x| */ + iy = esy&0x7fff; /* |y| */ + + if((ix>0x7f800000) || /* x is nan */ + (iy>=0x7fff&&((hy|ly)!=0))) /* y is nan */ + return x+y; + if((long double) x==y) return y; /* x=y, return y */ + if(ix==0) { /* x == 0 */ + volatile float u; + SET_FLOAT_WORD(x,((esy&0x8000)<<16)|1);/* return +-minsub*/ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if(esy>=0x8000||((ix>>23)&0xff)>iy-0x3f80 + || (((ix>>23)&0xff)==iy-0x3f80 + && ((ix&0x7fffff)<<8)>(hy&0x7fffffff))) {/* x > y, x -= ulp */ + hx -= 1; + } else { /* x < y, x += ulp */ + hx += 1; + } + } else { /* x < 0 */ + if(esy<0x8000||((ix>>23)&0xff)>iy-0x3f80 + || (((ix>>23)&0xff)==iy-0x3f80 + && ((ix&0x7fffff)<<8)>(hy&0x7fffffff))) {/* x < y, x -= ulp */ + hx -= 1; + } else { /* x > y, x += ulp */ + hx += 1; + } + } + hy = hx&0x7f800000; + if(hy>=0x7f800000) { + x = x+x; /* overflow */ + return x; + } + if(hy<0x00800000) { + volatile float u = x*x; /* underflow */ + } + SET_FLOAT_WORD(x,hx); + return x; +} diff --git a/lib/libm/src/ld80/s_remquol.c b/lib/libm/src/ld80/s_remquol.c new file mode 100644 index 00000000000..8b2ddd362ae --- /dev/null +++ b/lib/libm/src/ld80/s_remquol.c @@ -0,0 +1,171 @@ +/* @(#)e_fmod.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 <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_remquol.c,v 1.2 2008/07/31 20:09:47 das Exp $"); +#endif + +#include <sys/types.h> +#include <machine/ieee.h> + +#include <float.h> +#include <math.h> +#include <stdint.h> + +#include "math_private.h" + +#define BIAS (LDBL_MAX_EXP - 1) + +/* + * These macros add and remove an explicit integer bit in front of the + * fractional mantissa, if the architecture doesn't have such a bit by + * default already. + */ +#ifdef LDBL_IMPLICIT_NBIT +#define LDBL_NBIT 0 +#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) +#define HFRAC_BITS EXT_FRACHBITS +#else +#define LDBL_NBIT 0x80000000 +#define SET_NBIT(hx) (hx) +#define HFRAC_BITS (EXT_FRACHBITS - 1) +#endif + +#define MANL_SHIFT (EXT_FRACLBITS - 1) + +static const long double Zero[] = {0.0L, -0.0L}; + +/* + * Return the IEEE remainder and set *quo to the last n bits of the + * quotient, rounded to the nearest integer. We choose n=31 because + * we wind up computing all the integer bits of the quotient anyway as + * a side-effect of computing the remainder by the shift and subtract + * method. In practice, this is far more bits than are needed to use + * remquo in reduction algorithms. + * + * Assumptions: + * - The low part of the mantissa fits in a manl_t exactly. + * - The high part of the mantissa fits in an int64_t with enough room + * for an explicit integer bit in front of the fractional bits. + */ +long double +remquol(long double x, long double y, int *quo) +{ + int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ + uint32_t hy; + uint32_t lx,ly,lz; + uint32_t esx, esy; + int ix,iy,n,q,sx,sxy; + + GET_LDOUBLE_WORDS(esx,hx,lx,x); + GET_LDOUBLE_WORDS(esy,hy,ly,y); + sx = esx & 0x8000; + sxy = sx ^ (esy & 0x8000); + esx &= 0x7fff; /* |x| */ + esy &= 0x7fff; /* |y| */ + SET_LDOUBLE_EXP(x,esx); + SET_LDOUBLE_EXP(y,esy); + + /* purge off exception values */ + if((esy|hy|ly)==0 || /* y=0 */ + (esx == BIAS + LDBL_MAX_EXP) || /* or x not finite */ + (esy == BIAS + LDBL_MAX_EXP && + ((hy&~LDBL_NBIT)|ly)!=0)) /* or y is NaN */ + return (x*y)/(x*y); + if(esx<=esy) { + if((esx<esy) || + (hx<=hy && + (hx<hy || + lx<ly))) { + q = 0; + goto fixup; /* |x|<|y| return x or x-y */ + } + if(hx==hy && lx==ly) { + *quo = 1; + return Zero[sx!=0]; /* |x|=|y| return x*0*/ + } + } + + /* determine ix = ilogb(x) */ + if(esx == 0) { /* subnormal x */ + x *= 0x1.0p512; + GET_LDOUBLE_WORDS(esx,hx,lx,x); + ix = esx - (BIAS + 512); + } else { + ix = esx - BIAS; + } + + /* determine iy = ilogb(y) */ + if(esy == 0) { /* subnormal y */ + y *= 0x1.0p512; + GET_LDOUBLE_WORDS(esy,hy,ly,y); + iy = esy - (BIAS + 512); + } else { + iy = esy - BIAS; + } + + /* set up {hx,lx}, {hy,ly} and align y to x */ + hx = SET_NBIT(hx); + lx = SET_NBIT(lx); + + /* fix point fmod */ + n = ix - iy; + q = 0; + + while(n--) { + hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz<0){hx = hx+hx+(lx>>MANL_SHIFT); lx = lx+lx;} + else {hx = hz+hz+(lz>>MANL_SHIFT); lx = lz+lz; q++;} + q <<= 1; + } + hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; + if(hz>=0) {hx=hz;lx=lz;q++;} + + /* convert back to floating value and restore the sign */ + if((hx|lx)==0) { /* return sign(x)*0 */ + *quo = (sxy ? -q : q); + return Zero[sx!=0]; + } + while(hx<(1ULL<<HFRAC_BITS)) { /* normalize x */ + hx = hx+hx+(lx>>MANL_SHIFT); lx = lx+lx; + iy -= 1; + } + if (iy < LDBL_MIN_EXP) { + esx = (iy + BIAS + 512) & 0x7fff; + SET_LDOUBLE_WORDS(x,esx,hx,lx); + x *= 0x1p-512; + GET_LDOUBLE_WORDS(esx,hx,lx,x); + } else { + esx = (iy + BIAS) & 0x7fff; + } + SET_LDOUBLE_WORDS(x,esx,hx,lx); +fixup: + y = fabsl(y); + if (y < LDBL_MIN * 2) { + if (x+x>y || (x+x==y && (q & 1))) { + q++; + x-=y; + } + } else if (x>0.5*y || (x==0.5*y && (q & 1))) { + q++; + x-=y; + } + + GET_LDOUBLE_EXP(esx,x); + esx ^= sx; + SET_LDOUBLE_EXP(x,esx); + + q &= 0x7fffffff; + *quo = (sxy ? -q : q); + return x; +} diff --git a/lib/libm/src/ld80/s_tanhl.c b/lib/libm/src/ld80/s_tanhl.c new file mode 100644 index 00000000000..a0b7bd8e4c3 --- /dev/null +++ b/lib/libm/src/ld80/s_tanhl.c @@ -0,0 +1,79 @@ +/* @(#)s_tanh.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* tanhl(x) + * Return the Hyperbolic Tangent of x + * + * Method : + * x -x + * e - e + * 0. tanhl(x) is defined to be ----------- + * x -x + * e + e + * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x). + * 2. 0 <= x <= 2**-55 : tanhl(x) := x*(one+x) + * -t + * 2**-55 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x) + * t + 2 + * 2 + * 1 <= x <= 23.0 : tanhl(x) := 1- ----- ; t=expm1l(2x) + * t + 2 + * 23.0 < x <= INF : tanhl(x) := 1. + * + * Special cases: + * tanhl(NaN) is NaN; + * only tanhl(0)=0 is exact for finite argument. + */ + +#include <math.h> + +#include "math_private.h" + +static const long double one=1.0, two=2.0, tiny = 1.0e-4900L; + +long double +tanhl(long double x) +{ + long double t,z; + int32_t se; + u_int32_t jj0,jj1,ix; + + /* High word of |x|. */ + GET_LDOUBLE_WORDS(se,jj0,jj1,x); + ix = se&0x7fff; + + /* x is INF or NaN */ + if(ix==0x7fff) { + /* for NaN it's not important which branch: tanhl(NaN) = NaN */ + if (se&0x8000) return one/x-one; /* tanhl(-inf)= -1; */ + else return one/x+one; /* tanhl(+inf)=+1 */ + } + + /* |x| < 23 */ + if (ix < 0x4003 || (ix == 0x4003 && jj0 < 0xb8000000u)) {/* |x|<23 */ + if ((ix|jj0|jj1) == 0) + return x; /* x == +- 0 */ + if (ix<0x3fc8) /* |x|<2**-55 */ + return x*(one+tiny); /* tanh(small) = small */ + if (ix>=0x3fff) { /* |x|>=1 */ + t = expm1l(two*fabsl(x)); + z = one - two/(t+two); + } else { + t = expm1l(-two*fabsl(x)); + z= -t/(t+two); + } + /* |x| > 23, return +-1 */ + } else { + z = one - tiny; /* raised inexact flag */ + } + return (se&0x8000)? -z: z; +} diff --git a/lib/libm/src/ld80/s_truncl.c b/lib/libm/src/ld80/s_truncl.c new file mode 100644 index 00000000000..63cccf260ec --- /dev/null +++ b/lib/libm/src/ld80/s_truncl.c @@ -0,0 +1,77 @@ +/* + * ==================================================== + * 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: @(#)s_floor.c 5.1 93/09/24 + */ + +#include <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_truncl.c,v 1.9 2008/02/14 15:10:34 bde Exp $"); +#endif + +/* + * truncl(x) + * Return x rounded toward 0 to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to truncl(x). + */ + +#include <sys/types.h> +#include <machine/ieee.h> + +#include <float.h> +#include <math.h> +#include <stdint.h> + +#include "math_private.h" + +#ifdef LDBL_IMPLICIT_NBIT +#define MANH_SIZE (EXT_FRACHBITS + 1) +#else +#define MANH_SIZE EXT_FRACHBITS +#endif + +static const long double huge = 1.0e300; +static const float zero[] = { 0.0, -0.0 }; + +long double +truncl(long double x) +{ + int e, es; + uint32_t ix0, ix1; + + GET_LDOUBLE_WORDS(es,ix0,ix1,x); + e = (es&0x7fff) - LDBL_MAX_EXP + 1; + + if (e < MANH_SIZE - 1) { + if (e < 0) { /* raise inexact if x != 0 */ + if (huge + x > 0.0) + return (zero[(es&0x8000)!=0]); + } else { + uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); + if (((ix0 & m) | ix1) == 0) + return (x); /* x is integral */ + if (huge + x > 0.0) { /* raise inexact flag */ + ix0 &= ~m; + ix1 = 0; + } + } + } else if (e < LDBL_MANT_DIG - 1) { + uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); + if ((ix1 & m) == 0) + return (x); /* x is integral */ + if (huge + x > 0.0) /* raise inexact flag */ + ix1 &= ~m; + } + SET_LDOUBLE_WORDS(x,es,ix0,ix1); + return (x); +} diff --git a/lib/libm/src/math_private.h b/lib/libm/src/math_private.h index 456c96e792c..00c88387874 100644 --- a/lib/libm/src/math_private.h +++ b/lib/libm/src/math_private.h @@ -1,4 +1,4 @@ -/* $OpenBSD: math_private.h,v 1.12 2011/07/04 15:00:56 martynas Exp $ */ +/* $OpenBSD: math_private.h,v 1.13 2011/07/06 00:02:42 martynas Exp $ */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -160,21 +160,21 @@ typedef union /* Get three 32 bit ints from a double. */ -#define GET_LDOUBLE_WORDS(exp,ix0,ix1,d) \ +#define GET_LDOUBLE_WORDS(se,ix0,ix1,d) \ do { \ ieee_extended_shape_type ew_u; \ ew_u.value = (d); \ - (exp) = ew_u.parts.exp; \ + (se) = ew_u.parts.exp; \ (ix0) = ew_u.parts.msw; \ (ix1) = ew_u.parts.lsw; \ } while (0) /* Set a double from two 32 bit ints. */ -#define SET_LDOUBLE_WORDS(d,exp,ix0,ix1) \ +#define SET_LDOUBLE_WORDS(d,se,ix0,ix1) \ do { \ ieee_extended_shape_type iw_u; \ - iw_u.parts.exp = (exp); \ + iw_u.parts.exp = (se); \ iw_u.parts.msw = (ix0); \ iw_u.parts.lsw = (ix1); \ (d) = iw_u.value; \ @@ -201,20 +201,20 @@ do { \ /* Get int from the exponent of a long double. */ -#define GET_LDOUBLE_EXP(exp,d) \ +#define GET_LDOUBLE_EXP(se,d) \ do { \ ieee_extended_shape_type ge_u; \ ge_u.value = (d); \ - (exp) = ge_u.parts.exp; \ + (se) = ge_u.parts.exp; \ } while (0) /* Set exponent of a long double from an int. */ -#define SET_LDOUBLE_EXP(d,exp) \ +#define SET_LDOUBLE_EXP(d,se) \ do { \ ieee_extended_shape_type se_u; \ se_u.value = (d); \ - se_u.parts.exp = (exp); \ + se_u.parts.exp = (se); \ (d) = se_u.value; \ } while (0) diff --git a/lib/libm/src/polevll.c b/lib/libm/src/polevll.c new file mode 100644 index 00000000000..31964a91630 --- /dev/null +++ b/lib/libm/src/polevll.c @@ -0,0 +1,102 @@ +/* $OpenBSD: polevll.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +/* polevll.c + * p1evll.c + * + * Evaluate polynomial + * + * + * + * SYNOPSIS: + * + * int N; + * long double x, y, coef[N+1], polevl[]; + * + * y = polevll( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates polynomial of degree N: + * + * 2 N + * y = C + C x + C x +...+ C x + * 0 1 2 N + * + * Coefficients are stored in reverse order: + * + * coef[0] = C , ..., coef[N] = C . + * N 0 + * + * The function p1evll() assumes that coef[N] = 1.0 and is + * omitted from the array. Its calling arguments are + * otherwise the same as polevll(). + * + * + * SPEED: + * + * In the interest of speed, there are no checks for out + * of bounds arithmetic. This routine is used by most of + * the functions in the library. Depending on available + * equipment features, the user may wish to rewrite the + * program in microcode or assembly language. + * + */ + +#include <math.h> + +/* + * Polynomial evaluator: + * P[0] x^n + P[1] x^(n-1) + ... + P[n] + */ +long double +__polevll(long double x, void *PP, int n) +{ + long double y; + long double *P; + + P = (long double *)PP; + y = *P++; + do { + y = y * x + *P++; + } while (--n); + + return (y); +} + +/* + * Polynomial evaluator: + * x^n + P[0] x^(n-1) + P[1] x^(n-2) + ... + P[n] + */ +long double +__p1evll(long double x, void *PP, int n) +{ + long double y; + long double *P; + + P = (long double *)PP; + n -= 1; + y = x + *P++; + do { + y = y * x + *P++; + } while (--n); + + return (y); +} diff --git a/lib/libm/src/s_asinh.c b/lib/libm/src/s_asinh.c index aa4085ae799..2899d4c2cd6 100644 --- a/lib/libm/src/s_asinh.c +++ b/lib/libm/src/s_asinh.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* asinh(x) * Method : * Based on @@ -21,7 +23,10 @@ * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2))) */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -51,3 +56,12 @@ asinh(double x) } if(hx>0) return w; else return -w; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double asinhl(long double); +#else /* lint */ +__weak_alias(asinhl, asinh); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_cbrt.c b/lib/libm/src/s_cbrt.c index a6245b3c46f..2ec4378d096 100644 --- a/lib/libm/src/s_cbrt.c +++ b/lib/libm/src/s_cbrt.c @@ -10,7 +10,12 @@ * ==================================================== */ -#include "math.h" +/* LINTLIBRARY */ + +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" /* cbrt(x) @@ -75,3 +80,12 @@ cbrt(double x) SET_HIGH_WORD(t,high|sign); return(t); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double cbrtl(long double); +#else /* lint */ +__weak_alias(cbrtl, cbrt); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_ceil.c b/lib/libm/src/s_ceil.c index c5daeff163a..3825377c4d7 100644 --- a/lib/libm/src/s_ceil.c +++ b/lib/libm/src/s_ceil.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* * ceil(x) * Return x rounded toward -inf to integral value @@ -19,7 +21,10 @@ * Inexact flag raised if x not equal to ceil(x). */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double huge = 1.0e300; @@ -66,3 +71,12 @@ ceil(double x) INSERT_WORDS(x,i0,i1); return x; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double ceill(long double); +#else /* lint */ +__weak_alias(ceill, ceil); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_erf.c b/lib/libm/src/s_erf.c index 64d99f411c3..619e3ea0e33 100644 --- a/lib/libm/src/s_erf.c +++ b/lib/libm/src/s_erf.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* double erf(double x) * double erfc(double x) * x @@ -104,8 +106,10 @@ * erfc/erf(NaN) is NaN */ +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> -#include "math.h" #include "math_private.h" static const double @@ -295,3 +299,14 @@ erfc(double x) if(hx>0) return tiny*tiny; else return two-tiny; } } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double erfl(long double); +long double erfcl(long double); +#else /* lint */ +__weak_alias(erfl, erf); +__weak_alias(erfcl, erf); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_expm1.c b/lib/libm/src/s_expm1.c index 3f28b70131b..8d391c2dd8f 100644 --- a/lib/libm/src/s_expm1.c +++ b/lib/libm/src/s_expm1.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* expm1(x) * Returns exp(x)-1, the exponential of x minus 1. * @@ -105,7 +107,10 @@ * to produce the hexadecimal values shown. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -214,3 +219,12 @@ expm1(double x) } return y; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double expm1l(long double); +#else /* lint */ +__weak_alias(expm1l, expm1); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_floor.c b/lib/libm/src/s_floor.c index cccd7860971..3717861b914 100644 --- a/lib/libm/src/s_floor.c +++ b/lib/libm/src/s_floor.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* * floor(x) * Return x rounded toward -inf to integral value @@ -19,7 +21,10 @@ * Inexact flag raised if x not equal to floor(x). */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double huge = 1.0e300; @@ -67,3 +72,12 @@ floor(double x) INSERT_WORDS(x,i0,i1); return x; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double floorl(long double); +#else /* lint */ +__weak_alias(floorl, floor); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_fma.c b/lib/libm/src/s_fma.c new file mode 100644 index 00000000000..7f22094e268 --- /dev/null +++ b/lib/libm/src/s_fma.c @@ -0,0 +1,218 @@ +/* $OpenBSD: s_fma.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * 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. + */ + +/* LINTLIBRARY */ + +#include <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_fma.c,v 1.5 2008/04/03 06:14:51 das Exp $"); +#endif + +#include <fenv.h> +#include <float.h> +#include <math.h> + +/* + * Fused multiply-add: Compute x * y + z with a single rounding error. + * + * We use scaling to avoid overflow/underflow, along with the + * canonical precision-doubling technique adapted from: + * + * Dekker, T. A Floating-Point Technique for Extending the + * Available Precision. Numer. Math. 18, 224-242 (1971). + * + * This algorithm is sensitive to the rounding precision. FPUs such + * as the i387 must be set in double-precision mode if variables are + * to be stored in FP registers in order to avoid incorrect results. + * This is the default on FreeBSD, but not on many other systems. + * + * Hardware instructions should be used on architectures that support it, + * since this implementation will likely be several times slower. + */ +#if LDBL_MANT_DIG != 113 +double +fma(double x, double y, double z) +{ + static const double split = 0x1p27 + 1.0; + double xs, ys, zs; + double c, cc, hx, hy, p, q, tx, ty; + double r, rr, s; + int oround; + int ex, ey, ez; + int spread; + + /* + * Handle special cases. The order of operations and the particular + * return values here are crucial in handling special cases involving + * infinities, NaNs, overflows, and signed zeroes correctly. + */ + if (x == 0.0 || y == 0.0) + return (x * y + z); + if (z == 0.0) + return (x * y); + if (!isfinite(x) || !isfinite(y)) + return (x * y + z); + if (!isfinite(z)) + return (z); + + xs = frexp(x, &ex); + ys = frexp(y, &ey); + zs = frexp(z, &ez); + oround = fegetround(); + spread = ex + ey - ez; + + /* + * If x * y and z are many orders of magnitude apart, the scaling + * will overflow, so we handle these cases specially. Rounding + * modes other than FE_TONEAREST are painful. + */ + if (spread > DBL_MANT_DIG * 2) { + fenv_t env; + feraiseexcept(FE_INEXACT); + switch(oround) { + case FE_TONEAREST: + return (x * y); + case FE_TOWARDZERO: + if (x > 0.0 ^ y < 0.0 ^ z < 0.0) + return (x * y); + feholdexcept(&env); + r = x * y; + if (!fetestexcept(FE_INEXACT)) + r = nextafter(r, 0); + feupdateenv(&env); + return (r); + case FE_DOWNWARD: + if (z > 0.0) + return (x * y); + feholdexcept(&env); + r = x * y; + if (!fetestexcept(FE_INEXACT)) + r = nextafter(r, -INFINITY); + feupdateenv(&env); + return (r); + default: /* FE_UPWARD */ + if (z < 0.0) + return (x * y); + feholdexcept(&env); + r = x * y; + if (!fetestexcept(FE_INEXACT)) + r = nextafter(r, INFINITY); + feupdateenv(&env); + return (r); + } + } + if (spread < -DBL_MANT_DIG) { + feraiseexcept(FE_INEXACT); + if (!isnormal(z)) + feraiseexcept(FE_UNDERFLOW); + switch (oround) { + case FE_TONEAREST: + return (z); + case FE_TOWARDZERO: + if (x > 0.0 ^ y < 0.0 ^ z < 0.0) + return (z); + else + return (nextafter(z, 0)); + case FE_DOWNWARD: + if (x > 0.0 ^ y < 0.0) + return (z); + else + return (nextafter(z, -INFINITY)); + default: /* FE_UPWARD */ + if (x > 0.0 ^ y < 0.0) + return (nextafter(z, INFINITY)); + else + return (z); + } + } + + /* + * Use Dekker's algorithm to perform the multiplication and + * subsequent addition in twice the machine precision. + * Arrange so that x * y = c + cc, and x * y + z = r + rr. + */ + fesetround(FE_TONEAREST); + + p = xs * split; + hx = xs - p; + hx += p; + tx = xs - hx; + + p = ys * split; + hy = ys - p; + hy += p; + ty = ys - hy; + + p = hx * hy; + q = hx * ty + tx * hy; + c = p + q; + cc = p - c + q + tx * ty; + + zs = ldexp(zs, -spread); + r = c + zs; + s = r - c; + rr = (c - (r - s)) + (zs - s) + cc; + + spread = ex + ey; + if (spread + ilogb(r) > -1023) { + fesetround(oround); + r = r + rr; + } else { + /* + * The result is subnormal, so we round before scaling to + * avoid double rounding. + */ + p = ldexp(copysign(0x1p-1022, r), -spread); + c = r + p; + s = c - r; + cc = (r - (c - s)) + (p - s) + rr; + fesetround(oround); + r = (c + cc) - p; + } + return (ldexp(r, spread)); +} +#else /* LDBL_MANT_DIG == 113 */ +/* + * 113 bits of precision is more than twice the precision of a double, + * so it is enough to represent the intermediate product exactly. + */ +double +fma(double x, double y, double z) +{ + return ((long double)x * y + z); +} +#endif /* LDBL_MANT_DIG != 113 */ + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double fmal(long double, long double, long double); +#else /* lint */ +__weak_alias(fmal, fma); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_fmaf.c b/lib/libm/src/s_fmaf.c new file mode 100644 index 00000000000..172f270b058 --- /dev/null +++ b/lib/libm/src/s_fmaf.c @@ -0,0 +1,52 @@ +/* $OpenBSD: s_fmaf.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * 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 <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_fmaf.c,v 1.2 2008/03/29 16:38:29 das Exp $"); +#endif + +#include <math.h> + +/* + * Fused multiply-add: Compute x * y + z with a single rounding error. + * + * A double has more than twice as much precision than a float, so + * direct double-precision arithmetic suffices. + * + * XXX We are relying on the compiler to convert from double to float + * using the current rounding mode and with the appropriate + * side-effects. But on at least one platform (gcc 3.4.2/sparc64), + * this appears to be too much to ask for. The precision + * reduction should be done manually. + */ +float +fmaf(float x, float y, float z) +{ + return ((double)x * y + z); +} diff --git a/lib/libm/src/s_fmal.c b/lib/libm/src/s_fmal.c new file mode 100644 index 00000000000..e8bb1c2848c --- /dev/null +++ b/lib/libm/src/s_fmal.c @@ -0,0 +1,191 @@ +/* $OpenBSD: s_fmal.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * 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 <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_fmal.c,v 1.4 2008/04/03 06:14:51 das Exp $"); +#endif + +#include <fenv.h> +#include <float.h> +#include <math.h> + +/* + * Fused multiply-add: Compute x * y + z with a single rounding error. + * + * We use scaling to avoid overflow/underflow, along with the + * canonical precision-doubling technique adapted from: + * + * Dekker, T. A Floating-Point Technique for Extending the + * Available Precision. Numer. Math. 18, 224-242 (1971). + */ +long double +fmal(long double x, long double y, long double z) +{ +#if LDBL_MANT_DIG == 64 + static const long double split = 0x1p32L + 1.0; +#elif LDBL_MANT_DIG == 113 + static const long double split = 0x1p57L + 1.0; +#endif + long double xs, ys, zs; + long double c, cc, hx, hy, p, q, tx, ty; + long double r, rr, s; + int oround; + int ex, ey, ez; + int spread; + + /* + * Handle special cases. The order of operations and the particular + * return values here are crucial in handling special cases involving + * infinities, NaNs, overflows, and signed zeroes correctly. + */ + if (x == 0.0 || y == 0.0) + return (x * y + z); + if (z == 0.0) + return (x * y); + if (!isfinite(x) || !isfinite(y)) + return (x * y + z); + if (!isfinite(z)) + return (z); + + xs = frexpl(x, &ex); + ys = frexpl(y, &ey); + zs = frexpl(z, &ez); + oround = fegetround(); + spread = ex + ey - ez; + + /* + * If x * y and z are many orders of magnitude apart, the scaling + * will overflow, so we handle these cases specially. Rounding + * modes other than FE_TONEAREST are painful. + */ + if (spread > LDBL_MANT_DIG * 2) { + fenv_t env; + feraiseexcept(FE_INEXACT); + switch(oround) { + case FE_TONEAREST: + return (x * y); + case FE_TOWARDZERO: + if (x > 0.0 ^ y < 0.0 ^ z < 0.0) + return (x * y); + feholdexcept(&env); + r = x * y; + if (!fetestexcept(FE_INEXACT)) + r = nextafterl(r, 0); + feupdateenv(&env); + return (r); + case FE_DOWNWARD: + if (z > 0.0) + return (x * y); + feholdexcept(&env); + r = x * y; + if (!fetestexcept(FE_INEXACT)) + r = nextafterl(r, -INFINITY); + feupdateenv(&env); + return (r); + default: /* FE_UPWARD */ + if (z < 0.0) + return (x * y); + feholdexcept(&env); + r = x * y; + if (!fetestexcept(FE_INEXACT)) + r = nextafterl(r, INFINITY); + feupdateenv(&env); + return (r); + } + } + if (spread < -LDBL_MANT_DIG) { + feraiseexcept(FE_INEXACT); + if (!isnormal(z)) + feraiseexcept(FE_UNDERFLOW); + switch (oround) { + case FE_TONEAREST: + return (z); + case FE_TOWARDZERO: + if (x > 0.0 ^ y < 0.0 ^ z < 0.0) + return (z); + else + return (nextafterl(z, 0)); + case FE_DOWNWARD: + if (x > 0.0 ^ y < 0.0) + return (z); + else + return (nextafterl(z, -INFINITY)); + default: /* FE_UPWARD */ + if (x > 0.0 ^ y < 0.0) + return (nextafterl(z, INFINITY)); + else + return (z); + } + } + + /* + * Use Dekker's algorithm to perform the multiplication and + * subsequent addition in twice the machine precision. + * Arrange so that x * y = c + cc, and x * y + z = r + rr. + */ + fesetround(FE_TONEAREST); + + p = xs * split; + hx = xs - p; + hx += p; + tx = xs - hx; + + p = ys * split; + hy = ys - p; + hy += p; + ty = ys - hy; + + p = hx * hy; + q = hx * ty + tx * hy; + c = p + q; + cc = p - c + q + tx * ty; + + zs = ldexpl(zs, -spread); + r = c + zs; + s = r - c; + rr = (c - (r - s)) + (zs - s) + cc; + + spread = ex + ey; + if (spread + ilogbl(r) > -16383) { + fesetround(oround); + r = r + rr; + } else { + /* + * The result is subnormal, so we round before scaling to + * avoid double rounding. + */ + p = ldexpl(copysignl(0x1p-16382L, r), -spread); + c = r + p; + s = c - r; + cc = (r - (c - s)) + (p - s) + rr; + fesetround(oround); + r = (c + cc) - p; + } + return (ldexpl(r, spread)); +} diff --git a/lib/libm/src/s_llrint.c b/lib/libm/src/s_llrint.c index 56c321f3d41..c4a984e6566 100644 --- a/lib/libm/src/s_llrint.c +++ b/lib/libm/src/s_llrint.c @@ -1,4 +1,4 @@ -/* $OpenBSD: s_llrint.c,v 1.1 2006/09/25 20:25:41 kettenis Exp $ */ +/* $OpenBSD: s_llrint.c,v 1.2 2011/07/06 00:02:42 martynas Exp $ */ /* $NetBSD: llrint.c,v 1.2 2004/10/13 15:18:32 drochner Exp $ */ /* @@ -6,9 +6,20 @@ * Public domain. */ +/* LINTLIBRARY */ + #define LRINTNAME llrint #define RESTYPE long long int #define RESTYPE_MIN LLONG_MIN #define RESTYPE_MAX LLONG_MAX #include "s_lrint.c" + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long long int llrintl(long double); +#else /* lint */ +__weak_alias(llrintl, llrint); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_llrintl.c b/lib/libm/src/s_llrintl.c new file mode 100644 index 00000000000..2d29727592f --- /dev/null +++ b/lib/libm/src/s_llrintl.c @@ -0,0 +1,12 @@ +/* $OpenBSD: s_llrintl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Written by Martynas Venckus. Public domain + */ + +#define type long double +#define roundit rintl +#define dtype long long +#define fn llrintl + +#include "s_lrintl.c" diff --git a/lib/libm/src/s_llround.c b/lib/libm/src/s_llround.c index e9ba5c05363..de130396f2d 100644 --- a/lib/libm/src/s_llround.c +++ b/lib/libm/src/s_llround.c @@ -1,4 +1,4 @@ -/* $OpenBSD: s_llround.c,v 1.1 2008/07/21 20:29:14 martynas Exp $ */ +/* $OpenBSD: s_llround.c,v 1.2 2011/07/06 00:02:42 martynas Exp $ */ /* $NetBSD: llround.c,v 1.2 2004/10/13 15:18:32 drochner Exp $ */ /* @@ -6,9 +6,20 @@ * Public domain. */ +/* LINTLIBRARY */ + #define LROUNDNAME llround #define RESTYPE long long int #define RESTYPE_MIN LLONG_MIN #define RESTYPE_MAX LLONG_MAX #include "s_lround.c" + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long long int llroundl(long double); +#else /* lint */ +__weak_alias(llroundl, llround); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_llroundl.c b/lib/libm/src/s_llroundl.c new file mode 100644 index 00000000000..926bc0bbbe1 --- /dev/null +++ b/lib/libm/src/s_llroundl.c @@ -0,0 +1,14 @@ +/* $OpenBSD: s_llroundl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/* + * Written by Martynas Venckus. Public domain + */ + +#define type long double +#define roundit roundl +#define dtype long long +#define DTYPE_MIN LLONG_MIN +#define DTYPE_MAX LLONG_MAX +#define fn llroundl + +#include "s_lroundl.c" diff --git a/lib/libm/src/s_log1p.c b/lib/libm/src/s_log1p.c index 076f3d91061..2fbe0a9bed5 100644 --- a/lib/libm/src/s_log1p.c +++ b/lib/libm/src/s_log1p.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* double log1p(double x) * * Method : @@ -75,7 +77,10 @@ * See HP-15C Advanced Functions Handbook, p.193. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double @@ -155,3 +160,12 @@ log1p(double x) if(k==0) return f-(hfsq-s*(hfsq+R)); else return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double log1pl(long double); +#else /* lint */ +__weak_alias(log1pl, log1p); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_lrint.c b/lib/libm/src/s_lrint.c index 8e0e554348a..7a1c73f2933 100644 --- a/lib/libm/src/s_lrint.c +++ b/lib/libm/src/s_lrint.c @@ -1,4 +1,4 @@ -/* $OpenBSD: s_lrint.c,v 1.6 2011/04/20 21:32:59 martynas Exp $ */ +/* $OpenBSD: s_lrint.c,v 1.7 2011/07/06 00:02:42 martynas Exp $ */ /* $NetBSD: lrint.c,v 1.3 2004/10/13 15:18:32 drochner Exp $ */ /*- @@ -27,11 +27,15 @@ * SUCH DAMAGE. */ +/* LINTLIBRARY */ + #include <sys/types.h> #include <sys/limits.h> +#include <float.h> #include <math.h> #include <ieeefp.h> #include <machine/ieee.h> + #include "math_private.h" #ifndef LRINTNAME @@ -95,3 +99,12 @@ LRINTNAME(double x) return (s ? -res : res); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long int lrintl(long double); +#else /* lint */ +__weak_alias(lrintl, lrint); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_lrintl.c b/lib/libm/src/s_lrintl.c new file mode 100644 index 00000000000..66f699c8116 --- /dev/null +++ b/lib/libm/src/s_lrintl.c @@ -0,0 +1,62 @@ +/* $OpenBSD: s_lrintl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * 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 <sys/cdefs.h> +#include <fenv.h> +#include <math.h> + +#ifndef type +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_lrint.c,v 1.1 2005/01/11 23:12:55 das Exp $"); +#endif +#define type long double +#define roundit rintl +#define dtype long +#define fn lrintl +#endif + +/* + * C99 says we should not raise a spurious inexact exception when an + * invalid exception is raised. Unfortunately, the set of inputs + * that overflows depends on the rounding mode when 'dtype' has more + * significant bits than 'type'. Hence, we bend over backwards for the + * sake of correctness; an MD implementation could be more efficient. + */ +dtype +fn(type x) +{ + fenv_t env; + dtype d; + + feholdexcept(&env); + d = (dtype)roundit(x); + if (fetestexcept(FE_INVALID)) + feclearexcept(FE_INEXACT); + feupdateenv(&env); + return (d); +} diff --git a/lib/libm/src/s_lround.c b/lib/libm/src/s_lround.c index 647e35396d7..91e2c79e8a2 100644 --- a/lib/libm/src/s_lround.c +++ b/lib/libm/src/s_lround.c @@ -1,4 +1,4 @@ -/* $OpenBSD: s_lround.c,v 1.3 2011/04/17 13:59:54 martynas Exp $ */ +/* $OpenBSD: s_lround.c,v 1.4 2011/07/06 00:02:42 martynas Exp $ */ /* $NetBSD: lround.c,v 1.2 2004/10/13 15:18:32 drochner Exp $ */ /*- @@ -27,8 +27,11 @@ * SUCH DAMAGE. */ +/* LINTLIBRARY */ + #include <sys/types.h> #include <sys/limits.h> +#include <float.h> #include <math.h> #include <ieeefp.h> #include <machine/ieee.h> @@ -86,3 +89,12 @@ LROUNDNAME(double x) return (s ? -res : res); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long int lroundl(long double); +#else /* lint */ +__weak_alias(lroundl, lround); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_lroundl.c b/lib/libm/src/s_lroundl.c new file mode 100644 index 00000000000..ca24910866b --- /dev/null +++ b/lib/libm/src/s_lroundl.c @@ -0,0 +1,70 @@ +/* $OpenBSD: s_lroundl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * 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 <sys/cdefs.h> +#include <sys/limits.h> +#include <fenv.h> +#include <math.h> + +#ifndef type +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_lround.c,v 1.2 2005/04/08 00:52:16 das Exp $"); +#endif +#define type long double +#define roundit roundl +#define dtype long +#define DTYPE_MIN LONG_MIN +#define DTYPE_MAX LONG_MAX +#define fn lroundl +#endif + +/* + * If type has more precision than dtype, the endpoints dtype_(min|max) are + * of the form xxx.5; they are "out of range" because lround() rounds away + * from 0. On the other hand, if type has less precision than dtype, then + * all values that are out of range are integral, so we might as well assume + * that everything is in range. At compile time, INRANGE(x) should reduce to + * two floating-point comparisons in the former case, or TRUE otherwise. + */ +static const type dtype_min = DTYPE_MIN - 0.5; +static const type dtype_max = DTYPE_MAX + 0.5; +#define INRANGE(x) (dtype_max - DTYPE_MAX != 0.5 || \ + ((x) > dtype_min && (x) < dtype_max)) + +dtype +fn(type x) +{ + + if (INRANGE(x)) { + x = roundit(x); + return ((dtype)x); + } else { + feraiseexcept(FE_INVALID); + return (DTYPE_MAX); + } +} diff --git a/lib/libm/src/s_modf.c b/lib/libm/src/s_modf.c index 9511e77169c..c97408aa99f 100644 --- a/lib/libm/src/s_modf.c +++ b/lib/libm/src/s_modf.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* * modf(double x, double *iptr) * return fraction part of x, and return x's integral part in *iptr. @@ -20,7 +22,10 @@ * No exception. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double one = 1.0; @@ -69,3 +74,12 @@ modf(double x, double *iptr) } } } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double modfl(long double, long double *); +#else /* lint */ +__weak_alias(modfl, modf); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_nextafter.c b/lib/libm/src/s_nextafter.c index 9b148b47b33..ead67afd86c 100644 --- a/lib/libm/src/s_nextafter.c +++ b/lib/libm/src/s_nextafter.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* IEEE functions * nextafter(x,y) * return the next machine floating-point number of x in the @@ -17,7 +19,10 @@ * Special cases: */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" double @@ -31,15 +36,15 @@ nextafter(double x, double y) ix = hx&0x7fffffff; /* |x| */ iy = hy&0x7fffffff; /* |y| */ - if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ - ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */ + if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ + ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */ return x+y; if(x==y) return y; /* x=y, return y */ if((ix|lx)==0) { /* x == 0 */ INSERT_WORDS(x,hy&0x80000000,1); /* return +-minsubnormal */ y = x*x; if(y==x) return y; else return x; /* raise underflow flag */ - } + } if(hx>=0) { /* x > 0 */ if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */ if(lx==0) hx -= 1; @@ -69,3 +74,16 @@ nextafter(double x, double y) INSERT_WORDS(x,hx,lx); return x; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double nextafterl(long double, long double); +double nexttoward(double, long double); +long double nexttowardl(long double, long double); +#else /* lint */ +__weak_alias(nextafterl, nextafter); +__weak_alias(nexttoward, nextafter); +__weak_alias(nexttowardl, nextafter); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_nexttowardf.c b/lib/libm/src/s_nexttowardf.c new file mode 100644 index 00000000000..ee22018343d --- /dev/null +++ b/lib/libm/src/s_nexttowardf.c @@ -0,0 +1,74 @@ +/* @(#)s_nextafter.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* IEEE functions + * nexttowardf(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * This is for machines which use the same binary type for double and + * long double. + * Special cases: + */ + +#include <math.h> +#include <float.h> + +#include "math_private.h" + +float +nexttowardf(float x, long double y) +{ + int32_t hx,hy,ix,iy; + u_int32_t ly; + + GET_FLOAT_WORD(hx,x); + EXTRACT_WORDS(hy,ly,y); + ix = hx&0x7fffffff; /* |x| */ + iy = hy&0x7fffffff; /* |y| */ + + if((ix>0x7f800000) || /* x is nan */ + ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */ + return x+y; + if((long double) x==y) return y; /* x=y, return y */ + if(ix==0) { /* x == 0 */ + volatile float u; + SET_FLOAT_WORD(x,(u_int32_t)(hy&0x80000000)|1);/* return +-minsub*/ + u = x; + u = u * u; /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if(hy<0||(ix>>23)>(iy>>20)-0x380 + || ((ix>>23)==(iy>>20)-0x380 + && (ix&0x7fffff)>(((hy<<3)|(ly>>29))&0x7fffff))) /* x > y, x -= ulp */ + hx -= 1; + else /* x < y, x += ulp */ + hx += 1; + } else { /* x < 0 */ + if(hy>=0||(ix>>23)>(iy>>20)-0x380 + || ((ix>>23)==(iy>>20)-0x380 + && (ix&0x7fffff)>(((hy<<3)|(ly>>29))&0x7fffff))) /* x < y, x -= ulp */ + hx -= 1; + else /* x > y, x += ulp */ + hx += 1; + } + hy = hx&0x7f800000; + if(hy>=0x7f800000) { + x = x+x; /* overflow */ + return x; + } + if(hy<0x00800000) { + volatile float u = x*x; /* underflow */ + } + SET_FLOAT_WORD(x,hx); + return x; +} diff --git a/lib/libm/src/s_remquo.c b/lib/libm/src/s_remquo.c index b033071180b..1c00f104b3e 100644 --- a/lib/libm/src/s_remquo.c +++ b/lib/libm/src/s_remquo.c @@ -10,9 +10,12 @@ * ==================================================== */ +/* LINTLIBRARY */ + +#include <sys/cdefs.h> #include <float.h> +#include <math.h> -#include "math.h" #include "math_private.h" static const double Zero[] = {0.0, -0.0,}; @@ -149,3 +152,12 @@ fixup: *quo = (sxy ? -q : q); return x; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double remquol(long double, long double, int *); +#else /* lint */ +__weak_alias(remquol, remquo); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_round.c b/lib/libm/src/s_round.c index cb2db491cbd..356447a72fc 100644 --- a/lib/libm/src/s_round.c +++ b/lib/libm/src/s_round.c @@ -1,4 +1,4 @@ -/* $OpenBSD: s_round.c,v 1.1 2006/07/12 07:26:08 brad Exp $ */ +/* $OpenBSD: s_round.c,v 1.2 2011/07/06 00:02:42 martynas Exp $ */ /*- * Copyright (c) 2003, Steven G. Kargl @@ -26,7 +26,12 @@ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -#include "math.h" +/* LINTLIBRARY */ + +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" double @@ -49,3 +54,12 @@ round(double x) return (-t); } } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double roundl(long double); +#else /* lint */ +__weak_alias(roundl, round); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_roundl.c b/lib/libm/src/s_roundl.c new file mode 100644 index 00000000000..05cdaed3304 --- /dev/null +++ b/lib/libm/src/s_roundl.c @@ -0,0 +1,55 @@ +/* $OpenBSD: s_roundl.c,v 1.1 2011/07/06 00:02:42 martynas Exp $ */ + +/*- + * Copyright (c) 2003, 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. + */ + +#include <sys/cdefs.h> +#if 0 +__FBSDID("$FreeBSD: src/lib/msun/src/s_roundl.c,v 1.2 2005/12/02 13:45:06 bde Exp $"); +#endif + +#include <math.h> + +long double +roundl(long double x) +{ + long double t; + + if (!isfinite(x)) + return (x); + + if (x >= 0.0) { + t = floorl(x); + if (t - x <= -0.5) + t += 1.0; + return (t); + } else { + t = floorl(-x); + if (t + x <= -0.5) + t += 1.0; + return (-t); + } +} diff --git a/lib/libm/src/s_tanh.c b/lib/libm/src/s_tanh.c index c5730590dfc..7daaf83844b 100644 --- a/lib/libm/src/s_tanh.c +++ b/lib/libm/src/s_tanh.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* Tanh(x) * Return the Hyperbolic Tangent of x * @@ -34,7 +36,10 @@ * only tanh(0)=0 is exact for finite argument. */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double one=1.0, two=2.0, tiny = 1.0e-300; @@ -74,3 +79,12 @@ tanh(double x) } return (jx>=0)? z: -z; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double tanhl(long double); +#else /* lint */ +__weak_alias(tanhl, tanh); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/s_trunc.c b/lib/libm/src/s_trunc.c index 3fdf02a2bc0..8c2b165ddb6 100644 --- a/lib/libm/src/s_trunc.c +++ b/lib/libm/src/s_trunc.c @@ -10,6 +10,8 @@ * ==================================================== */ +/* LINTLIBRARY */ + #if 0 #include <sys/cdefs.h> __FBSDID("$FreeBSD: src/lib/msun/src/s_trunc.c,v 1.1 2004/06/20 09:25:43 das Exp $"); @@ -24,7 +26,10 @@ __FBSDID("$FreeBSD: src/lib/msun/src/s_trunc.c,v 1.1 2004/06/20 09:25:43 das Exp * Inexact flag raised if x not equal to trunc(x). */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" static const double huge = 1.0e300; @@ -61,3 +66,12 @@ trunc(double x) INSERT_WORDS(x,i0,i1); return x; } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double truncl(long double); +#else /* lint */ +__weak_alias(truncl, trunc); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ diff --git a/lib/libm/src/w_lgamma.c b/lib/libm/src/w_lgamma.c index 8e5b9b7cb8c..bf69e9a734f 100644 --- a/lib/libm/src/w_lgamma.c +++ b/lib/libm/src/w_lgamma.c @@ -10,13 +10,18 @@ * ==================================================== */ +/* LINTLIBRARY */ + /* double lgamma(double x) * Return the logarithm of the Gamma function of x. * * Method: call lgamma_r */ -#include "math.h" +#include <sys/cdefs.h> +#include <float.h> +#include <math.h> + #include "math_private.h" extern int signgam; @@ -26,3 +31,12 @@ lgamma(double x) { return lgamma_r(x,&signgam); } + +#if LDBL_MANT_DIG == 53 +#ifdef lint +/* PROTOLIB1 */ +long double lgammal(long double); +#else /* lint */ +__weak_alias(lgammal, lgamma); +#endif /* lint */ +#endif /* LDBL_MANT_DIG == 53 */ |