diff options
Diffstat (limited to 'REORG.TODO/sysdeps/ieee754/ldbl-96')
74 files changed, 8383 insertions, 0 deletions
diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/Makefile b/REORG.TODO/sysdeps/ieee754/ldbl-96/Makefile new file mode 100644 index 0000000000..279342acdf --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/Makefile @@ -0,0 +1,21 @@ +# Makefile for sysdeps/ieee754/ldbl-96. +# Copyright (C) 2016-2017 Free Software Foundation, Inc. +# This file is part of the GNU C Library. + +# The GNU C Library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; either +# version 2.1 of the License, or (at your option) any later version. + +# The GNU C Library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. + +# You should have received a copy of the GNU Lesser General Public +# License along with the GNU C Library; if not, see +# <http://www.gnu.org/licenses/>. + +ifeq ($(subdir),math) +tests += test-canonical-ldbl-96 test-totalorderl-ldbl-96 +endif diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/bits/iscanonical.h b/REORG.TODO/sysdeps/ieee754/ldbl-96/bits/iscanonical.h new file mode 100644 index 0000000000..2c8b786183 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/bits/iscanonical.h @@ -0,0 +1,34 @@ +/* Define iscanonical macro. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#ifndef _MATH_H +# error "Never use <bits/iscanonical.h> directly; include <math.h> instead." +#endif + +extern int __iscanonicall (long double __x) + __THROW __attribute__ ((__const__)); +#define __iscanonicalf(x) ((void) (__typeof (x)) (x), 1) +#define __iscanonical(x) ((void) (__typeof (x)) (x), 1) + +/* Return nonzero value if X is canonical. In IEEE interchange binary + formats, all values are canonical, but the argument must still be + converted to its semantic type for any exceptions arising from the + conversion, before being discarded; in extended precision, there + are encodings that are not consistently handled as corresponding to + any particular value of the type, and we return 0 for those. */ +#define iscanonical(x) __MATH_TG ((x), __iscanonical, (x)) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/bits/long-double.h b/REORG.TODO/sysdeps/ieee754/ldbl-96/bits/long-double.h new file mode 100644 index 0000000000..bb06df077f --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/bits/long-double.h @@ -0,0 +1,20 @@ +/* Properties of long double type. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* long double is distinct from double, so there is nothing to + define here. */ diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_acoshl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_acoshl.c new file mode 100644 index 0000000000..cf9a6db0ef --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_acoshl.c @@ -0,0 +1,61 @@ +/* e_acoshl.c -- long double version of e_acosh.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* __ieee754_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 +__ieee754_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 __ieee754_logl(x)+ln2; /* acoshl(huge)=logl(2x) */ + } else if(((se-0x3fff)|(i0^0x80000000)|i1)==0) { + return 0.0; /* acosh(1) = 0 */ + } else if (se > 0x4000) { /* 2**28 > x > 2 */ + t=x*x; + return __ieee754_logl(2.0*x-one/(x+__ieee754_sqrtl(t-one))); + } else { /* 1<x<2 */ + t = x-one; + return __log1pl(t+__ieee754_sqrtl(2.0*t+t*t)); + } +} +strong_alias (__ieee754_acoshl, __acoshl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_asinl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_asinl.c new file mode 100644 index 0000000000..f52b931459 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_asinl.c @@ -0,0 +1,157 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + Long double expansions are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* __ieee754_asin(x) + * Method : + * Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ... + * we approximate asin(x) on [0,0.5] by + * asin(x) = x + x*x^2*R(x^2) + * + * For x in [0.5,1] + * asin(x) = pi/2-2*asin(sqrt((1-x)/2)) + * Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2; + * then for x>0.98 + * asin(x) = pi/2 - 2*(s+s*z*R(z)) + * = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo) + * For x<=0.98, let pio4_hi = pio2_hi/2, then + * f = hi part of s; + * c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z) + * and + * asin(x) = pi/2 - 2*(s+s*z*R(z)) + * = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo) + * = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c)) + * + * Special cases: + * if x is NaN, return x itself; + * if |x|>1, return NaN with invalid signal. + * + */ + + +#include <float.h> +#include <math.h> +#include <math_private.h> + +static const long double + one = 1.0L, + huge = 1.0e+4932L, + pio2_hi = 0x1.921fb54442d1846ap+0L, /* pi/2 rounded to nearest to 64 + bits. */ + pio2_lo = -0x7.6733ae8fe47c65d8p-68L, /* pi/2 - pio2_hi rounded to + nearest to 64 bits. */ + pio4_hi = 0xc.90fdaa22168c235p-4L, /* pi/4 rounded to nearest to 64 + bits. */ + + /* coefficient for R(x^2) */ + + /* asin(x) = x + x^3 pS(x^2) / qS(x^2) + 0 <= x <= 0.5 + peak relative error 1.9e-21 */ + pS0 = -1.008714657938491626019651170502036851607E1L, + pS1 = 2.331460313214179572063441834101394865259E1L, + pS2 = -1.863169762159016144159202387315381830227E1L, + pS3 = 5.930399351579141771077475766877674661747E0L, + pS4 = -6.121291917696920296944056882932695185001E-1L, + pS5 = 3.776934006243367487161248678019350338383E-3L, + + qS0 = -6.052287947630949712886794360635592886517E1L, + qS1 = 1.671229145571899593737596543114258558503E2L, + qS2 = -1.707840117062586426144397688315411324388E2L, + qS3 = 7.870295154902110425886636075950077640623E1L, + qS4 = -1.568433562487314651121702982333303458814E1L; + /* 1.000000000000000000000000000000000000000E0 */ + +long double +__ieee754_asinl (long double x) +{ + long double t, w, p, q, c, r, s; + int32_t ix; + u_int32_t se, i0, i1, k; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + ix = (ix << 16) | (i0 >> 16); + if (ix >= 0x3fff8000) + { /* |x|>= 1 */ + if (ix == 0x3fff8000 && ((i0 - 0x80000000) | i1) == 0) + /* asin(1)=+-pi/2 with inexact */ + return x * pio2_hi + x * pio2_lo; + return (x - x) / (x - x); /* asin(|x|>1) is NaN */ + } + else if (ix < 0x3ffe8000) + { /* |x|<0.5 */ + if (ix < 0x3fde8000) + { /* if |x| < 2**-33 */ + math_check_force_underflow (x); + if (huge + x > one) + return x; /* return x with inexact if x!=0 */ + } + else + { + t = x * x; + p = + t * (pS0 + + t * (pS1 + t * (pS2 + t * (pS3 + t * (pS4 + t * pS5))))); + q = qS0 + t * (qS1 + t * (qS2 + t * (qS3 + t * (qS4 + t)))); + w = p / q; + return x + x * w; + } + } + /* 1> |x|>= 0.5 */ + w = one - fabsl (x); + t = w * 0.5; + p = t * (pS0 + t * (pS1 + t * (pS2 + t * (pS3 + t * (pS4 + t * pS5))))); + q = qS0 + t * (qS1 + t * (qS2 + t * (qS3 + t * (qS4 + t)))); + s = __ieee754_sqrtl (t); + if (ix >= 0x3ffef999) + { /* if |x| > 0.975 */ + w = p / q; + t = pio2_hi - (2.0 * (s + s * w) - pio2_lo); + } + else + { + GET_LDOUBLE_WORDS (k, i0, i1, s); + i1 = 0; + SET_LDOUBLE_WORDS (w,k,i0,i1); + c = (t - w * w) / (s + w); + r = p / q; + p = 2.0 * s * r - (pio2_lo - 2.0 * c); + q = pio4_hi - 2.0 * w; + t = pio4_hi - (p - q); + } + if ((se & 0x8000) == 0) + return t; + else + return -t; +} +strong_alias (__ieee754_asinl, __asinl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_atanhl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_atanhl.c new file mode 100644 index 0000000000..b99a83c6ee --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_atanhl.c @@ -0,0 +1,69 @@ +/* s_atanhl.c -- long double version of s_atan.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* __ieee754_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 <float.h> +#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 +__ieee754_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<0x3fdf) { + math_force_eval(huge+x); + math_check_force_underflow (x); + return x; /* x<2**-32 */ + } + 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; +} +strong_alias (__ieee754_atanhl, __atanhl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_coshl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_coshl.c new file mode 100644 index 0000000000..dd22cae363 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_coshl.c @@ -0,0 +1,87 @@ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: e_cosh.c,v 1.7 1995/05/10 20:44:58 jtc Exp $"; +#endif + +/* __ieee754_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 +__ieee754_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| in [0,22] */ + if (ex < 0x4003 || (ex == 0x4003 && mx < 0xb0000000u)) { + /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */ + if(ex < 0x3ffd || (ex == 0x3ffd && mx < 0xb17217f7u)) { + if (ex<0x3fbc) return one; /* cosh(tiny) = 1 */ + t = __expm1l(fabsl(x)); + w = one+t; + return one+(t*t)/(w+w); + } + + /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */ + t = __ieee754_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*__ieee754_expl(fabsl(x)); + + /* |x| in [log(maxdouble), log(2*maxdouble)) */ + if (ex == 0x400c && (mx < 0xb174ddc0u + || (mx == 0xb174ddc0u && lx < 0x31aec0ebu))) + { + w = __ieee754_expl(half*fabsl(x)); + t = half*w; + return t*w; + } + + /* x is INF or NaN */ + if(ex==0x7fff) return x*x; + + /* |x| >= log(2*maxdouble), cosh(x) overflow */ + return huge*huge; +} +strong_alias (__ieee754_coshl, __coshl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_gammal_r.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_gammal_r.c new file mode 100644 index 0000000000..7e42cc1161 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_gammal_r.c @@ -0,0 +1,210 @@ +/* Implementation of gamma function according to ISO C. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <float.h> + +/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) inside exp in Stirling's + approximation to gamma function. */ + +static const long double gamma_coeff[] = + { + 0x1.5555555555555556p-4L, + -0xb.60b60b60b60b60bp-12L, + 0x3.4034034034034034p-12L, + -0x2.7027027027027028p-12L, + 0x3.72a3c5631fe46aep-12L, + -0x7.daac36664f1f208p-12L, + 0x1.a41a41a41a41a41ap-8L, + -0x7.90a1b2c3d4e5f708p-8L, + }; + +#define NCOEFF (sizeof (gamma_coeff) / sizeof (gamma_coeff[0])) + +/* Return gamma (X), for positive X less than 1766, in the form R * + 2^(*EXP2_ADJ), where R is the return value and *EXP2_ADJ is set to + avoid overflow or underflow in intermediate calculations. */ + +static long double +gammal_positive (long double x, int *exp2_adj) +{ + int local_signgam; + if (x < 0.5L) + { + *exp2_adj = 0; + return __ieee754_expl (__ieee754_lgammal_r (x + 1, &local_signgam)) / x; + } + else if (x <= 1.5L) + { + *exp2_adj = 0; + return __ieee754_expl (__ieee754_lgammal_r (x, &local_signgam)); + } + else if (x < 7.5L) + { + /* Adjust into the range for using exp (lgamma). */ + *exp2_adj = 0; + long double n = __ceill (x - 1.5L); + long double x_adj = x - n; + long double eps; + long double prod = __gamma_productl (x_adj, 0, n, &eps); + return (__ieee754_expl (__ieee754_lgammal_r (x_adj, &local_signgam)) + * prod * (1.0L + eps)); + } + else + { + long double eps = 0; + long double x_eps = 0; + long double x_adj = x; + long double prod = 1; + if (x < 13.0L) + { + /* Adjust into the range for applying Stirling's + approximation. */ + long double n = __ceill (13.0L - x); + x_adj = x + n; + x_eps = (x - (x_adj - n)); + prod = __gamma_productl (x_adj - n, x_eps, n, &eps); + } + /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)). + Compute gamma (X_ADJ + X_EPS) using Stirling's approximation, + starting by computing pow (X_ADJ, X_ADJ) with a power of 2 + factored out. */ + long double exp_adj = -eps; + long double x_adj_int = __roundl (x_adj); + long double x_adj_frac = x_adj - x_adj_int; + int x_adj_log2; + long double x_adj_mant = __frexpl (x_adj, &x_adj_log2); + if (x_adj_mant < M_SQRT1_2l) + { + x_adj_log2--; + x_adj_mant *= 2.0L; + } + *exp2_adj = x_adj_log2 * (int) x_adj_int; + long double ret = (__ieee754_powl (x_adj_mant, x_adj) + * __ieee754_exp2l (x_adj_log2 * x_adj_frac) + * __ieee754_expl (-x_adj) + * __ieee754_sqrtl (2 * M_PIl / x_adj) + / prod); + exp_adj += x_eps * __ieee754_logl (x_adj); + long double bsum = gamma_coeff[NCOEFF - 1]; + long double x_adj2 = x_adj * x_adj; + for (size_t i = 1; i <= NCOEFF - 1; i++) + bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i]; + exp_adj += bsum / x_adj; + return ret + ret * __expm1l (exp_adj); + } +} + +long double +__ieee754_gammal_r (long double x, int *signgamp) +{ + u_int32_t es, hx, lx; + long double ret; + + GET_LDOUBLE_WORDS (es, hx, lx, x); + + if (__glibc_unlikely (((es & 0x7fff) | hx | lx) == 0)) + { + /* Return value for x == 0 is Inf with divide by zero exception. */ + *signgamp = 0; + return 1.0 / x; + } + if (__glibc_unlikely (es == 0xffffffff && ((hx & 0x7fffffff) | lx) == 0)) + { + /* x == -Inf. According to ISO this is NaN. */ + *signgamp = 0; + return x - x; + } + if (__glibc_unlikely ((es & 0x7fff) == 0x7fff)) + { + /* Positive infinity (return positive infinity) or NaN (return + NaN). */ + *signgamp = 0; + return x + x; + } + if (__builtin_expect ((es & 0x8000) != 0, 0) && __rintl (x) == x) + { + /* Return value for integer x < 0 is NaN with invalid exception. */ + *signgamp = 0; + return (x - x) / (x - x); + } + + if (x >= 1756.0L) + { + /* Overflow. */ + *signgamp = 0; + return LDBL_MAX * LDBL_MAX; + } + else + { + SET_RESTORE_ROUNDL (FE_TONEAREST); + if (x > 0.0L) + { + *signgamp = 0; + int exp2_adj; + ret = gammal_positive (x, &exp2_adj); + ret = __scalbnl (ret, exp2_adj); + } + else if (x >= -LDBL_EPSILON / 4.0L) + { + *signgamp = 0; + ret = 1.0L / x; + } + else + { + long double tx = __truncl (x); + *signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1; + if (x <= -1766.0L) + /* Underflow. */ + ret = LDBL_MIN * LDBL_MIN; + else + { + long double frac = tx - x; + if (frac > 0.5L) + frac = 1.0L - frac; + long double sinpix = (frac <= 0.25L + ? __sinl (M_PIl * frac) + : __cosl (M_PIl * (0.5L - frac))); + int exp2_adj; + ret = M_PIl / (-x * sinpix + * gammal_positive (-x, &exp2_adj)); + ret = __scalbnl (ret, -exp2_adj); + math_check_force_underflow_nonneg (ret); + } + } + } + if (isinf (ret) && x != 0) + { + if (*signgamp < 0) + return -(-__copysignl (LDBL_MAX, ret) * LDBL_MAX); + else + return __copysignl (LDBL_MAX, ret) * LDBL_MAX; + } + else if (ret == 0) + { + if (*signgamp < 0) + return -(-__copysignl (LDBL_MIN, ret) * LDBL_MIN); + else + return __copysignl (LDBL_MIN, ret) * LDBL_MIN; + } + else + return ret; +} +strong_alias (__ieee754_gammal_r, __gammal_r_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_hypotl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_hypotl.c new file mode 100644 index 0000000000..6b55b6d8ee --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_hypotl.c @@ -0,0 +1,142 @@ +/* e_hypotl.c -- long double version of e_hypot.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* __ieee754_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*y1+((x-y)*(x-y)+(t1*y2+t2*y)) + * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, + * y1= y with lower 32 bits chopped, y2 = y-y1. + * + * NOTE: scaling may be necessary if some argument is too + * large or too tiny + * + * Special cases: + * hypot(x,y) is INF if x or y is +INF or -INF; else + * hypot(x,y) is NAN if x or y is NAN. + * + * Accuracy: + * hypot(x,y) returns sqrt(x^2+y^2) with error less + * than 1 ulps (units in the last place) + */ + +#include <math.h> +#include <math_private.h> + +long double __ieee754_hypotl(long double x, long double y) +{ + long double a,b,t1,t2,y1,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(__builtin_expect(ea > 0x5f3f,0)) { /* a>2**8000 */ + if(ea == 0x7fff) { /* Inf or NaN */ + u_int32_t exp __attribute__ ((unused)); + u_int32_t high,low; + w = a+b; /* for sNaN */ + if (issignaling (a) || issignaling (b)) + return w; + GET_LDOUBLE_WORDS(exp,high,low,a); + if(((high&0x7fffffff)|low)==0) w = a; + GET_LDOUBLE_WORDS(exp,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(__builtin_expect(eb < 0x20bf, 0)) { /* b < 2**-8000 */ + if(eb == 0) { /* subnormal b or 0 */ + u_int32_t exp __attribute__ ((unused)); + u_int32_t high,low; + GET_LDOUBLE_WORDS(exp,high,low,b); + if((high|low)==0) return a; + SET_LDOUBLE_WORDS(t1, 0x7ffd, 0x80000000, 0); /* t1=2^16382 */ + b *= t1; + a *= t1; + k -= 16382; + GET_LDOUBLE_EXP (ea, a); + GET_LDOUBLE_EXP (eb, b); + if (eb > ea) + { + t1 = a; + a = b; + b = t1; + j = ea; + ea = eb; + eb = j; + } + } 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 = __ieee754_sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); + } else { + u_int32_t high; + GET_LDOUBLE_MSW(high,b); + a = a+a; + SET_LDOUBLE_WORDS(y1,eb,high,0); + y2 = b - y1; + GET_LDOUBLE_MSW(high,a); + SET_LDOUBLE_WORDS(t1,ea+1,high,0); + t2 = a - t1; + w = __ieee754_sqrtl(t1*y1-(w*(-w)-(t1*y2+t2*b))); + } + if(k!=0) { + u_int32_t exp; + t1 = 1.0; + GET_LDOUBLE_EXP(exp,t1); + SET_LDOUBLE_EXP(t1,exp+k); + w *= t1; + math_check_force_underflow_nonneg (w); + return w; + } else return w; +} +strong_alias (__ieee754_hypotl, __hypotl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_j0l.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_j0l.c new file mode 100644 index 0000000000..a536054cde --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_j0l.c @@ -0,0 +1,531 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* Long double expansions are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* __ieee754_j0(x), __ieee754_y0(x) + * Bessel function of the first and second kinds of order zero. + * Method -- j0(x): + * 1. For tiny x, we use j0(x) = 1 - x^2/4 + x^4/64 - ... + * 2. Reduce x to |x| since j0(x)=j0(-x), and + * for x in (0,2) + * j0(x) = 1 - z/4 + z^2*R0/S0, where z = x*x; + * for x in (2,inf) + * j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0)) + * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) + * as follow: + * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) + * = 1/sqrt(2) * (cos(x) + sin(x)) + * sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * (To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one.) + * + * 3 Special cases + * j0(nan)= nan + * j0(0) = 1 + * j0(inf) = 0 + * + * Method -- y0(x): + * 1. For x<2. + * Since + * y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...) + * therefore y0(x)-2/pi*j0(x)*ln(x) is an even function. + * We use the following function to approximate y0, + * y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2 + * + * Note: For tiny x, U/V = u0 and j0(x)~1, hence + * y0(tiny) = u0 + (2/pi)*ln(tiny), (choose tiny<2**-27) + * 2. For x>=2. + * y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0)) + * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) + * by the method mentioned above. + * 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0. + */ + +#include <math.h> +#include <math_private.h> + +static long double pzero (long double), qzero (long double); + +static const long double + huge = 1e4930L, + one = 1.0L, + invsqrtpi = 5.6418958354775628694807945156077258584405e-1L, + tpi = 6.3661977236758134307553505349005744813784e-1L, + + /* J0(x) = 1 - x^2 / 4 + x^4 R0(x^2) / S0(x^2) + 0 <= x <= 2 + peak relative error 1.41e-22 */ + R[5] = { + 4.287176872744686992880841716723478740566E7L, + -6.652058897474241627570911531740907185772E5L, + 7.011848381719789863458364584613651091175E3L, + -3.168040850193372408702135490809516253693E1L, + 6.030778552661102450545394348845599300939E-2L, +}, + + S[4] = { + 2.743793198556599677955266341699130654342E9L, + 3.364330079384816249840086842058954076201E7L, + 1.924119649412510777584684927494642526573E5L, + 6.239282256012734914211715620088714856494E2L, + /* 1.000000000000000000000000000000000000000E0L,*/ +}; + +static const long double zero = 0.0; + +long double +__ieee754_j0l (long double x) +{ + long double z, s, c, ss, cc, r, u, v; + int32_t ix; + u_int32_t se; + + GET_LDOUBLE_EXP (se, x); + ix = se & 0x7fff; + if (__glibc_unlikely (ix >= 0x7fff)) + return one / (x * x); + x = fabsl (x); + if (ix >= 0x4000) /* |x| >= 2.0 */ + { + __sincosl (x, &s, &c); + ss = s - c; + cc = s + c; + if (ix < 0x7ffe) + { /* make sure x+x not overflow */ + z = -__cosl (x + x); + if ((s * c) < zero) + cc = z / ss; + else + ss = z / cc; + } + /* + * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) + * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) + */ + if (__glibc_unlikely (ix > 0x4080)) /* 2^129 */ + z = (invsqrtpi * cc) / __ieee754_sqrtl (x); + else + { + u = pzero (x); + v = qzero (x); + z = invsqrtpi * (u * cc - v * ss) / __ieee754_sqrtl (x); + } + return z; + } + if (__glibc_unlikely (ix < 0x3fef)) /* |x| < 2**-16 */ + { + /* raise inexact if x != 0 */ + math_force_eval (huge + x); + if (ix < 0x3fde) /* |x| < 2^-33 */ + return one; + else + return one - 0.25 * x * x; + } + z = x * x; + r = z * (R[0] + z * (R[1] + z * (R[2] + z * (R[3] + z * R[4])))); + s = S[0] + z * (S[1] + z * (S[2] + z * (S[3] + z))); + if (ix < 0x3fff) + { /* |x| < 1.00 */ + return (one - 0.25 * z + z * (r / s)); + } + else + { + u = 0.5 * x; + return ((one + u) * (one - u) + z * (r / s)); + } +} +strong_alias (__ieee754_j0l, __j0l_finite) + + +/* y0(x) = 2/pi ln(x) J0(x) + U(x^2)/V(x^2) + 0 < x <= 2 + peak relative error 1.7e-21 */ +static const long double +U[6] = { + -1.054912306975785573710813351985351350861E10L, + 2.520192609749295139432773849576523636127E10L, + -1.856426071075602001239955451329519093395E9L, + 4.079209129698891442683267466276785956784E7L, + -3.440684087134286610316661166492641011539E5L, + 1.005524356159130626192144663414848383774E3L, +}; +static const long double +V[5] = { + 1.429337283720789610137291929228082613676E11L, + 2.492593075325119157558811370165695013002E9L, + 2.186077620785925464237324417623665138376E7L, + 1.238407896366385175196515057064384929222E5L, + 4.693924035211032457494368947123233101664E2L, + /* 1.000000000000000000000000000000000000000E0L */ +}; + +long double +__ieee754_y0l (long double x) +{ + long double z, s, c, ss, cc, u, v; + int32_t ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ + if (__glibc_unlikely (se & 0x8000)) + return zero / (zero * x); + if (__glibc_unlikely (ix >= 0x7fff)) + return one / (x + x * x); + if (__glibc_unlikely ((i0 | i1) == 0)) + return -HUGE_VALL + x; /* -inf and overflow exception. */ + if (ix >= 0x4000) + { /* |x| >= 2.0 */ + + /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) + * where x0 = x-pi/4 + * Better formula: + * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) + * = 1/sqrt(2) * (sin(x) + cos(x)) + * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one. + */ + __sincosl (x, &s, &c); + ss = s - c; + cc = s + c; + /* + * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) + * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) + */ + if (ix < 0x7ffe) + { /* make sure x+x not overflow */ + z = -__cosl (x + x); + if ((s * c) < zero) + cc = z / ss; + else + ss = z / cc; + } + if (__glibc_unlikely (ix > 0x4080)) /* 1e39 */ + z = (invsqrtpi * ss) / __ieee754_sqrtl (x); + else + { + u = pzero (x); + v = qzero (x); + z = invsqrtpi * (u * ss + v * cc) / __ieee754_sqrtl (x); + } + return z; + } + if (__glibc_unlikely (ix <= 0x3fde)) /* x < 2^-33 */ + { + z = -7.380429510868722527629822444004602747322E-2L + + tpi * __ieee754_logl (x); + return z; + } + z = x * x; + u = U[0] + z * (U[1] + z * (U[2] + z * (U[3] + z * (U[4] + z * U[5])))); + v = V[0] + z * (V[1] + z * (V[2] + z * (V[3] + z * (V[4] + z)))); + return (u / v + tpi * (__ieee754_j0l (x) * __ieee754_logl (x))); +} +strong_alias (__ieee754_y0l, __y0l_finite) + +/* The asymptotic expansions of pzero is + * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. + * For x >= 2, We approximate pzero by + * pzero(x) = 1 + s^2 R(s^2) / S(s^2) + */ +static const long double pR8[7] = { + /* 8 <= x <= inf + Peak relative error 4.62 */ + -4.094398895124198016684337960227780260127E-9L, + -8.929643669432412640061946338524096893089E-7L, + -6.281267456906136703868258380673108109256E-5L, + -1.736902783620362966354814353559382399665E-3L, + -1.831506216290984960532230842266070146847E-2L, + -5.827178869301452892963280214772398135283E-2L, + -2.087563267939546435460286895807046616992E-2L, +}; +static const long double pS8[6] = { + 5.823145095287749230197031108839653988393E-8L, + 1.279281986035060320477759999428992730280E-5L, + 9.132668954726626677174825517150228961304E-4L, + 2.606019379433060585351880541545146252534E-2L, + 2.956262215119520464228467583516287175244E-1L, + 1.149498145388256448535563278632697465675E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double pR5[7] = { + /* 4.54541015625 <= x <= 8 + Peak relative error 6.51E-22 */ + -2.041226787870240954326915847282179737987E-7L, + -2.255373879859413325570636768224534428156E-5L, + -7.957485746440825353553537274569102059990E-4L, + -1.093205102486816696940149222095559439425E-2L, + -5.657957849316537477657603125260701114646E-2L, + -8.641175552716402616180994954177818461588E-2L, + -1.354654710097134007437166939230619726157E-2L, +}; +static const long double pS5[6] = { + 2.903078099681108697057258628212823545290E-6L, + 3.253948449946735405975737677123673867321E-4L, + 1.181269751723085006534147920481582279979E-2L, + 1.719212057790143888884745200257619469363E-1L, + 1.006306498779212467670654535430694221924E0L, + 2.069568808688074324555596301126375951502E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double pR3[7] = { + /* 2.85711669921875 <= x <= 4.54541015625 + peak relative error 5.25e-21 */ + -5.755732156848468345557663552240816066802E-6L, + -3.703675625855715998827966962258113034767E-4L, + -7.390893350679637611641350096842846433236E-3L, + -5.571922144490038765024591058478043873253E-2L, + -1.531290690378157869291151002472627396088E-1L, + -1.193350853469302941921647487062620011042E-1L, + -8.567802507331578894302991505331963782905E-3L, +}; +static const long double pS3[6] = { + 8.185931139070086158103309281525036712419E-5L, + 5.398016943778891093520574483111255476787E-3L, + 1.130589193590489566669164765853409621081E-1L, + 9.358652328786413274673192987670237145071E-1L, + 3.091711512598349056276917907005098085273E0L, + 3.594602474737921977972586821673124231111E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double pR2[7] = { + /* 2 <= x <= 2.85711669921875 + peak relative error 2.64e-21 */ + -1.219525235804532014243621104365384992623E-4L, + -4.838597135805578919601088680065298763049E-3L, + -5.732223181683569266223306197751407418301E-2L, + -2.472947430526425064982909699406646503758E-1L, + -3.753373645974077960207588073975976327695E-1L, + -1.556241316844728872406672349347137975495E-1L, + -5.355423239526452209595316733635519506958E-3L, +}; +static const long double pS2[6] = { + 1.734442793664291412489066256138894953823E-3L, + 7.158111826468626405416300895617986926008E-2L, + 9.153839713992138340197264669867993552641E-1L, + 4.539209519433011393525841956702487797582E0L, + 8.868932430625331650266067101752626253644E0L, + 6.067161890196324146320763844772857713502E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static long double +pzero (long double x) +{ + const long double *p, *q; + long double z, r, s; + int32_t ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* ix >= 0x4000 for all calls to this function. */ + if (ix >= 0x4002) + { + p = pR8; + q = pS8; + } /* x >= 8 */ + else + { + i1 = (ix << 16) | (i0 >> 16); + if (i1 >= 0x40019174) /* x >= 4.54541015625 */ + { + p = pR5; + q = pS5; + } + else if (i1 >= 0x4000b6db) /* x >= 2.85711669921875 */ + { + p = pR3; + q = pS3; + } + else /* x >= 2 */ + { + p = pR2; + q = pS2; + } + } + z = one / (x * x); + r = + p[0] + z * (p[1] + + z * (p[2] + z * (p[3] + z * (p[4] + z * (p[5] + z * p[6]))))); + s = + q[0] + z * (q[1] + z * (q[2] + z * (q[3] + z * (q[4] + z * (q[5] + z))))); + return (one + z * r / s); +} + + +/* For x >= 8, the asymptotic expansions of qzero is + * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. + * We approximate qzero by + * qzero(x) = s*(-.125 + R(s^2) / S(s^2)) + */ +static const long double qR8[7] = { + /* 8 <= x <= inf + peak relative error 2.23e-21 */ + 3.001267180483191397885272640777189348008E-10L, + 8.693186311430836495238494289942413810121E-8L, + 8.496875536711266039522937037850596580686E-6L, + 3.482702869915288984296602449543513958409E-4L, + 6.036378380706107692863811938221290851352E-3L, + 3.881970028476167836382607922840452192636E-2L, + 6.132191514516237371140841765561219149638E-2L, +}; +static const long double qS8[7] = { + 4.097730123753051126914971174076227600212E-9L, + 1.199615869122646109596153392152131139306E-6L, + 1.196337580514532207793107149088168946451E-4L, + 5.099074440112045094341500497767181211104E-3L, + 9.577420799632372483249761659674764460583E-2L, + 7.385243015344292267061953461563695918646E-1L, + 1.917266424391428937962682301561699055943E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double qR5[7] = { + /* 4.54541015625 <= x <= 8 + peak relative error 1.03e-21 */ + 3.406256556438974327309660241748106352137E-8L, + 4.855492710552705436943630087976121021980E-6L, + 2.301011739663737780613356017352912281980E-4L, + 4.500470249273129953870234803596619899226E-3L, + 3.651376459725695502726921248173637054828E-2L, + 1.071578819056574524416060138514508609805E-1L, + 7.458950172851611673015774675225656063757E-2L, +}; +static const long double qS5[7] = { + 4.650675622764245276538207123618745150785E-7L, + 6.773573292521412265840260065635377164455E-5L, + 3.340711249876192721980146877577806687714E-3L, + 7.036218046856839214741678375536970613501E-2L, + 6.569599559163872573895171876511377891143E-1L, + 2.557525022583599204591036677199171155186E0L, + 3.457237396120935674982927714210361269133E0L, + /* 1.000000000000000000000000000000000000000E0L,*/ +}; + +static const long double qR3[7] = { + /* 2.85711669921875 <= x <= 4.54541015625 + peak relative error 5.24e-21 */ + 1.749459596550816915639829017724249805242E-6L, + 1.446252487543383683621692672078376929437E-4L, + 3.842084087362410664036704812125005761859E-3L, + 4.066369994699462547896426554180954233581E-2L, + 1.721093619117980251295234795188992722447E-1L, + 2.538595333972857367655146949093055405072E-1L, + 8.560591367256769038905328596020118877936E-2L, +}; +static const long double qS3[7] = { + 2.388596091707517488372313710647510488042E-5L, + 2.048679968058758616370095132104333998147E-3L, + 5.824663198201417760864458765259945181513E-2L, + 6.953906394693328750931617748038994763958E-1L, + 3.638186936390881159685868764832961092476E0L, + 7.900169524705757837298990558459547842607E0L, + 5.992718532451026507552820701127504582907E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double qR2[7] = { + /* 2 <= x <= 2.85711669921875 + peak relative error 1.58e-21 */ + 6.306524405520048545426928892276696949540E-5L, + 3.209606155709930950935893996591576624054E-3L, + 5.027828775702022732912321378866797059604E-2L, + 3.012705561838718956481911477587757845163E-1L, + 6.960544893905752937420734884995688523815E-1L, + 5.431871999743531634887107835372232030655E-1L, + 9.447736151202905471899259026430157211949E-2L, +}; +static const long double qS2[7] = { + 8.610579901936193494609755345106129102676E-4L, + 4.649054352710496997203474853066665869047E-2L, + 8.104282924459837407218042945106320388339E-1L, + 5.807730930825886427048038146088828206852E0L, + 1.795310145936848873627710102199881642939E1L, + 2.281313316875375733663657188888110605044E1L, + 1.011242067883822301487154844458322200143E1L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static long double +qzero (long double x) +{ + const long double *p, *q; + long double s, r, z; + int32_t ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* ix >= 0x4000 for all calls to this function. */ + if (ix >= 0x4002) /* x >= 8 */ + { + p = qR8; + q = qS8; + } + else + { + i1 = (ix << 16) | (i0 >> 16); + if (i1 >= 0x40019174) /* x >= 4.54541015625 */ + { + p = qR5; + q = qS5; + } + else if (i1 >= 0x4000b6db) /* x >= 2.85711669921875 */ + { + p = qR3; + q = qS3; + } + else /* x >= 2 */ + { + p = qR2; + q = qS2; + } + } + z = one / (x * x); + r = + p[0] + z * (p[1] + + z * (p[2] + z * (p[3] + z * (p[4] + z * (p[5] + z * p[6]))))); + s = + q[0] + z * (q[1] + + z * (q[2] + + z * (q[3] + z * (q[4] + z * (q[5] + z * (q[6] + z)))))); + return (-.125 + z * r / s) / x; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_j1l.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_j1l.c new file mode 100644 index 0000000000..e8a7349cf4 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_j1l.c @@ -0,0 +1,550 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* Long double expansions are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* __ieee754_j1(x), __ieee754_y1(x) + * Bessel function of the first and second kinds of order zero. + * Method -- j1(x): + * 1. For tiny x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ... + * 2. Reduce x to |x| since j1(x)=-j1(-x), and + * for x in (0,2) + * j1(x) = x/2 + x*z*R0/S0, where z = x*x; + * for x in (2,inf) + * j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1)) + * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) + * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) + * as follow: + * cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = -1/sqrt(2) * (sin(x) + cos(x)) + * (To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one.) + * + * 3 Special cases + * j1(nan)= nan + * j1(0) = 0 + * j1(inf) = 0 + * + * Method -- y1(x): + * 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN + * 2. For x<2. + * Since + * y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...) + * therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function. + * We use the following function to approximate y1, + * y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2 + * Note: For tiny x, 1/x dominate y1 and hence + * y1(tiny) = -2/pi/tiny + * 3. For x>=2. + * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) + * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) + * by method mentioned above. + */ + +#include <errno.h> +#include <float.h> +#include <math.h> +#include <math_private.h> + +static long double pone (long double), qone (long double); + +static const long double + huge = 1e4930L, + one = 1.0L, + invsqrtpi = 5.6418958354775628694807945156077258584405e-1L, + tpi = 6.3661977236758134307553505349005744813784e-1L, + + /* J1(x) = .5 x + x x^2 R(x^2) / S(x^2) + 0 <= x <= 2 + Peak relative error 4.5e-21 */ +R[5] = { + -9.647406112428107954753770469290757756814E7L, + 2.686288565865230690166454005558203955564E6L, + -3.689682683905671185891885948692283776081E4L, + 2.195031194229176602851429567792676658146E2L, + -5.124499848728030297902028238597308971319E-1L, +}, + + S[4] = +{ + 1.543584977988497274437410333029029035089E9L, + 2.133542369567701244002565983150952549520E7L, + 1.394077011298227346483732156167414670520E5L, + 5.252401789085732428842871556112108446506E2L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +static const long double zero = 0.0; + + +long double +__ieee754_j1l (long double x) +{ + long double z, c, r, s, ss, cc, u, v, y; + int32_t ix; + u_int32_t se; + + GET_LDOUBLE_EXP (se, x); + ix = se & 0x7fff; + if (__glibc_unlikely (ix >= 0x7fff)) + return one / x; + y = fabsl (x); + if (ix >= 0x4000) + { /* |x| >= 2.0 */ + __sincosl (y, &s, &c); + ss = -s - c; + cc = s - c; + if (ix < 0x7ffe) + { /* make sure y+y not overflow */ + z = __cosl (y + y); + if ((s * c) > zero) + cc = z / ss; + else + ss = z / cc; + } + /* + * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) + * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) + */ + if (__glibc_unlikely (ix > 0x4080)) + z = (invsqrtpi * cc) / __ieee754_sqrtl (y); + else + { + u = pone (y); + v = qone (y); + z = invsqrtpi * (u * cc - v * ss) / __ieee754_sqrtl (y); + } + if (se & 0x8000) + return -z; + else + return z; + } + if (__glibc_unlikely (ix < 0x3fde)) /* |x| < 2^-33 */ + { + if (huge + x > one) /* inexact if x!=0 necessary */ + { + long double ret = 0.5 * x; + math_check_force_underflow (ret); + if (ret == 0 && x != 0) + __set_errno (ERANGE); + return ret; + } + } + z = x * x; + r = z * (R[0] + z * (R[1]+ z * (R[2] + z * (R[3] + z * R[4])))); + s = S[0] + z * (S[1] + z * (S[2] + z * (S[3] + z))); + r *= x; + return (x * 0.5 + r / s); +} +strong_alias (__ieee754_j1l, __j1l_finite) + + +/* Y1(x) = 2/pi * (log(x) * j1(x) - 1/x) + x R(x^2) + 0 <= x <= 2 + Peak relative error 2.3e-23 */ +static const long double U0[6] = { + -5.908077186259914699178903164682444848615E10L, + 1.546219327181478013495975514375773435962E10L, + -6.438303331169223128870035584107053228235E8L, + 9.708540045657182600665968063824819371216E6L, + -6.138043997084355564619377183564196265471E4L, + 1.418503228220927321096904291501161800215E2L, +}; +static const long double V0[5] = { + 3.013447341682896694781964795373783679861E11L, + 4.669546565705981649470005402243136124523E9L, + 3.595056091631351184676890179233695857260E7L, + 1.761554028569108722903944659933744317994E5L, + 5.668480419646516568875555062047234534863E2L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + + +long double +__ieee754_y1l (long double x) +{ + long double z, s, c, ss, cc, u, v; + int32_t ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ + if (__glibc_unlikely (se & 0x8000)) + return zero / (zero * x); + if (__glibc_unlikely (ix >= 0x7fff)) + return one / (x + x * x); + if (__glibc_unlikely ((i0 | i1) == 0)) + return -HUGE_VALL + x; /* -inf and overflow exception. */ + if (ix >= 0x4000) + { /* |x| >= 2.0 */ + __sincosl (x, &s, &c); + ss = -s - c; + cc = s - c; + if (ix < 0x7ffe) + { /* make sure x+x not overflow */ + z = __cosl (x + x); + if ((s * c) > zero) + cc = z / ss; + else + ss = z / cc; + } + /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) + * where x0 = x-3pi/4 + * Better formula: + * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = -1/sqrt(2) * (cos(x) + sin(x)) + * To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one. + */ + if (__glibc_unlikely (ix > 0x4080)) + z = (invsqrtpi * ss) / __ieee754_sqrtl (x); + else + { + u = pone (x); + v = qone (x); + z = invsqrtpi * (u * ss + v * cc) / __ieee754_sqrtl (x); + } + return z; + } + if (__glibc_unlikely (ix <= 0x3fbe)) + { /* x < 2**-65 */ + z = -tpi / x; + if (isinf (z)) + __set_errno (ERANGE); + return z; + } + z = x * x; + u = U0[0] + z * (U0[1] + z * (U0[2] + z * (U0[3] + z * (U0[4] + z * U0[5])))); + v = V0[0] + z * (V0[1] + z * (V0[2] + z * (V0[3] + z * (V0[4] + z)))); + return (x * (u / v) + + tpi * (__ieee754_j1l (x) * __ieee754_logl (x) - one / x)); +} +strong_alias (__ieee754_y1l, __y1l_finite) + + +/* For x >= 8, the asymptotic expansions of pone is + * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. + * We approximate pone by + * pone(x) = 1 + (R/S) + */ + +/* J1(x) cosX + Y1(x) sinX = sqrt( 2/(pi x)) P1(x) + P1(x) = 1 + z^2 R(z^2), z=1/x + 8 <= x <= inf (0 <= z <= 0.125) + Peak relative error 5.2e-22 */ + +static const long double pr8[7] = { + 8.402048819032978959298664869941375143163E-9L, + 1.813743245316438056192649247507255996036E-6L, + 1.260704554112906152344932388588243836276E-4L, + 3.439294839869103014614229832700986965110E-3L, + 3.576910849712074184504430254290179501209E-2L, + 1.131111483254318243139953003461511308672E-1L, + 4.480715825681029711521286449131671880953E-2L, +}; +static const long double ps8[6] = { + 7.169748325574809484893888315707824924354E-8L, + 1.556549720596672576431813934184403614817E-5L, + 1.094540125521337139209062035774174565882E-3L, + 3.060978962596642798560894375281428805840E-2L, + 3.374146536087205506032643098619414507024E-1L, + 1.253830208588979001991901126393231302559E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* J1(x) cosX + Y1(x) sinX = sqrt( 2/(pi x)) P1(x) + P1(x) = 1 + z^2 R(z^2), z=1/x + 4.54541015625 <= x <= 8 + Peak relative error 7.7e-22 */ +static const long double pr5[7] = { + 4.318486887948814529950980396300969247900E-7L, + 4.715341880798817230333360497524173929315E-5L, + 1.642719430496086618401091544113220340094E-3L, + 2.228688005300803935928733750456396149104E-2L, + 1.142773760804150921573259605730018327162E-1L, + 1.755576530055079253910829652698703791957E-1L, + 3.218803858282095929559165965353784980613E-2L, +}; +static const long double ps5[6] = { + 3.685108812227721334719884358034713967557E-6L, + 4.069102509511177498808856515005792027639E-4L, + 1.449728676496155025507893322405597039816E-2L, + 2.058869213229520086582695850441194363103E-1L, + 1.164890985918737148968424972072751066553E0L, + 2.274776933457009446573027260373361586841E0L, + /* 1.000000000000000000000000000000000000000E0L,*/ +}; + +/* J1(x) cosX + Y1(x) sinX = sqrt( 2/(pi x)) P1(x) + P1(x) = 1 + z^2 R(z^2), z=1/x + 2.85711669921875 <= x <= 4.54541015625 + Peak relative error 6.5e-21 */ +static const long double pr3[7] = { + 1.265251153957366716825382654273326407972E-5L, + 8.031057269201324914127680782288352574567E-4L, + 1.581648121115028333661412169396282881035E-2L, + 1.179534658087796321928362981518645033967E-1L, + 3.227936912780465219246440724502790727866E-1L, + 2.559223765418386621748404398017602935764E-1L, + 2.277136933287817911091370397134882441046E-2L, +}; +static const long double ps3[6] = { + 1.079681071833391818661952793568345057548E-4L, + 6.986017817100477138417481463810841529026E-3L, + 1.429403701146942509913198539100230540503E-1L, + 1.148392024337075609460312658938700765074E0L, + 3.643663015091248720208251490291968840882E0L, + 3.990702269032018282145100741746633960737E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* J1(x) cosX + Y1(x) sinX = sqrt( 2/(pi x)) P1(x) + P1(x) = 1 + z^2 R(z^2), z=1/x + 2 <= x <= 2.85711669921875 + Peak relative error 3.5e-21 */ +static const long double pr2[7] = { + 2.795623248568412225239401141338714516445E-4L, + 1.092578168441856711925254839815430061135E-2L, + 1.278024620468953761154963591853679640560E-1L, + 5.469680473691500673112904286228351988583E-1L, + 8.313769490922351300461498619045639016059E-1L, + 3.544176317308370086415403567097130611468E-1L, + 1.604142674802373041247957048801599740644E-2L, +}; +static const long double ps2[6] = { + 2.385605161555183386205027000675875235980E-3L, + 9.616778294482695283928617708206967248579E-2L, + 1.195215570959693572089824415393951258510E0L, + 5.718412857897054829999458736064922974662E0L, + 1.065626298505499086386584642761602177568E1L, + 6.809140730053382188468983548092322151791E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + + +static long double +pone (long double x) +{ + const long double *p, *q; + long double z, r, s; + int32_t ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* ix >= 0x4000 for all calls to this function. */ + if (ix >= 0x4002) /* x >= 8 */ + { + p = pr8; + q = ps8; + } + else + { + i1 = (ix << 16) | (i0 >> 16); + if (i1 >= 0x40019174) /* x >= 4.54541015625 */ + { + p = pr5; + q = ps5; + } + else if (i1 >= 0x4000b6db) /* x >= 2.85711669921875 */ + { + p = pr3; + q = ps3; + } + else /* x >= 2 */ + { + p = pr2; + q = ps2; + } + } + z = one / (x * x); + r = p[0] + z * (p[1] + + z * (p[2] + z * (p[3] + z * (p[4] + z * (p[5] + z * p[6]))))); + s = q[0] + z * (q[1] + z * (q[2] + z * (q[3] + z * (q[4] + z * (q[5] + z))))); + return one + z * r / s; +} + + +/* For x >= 8, the asymptotic expansions of qone is + * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. + * We approximate pone by + * qone(x) = s*(0.375 + (R/S)) + */ + +/* Y1(x)cosX - J1(x)sinX = sqrt( 2/(pi x)) Q1(x), + Q1(x) = z(.375 + z^2 R(z^2)), z=1/x + 8 <= x <= inf + Peak relative error 8.3e-22 */ + +static const long double qr8[7] = { + -5.691925079044209246015366919809404457380E-10L, + -1.632587664706999307871963065396218379137E-7L, + -1.577424682764651970003637263552027114600E-5L, + -6.377627959241053914770158336842725291713E-4L, + -1.087408516779972735197277149494929568768E-2L, + -6.854943629378084419631926076882330494217E-2L, + -1.055448290469180032312893377152490183203E-1L, +}; +static const long double qs8[7] = { + 5.550982172325019811119223916998393907513E-9L, + 1.607188366646736068460131091130644192244E-6L, + 1.580792530091386496626494138334505893599E-4L, + 6.617859900815747303032860443855006056595E-3L, + 1.212840547336984859952597488863037659161E-1L, + 9.017885953937234900458186716154005541075E-1L, + 2.201114489712243262000939120146436167178E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* Y1(x)cosX - J1(x)sinX = sqrt( 2/(pi x)) Q1(x), + Q1(x) = z(.375 + z^2 R(z^2)), z=1/x + 4.54541015625 <= x <= 8 + Peak relative error 4.1e-22 */ +static const long double qr5[7] = { + -6.719134139179190546324213696633564965983E-8L, + -9.467871458774950479909851595678622044140E-6L, + -4.429341875348286176950914275723051452838E-4L, + -8.539898021757342531563866270278505014487E-3L, + -6.818691805848737010422337101409276287170E-2L, + -1.964432669771684034858848142418228214855E-1L, + -1.333896496989238600119596538299938520726E-1L, +}; +static const long double qs5[7] = { + 6.552755584474634766937589285426911075101E-7L, + 9.410814032118155978663509073200494000589E-5L, + 4.561677087286518359461609153655021253238E-3L, + 9.397742096177905170800336715661091535805E-2L, + 8.518538116671013902180962914473967738771E-1L, + 3.177729183645800174212539541058292579009E0L, + 4.006745668510308096259753538973038902990E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* Y1(x)cosX - J1(x)sinX = sqrt( 2/(pi x)) Q1(x), + Q1(x) = z(.375 + z^2 R(z^2)), z=1/x + 2.85711669921875 <= x <= 4.54541015625 + Peak relative error 2.2e-21 */ +static const long double qr3[7] = { + -3.618746299358445926506719188614570588404E-6L, + -2.951146018465419674063882650970344502798E-4L, + -7.728518171262562194043409753656506795258E-3L, + -8.058010968753999435006488158237984014883E-2L, + -3.356232856677966691703904770937143483472E-1L, + -4.858192581793118040782557808823460276452E-1L, + -1.592399251246473643510898335746432479373E-1L, +}; +static const long double qs3[7] = { + 3.529139957987837084554591421329876744262E-5L, + 2.973602667215766676998703687065066180115E-3L, + 8.273534546240864308494062287908662592100E-2L, + 9.613359842126507198241321110649974032726E-1L, + 4.853923697093974370118387947065402707519E0L, + 1.002671608961669247462020977417828796933E1L, + 7.028927383922483728931327850683151410267E0L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + +/* Y1(x)cosX - J1(x)sinX = sqrt( 2/(pi x)) Q1(x), + Q1(x) = z(.375 + z^2 R(z^2)), z=1/x + 2 <= x <= 2.85711669921875 + Peak relative error 6.9e-22 */ +static const long double qr2[7] = { + -1.372751603025230017220666013816502528318E-4L, + -6.879190253347766576229143006767218972834E-3L, + -1.061253572090925414598304855316280077828E-1L, + -6.262164224345471241219408329354943337214E-1L, + -1.423149636514768476376254324731437473915E0L, + -1.087955310491078933531734062917489870754E0L, + -1.826821119773182847861406108689273719137E-1L, +}; +static const long double qs2[7] = { + 1.338768933634451601814048220627185324007E-3L, + 7.071099998918497559736318523932241901810E-2L, + 1.200511429784048632105295629933382142221E0L, + 8.327301713640367079030141077172031825276E0L, + 2.468479301872299311658145549931764426840E1L, + 2.961179686096262083509383820557051621644E1L, + 1.201402313144305153005639494661767354977E1L, + /* 1.000000000000000000000000000000000000000E0L, */ +}; + + +static long double +qone (long double x) +{ + const long double *p, *q; + static long double s, r, z; + int32_t ix; + u_int32_t se, i0, i1; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* ix >= 0x4000 for all calls to this function. */ + if (ix >= 0x4002) /* x >= 8 */ + { + p = qr8; + q = qs8; + } + else + { + i1 = (ix << 16) | (i0 >> 16); + if (i1 >= 0x40019174) /* x >= 4.54541015625 */ + { + p = qr5; + q = qs5; + } + else if (i1 >= 0x4000b6db) /* x >= 2.85711669921875 */ + { + p = qr3; + q = qs3; + } + else /* x >= 2 */ + { + p = qr2; + q = qs2; + } + } + z = one / (x * x); + r = + p[0] + z * (p[1] + + z * (p[2] + z * (p[3] + z * (p[4] + z * (p[5] + z * p[6]))))); + s = + q[0] + z * (q[1] + + z * (q[2] + + z * (q[3] + z * (q[4] + z * (q[5] + z * (q[6] + z)))))); + return (.375 + z * r / s) / x; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_jnl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_jnl.c new file mode 100644 index 0000000000..92f96921a7 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_jnl.c @@ -0,0 +1,404 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* Modifications for long double are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* + * __ieee754_jn(n, x), __ieee754_yn(n, x) + * floating point Bessel's function of the 1st and 2nd kind + * of order n + * + * Special cases: + * y0(0)=y1(0)=yn(n,0) = -inf with overflow signal; + * y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal. + * Note 2. About jn(n,x), yn(n,x) + * For n=0, j0(x) is called, + * for n=1, j1(x) is called, + * for n<x, forward recursion us used starting + * from values of j0(x) and j1(x). + * for n>x, a continued fraction approximation to + * j(n,x)/j(n-1,x) is evaluated and then backward + * recursion is used starting from a supposed value + * for j(n,x). The resulting value of j(0,x) is + * compared with the actual value to correct the + * supposed value of j(n,x). + * + * yn(n,x) is similar in all respects, except + * that forward recursion is used for all + * values of n>1. + * + */ + +#include <errno.h> +#include <float.h> +#include <math.h> +#include <math_private.h> + +static const long double + invsqrtpi = 5.64189583547756286948079e-1L, two = 2.0e0L, one = 1.0e0L; + +static const long double zero = 0.0L; + +long double +__ieee754_jnl (int n, long double x) +{ + u_int32_t se, i0, i1; + int32_t i, ix, sgn; + long double a, b, temp, di, ret; + long double z, w; + + /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) + * Thus, J(-n,x) = J(n,-x) + */ + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + + /* if J(n,NaN) is NaN */ + if (__glibc_unlikely ((ix == 0x7fff) && ((i0 & 0x7fffffff) != 0))) + return x + x; + if (n < 0) + { + n = -n; + x = -x; + se ^= 0x8000; + } + if (n == 0) + return (__ieee754_j0l (x)); + if (n == 1) + return (__ieee754_j1l (x)); + sgn = (n & 1) & (se >> 15); /* even n -- 0, odd n -- sign(x) */ + x = fabsl (x); + { + SET_RESTORE_ROUNDL (FE_TONEAREST); + if (__glibc_unlikely ((ix | i0 | i1) == 0 || ix >= 0x7fff)) + /* if x is 0 or inf */ + return sgn == 1 ? -zero : zero; + else if ((long double) n <= x) + { + /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ + if (ix >= 0x412D) + { /* x > 2**302 */ + + /* ??? This might be a futile gesture. + If x exceeds X_TLOSS anyway, the wrapper function + will set the result to zero. */ + + /* (x >> n**2) + * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Let s=sin(x), c=cos(x), + * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then + * + * n sin(xn)*sqt2 cos(xn)*sqt2 + * ---------------------------------- + * 0 s-c c+s + * 1 -s-c -c+s + * 2 -s+c -c-s + * 3 s+c c-s + */ + long double s; + long double c; + __sincosl (x, &s, &c); + switch (n & 3) + { + case 0: + temp = c + s; + break; + case 1: + temp = -c + s; + break; + case 2: + temp = -c - s; + break; + case 3: + temp = c - s; + break; + } + b = invsqrtpi * temp / __ieee754_sqrtl (x); + } + else + { + a = __ieee754_j0l (x); + b = __ieee754_j1l (x); + for (i = 1; i < n; i++) + { + temp = b; + b = b * ((long double) (i + i) / x) - a; /* avoid underflow */ + a = temp; + } + } + } + else + { + if (ix < 0x3fde) + { /* x < 2**-33 */ + /* x is tiny, return the first Taylor expansion of J(n,x) + * J(n,x) = 1/n!*(x/2)^n - ... + */ + if (n >= 400) /* underflow, result < 10^-4952 */ + b = zero; + else + { + temp = x * 0.5; + b = temp; + for (a = one, i = 2; i <= n; i++) + { + a *= (long double) i; /* a = n! */ + b *= temp; /* b = (x/2)^n */ + } + b = b / a; + } + } + else + { + /* use backward recurrence */ + /* x x^2 x^2 + * J(n,x)/J(n-1,x) = ---- ------ ------ ..... + * 2n - 2(n+1) - 2(n+2) + * + * 1 1 1 + * (for large x) = ---- ------ ------ ..... + * 2n 2(n+1) 2(n+2) + * -- - ------ - ------ - + * x x x + * + * Let w = 2n/x and h=2/x, then the above quotient + * is equal to the continued fraction: + * 1 + * = ----------------------- + * 1 + * w - ----------------- + * 1 + * w+h - --------- + * w+2h - ... + * + * To determine how many terms needed, let + * Q(0) = w, Q(1) = w(w+h) - 1, + * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), + * When Q(k) > 1e4 good for single + * When Q(k) > 1e9 good for double + * When Q(k) > 1e17 good for quadruple + */ + /* determine k */ + long double t, v; + long double q0, q1, h, tmp; + int32_t k, m; + w = (n + n) / (long double) x; + h = 2.0L / (long double) x; + q0 = w; + z = w + h; + q1 = w * z - 1.0L; + k = 1; + while (q1 < 1.0e11L) + { + k += 1; + z += h; + tmp = z * q1 - q0; + q0 = q1; + q1 = tmp; + } + m = n + n; + for (t = zero, i = 2 * (n + k); i >= m; i -= 2) + t = one / (i / x - t); + a = t; + b = one; + /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) + * Hence, if n*(log(2n/x)) > ... + * single 8.8722839355e+01 + * double 7.09782712893383973096e+02 + * long double 1.1356523406294143949491931077970765006170e+04 + * then recurrent value may overflow and the result is + * likely underflow to zero + */ + tmp = n; + v = two / x; + tmp = tmp * __ieee754_logl (fabsl (v * tmp)); + + if (tmp < 1.1356523406294143949491931077970765006170e+04L) + { + for (i = n - 1, di = (long double) (i + i); i > 0; i--) + { + temp = b; + b *= di; + b = b / x - a; + a = temp; + di -= two; + } + } + else + { + for (i = n - 1, di = (long double) (i + i); i > 0; i--) + { + temp = b; + b *= di; + b = b / x - a; + a = temp; + di -= two; + /* scale b to avoid spurious overflow */ + if (b > 1e100L) + { + a /= b; + t /= b; + b = one; + } + } + } + /* j0() and j1() suffer enormous loss of precision at and + * near zero; however, we know that their zero points never + * coincide, so just choose the one further away from zero. + */ + z = __ieee754_j0l (x); + w = __ieee754_j1l (x); + if (fabsl (z) >= fabsl (w)) + b = (t * z / b); + else + b = (t * w / a); + } + } + if (sgn == 1) + ret = -b; + else + ret = b; + } + if (ret == 0) + { + ret = __copysignl (LDBL_MIN, ret) * LDBL_MIN; + __set_errno (ERANGE); + } + else + math_check_force_underflow (ret); + return ret; +} +strong_alias (__ieee754_jnl, __jnl_finite) + +long double +__ieee754_ynl (int n, long double x) +{ + u_int32_t se, i0, i1; + int32_t i, ix; + int32_t sign; + long double a, b, temp, ret; + + + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + /* if Y(n,NaN) is NaN */ + if (__builtin_expect ((ix == 0x7fff) && ((i0 & 0x7fffffff) != 0), 0)) + return x + x; + if (__builtin_expect ((ix | i0 | i1) == 0, 0)) + /* -inf or inf and divide-by-zero exception. */ + return ((n < 0 && (n & 1) != 0) ? 1.0L : -1.0L) / 0.0L; + if (__builtin_expect (se & 0x8000, 0)) + return zero / (zero * x); + sign = 1; + if (n < 0) + { + n = -n; + sign = 1 - ((n & 1) << 1); + } + if (n == 0) + return (__ieee754_y0l (x)); + { + SET_RESTORE_ROUNDL (FE_TONEAREST); + if (n == 1) + { + ret = sign * __ieee754_y1l (x); + goto out; + } + if (__glibc_unlikely (ix == 0x7fff)) + return zero; + if (ix >= 0x412D) + { /* x > 2**302 */ + + /* ??? See comment above on the possible futility of this. */ + + /* (x >> n**2) + * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Let s=sin(x), c=cos(x), + * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then + * + * n sin(xn)*sqt2 cos(xn)*sqt2 + * ---------------------------------- + * 0 s-c c+s + * 1 -s-c -c+s + * 2 -s+c -c-s + * 3 s+c c-s + */ + long double s; + long double c; + __sincosl (x, &s, &c); + switch (n & 3) + { + case 0: + temp = s - c; + break; + case 1: + temp = -s - c; + break; + case 2: + temp = -s + c; + break; + case 3: + temp = s + c; + break; + } + b = invsqrtpi * temp / __ieee754_sqrtl (x); + } + else + { + a = __ieee754_y0l (x); + b = __ieee754_y1l (x); + /* quit if b is -inf */ + GET_LDOUBLE_WORDS (se, i0, i1, b); + /* Use 0xffffffff since GET_LDOUBLE_WORDS sign-extends SE. */ + for (i = 1; i < n && se != 0xffffffff; i++) + { + temp = b; + b = ((long double) (i + i) / x) * b - a; + GET_LDOUBLE_WORDS (se, i0, i1, b); + a = temp; + } + } + /* If B is +-Inf, set up errno accordingly. */ + if (! isfinite (b)) + __set_errno (ERANGE); + if (sign > 0) + ret = b; + else + ret = -b; + } + out: + if (isinf (ret)) + ret = __copysignl (LDBL_MAX, ret) * LDBL_MAX; + return ret; +} +strong_alias (__ieee754_ynl, __ynl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_lgammal_r.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_lgammal_r.c new file mode 100644 index 0000000000..4ecd63045f --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_lgammal_r.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. + * ==================================================== + */ + +/* Long double expansions are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* __ieee754_lgammal_r(x, signgamp) + * Reentrant version of the logarithm of the Gamma function + * with user provide pointer for the sign of Gamma(x). + * + * Method: + * 1. Argument Reduction for 0 < x <= 8 + * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may + * reduce x to a number in [1.5,2.5] by + * lgamma(1+s) = log(s) + lgamma(s) + * for example, + * lgamma(7.3) = log(6.3) + lgamma(6.3) + * = log(6.3*5.3) + lgamma(5.3) + * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3) + * 2. Polynomial approximation of lgamma around its + * minimun ymin=1.461632144968362245 to maintain monotonicity. + * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use + * Let z = x-ymin; + * lgamma(x) = -1.214862905358496078218 + z^2*poly(z) + * 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> +#include <libc-diag.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 +__ieee754_lgammal_r (long double x, int *signgamp) +{ + long double t, y, z, nadj, p, p1, p2, q, r, w; + int i, ix; + u_int32_t se, i0, i1; + + *signgamp = 1; + GET_LDOUBLE_WORDS (se, i0, i1, x); + ix = se & 0x7fff; + + if (__builtin_expect((ix | i0 | i1) == 0, 0)) + { + if (se & 0x8000) + *signgamp = -1; + return one / fabsl (x); + } + + ix = (ix << 16) | (i0 >> 16); + + /* purge off +-inf, NaN, +-0, and negative arguments */ + if (__builtin_expect(ix >= 0x7fff0000, 0)) + return x * x; + + if (__builtin_expect(ix < 0x3fc08000, 0)) /* 2^-63 */ + { /* |x|<2**-63, return -log(|x|) */ + if (se & 0x8000) + { + *signgamp = -1; + return -__ieee754_logl (-x); + } + else + return -__ieee754_logl (x); + } + if (se & 0x8000) + { + if (x < -2.0L && x > -33.0L) + return __lgamma_negl (x, signgamp); + t = sin_pi (x); + if (t == zero) + return one / fabsl (t); /* -integer */ + nadj = __ieee754_logl (pi / fabsl (t * x)); + if (t < zero) + *signgamp = -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 = -__ieee754_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 += __ieee754_logl (z); + break; + } + } + else if (ix < 0x40418000) /* 2^66 */ + { + /* 8.0 <= x < 2**66 */ + t = __ieee754_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 * (__ieee754_logl (x) - one); + /* NADJ is set for negative arguments but not otherwise, resulting + in warnings that it may be used uninitialized although in the + cases where it is used it has always been set. */ + DIAG_PUSH_NEEDS_COMMENT; + DIAG_IGNORE_NEEDS_COMMENT (4.9, "-Wmaybe-uninitialized"); + if (se & 0x8000) + r = nadj - r; + DIAG_POP_NEEDS_COMMENT; + return r; +} +strong_alias (__ieee754_lgammal_r, __lgammal_r_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_rem_pio2l.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_rem_pio2l.c new file mode 100644 index 0000000000..43c5d91f0b --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_rem_pio2l.c @@ -0,0 +1,236 @@ +/* Extended-precision floating point argument reduction. + Copyright (C) 1999-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Based on quad-precision code by Jakub Jelinek <jj@ultra.linux.cz> + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> + +/* Table of constants for 2/pi, 5628 hexadecimal digits of 2/pi. */ +static const int32_t two_over_pi[] = { +0xa2f983, 0x6e4e44, 0x1529fc, 0x2757d1, 0xf534dd, 0xc0db62, +0x95993c, 0x439041, 0xfe5163, 0xabdebb, 0xc561b7, 0x246e3a, +0x424dd2, 0xe00649, 0x2eea09, 0xd1921c, 0xfe1deb, 0x1cb129, +0xa73ee8, 0x8235f5, 0x2ebb44, 0x84e99c, 0x7026b4, 0x5f7e41, +0x3991d6, 0x398353, 0x39f49c, 0x845f8b, 0xbdf928, 0x3b1ff8, +0x97ffde, 0x05980f, 0xef2f11, 0x8b5a0a, 0x6d1f6d, 0x367ecf, +0x27cb09, 0xb74f46, 0x3f669e, 0x5fea2d, 0x7527ba, 0xc7ebe5, +0xf17b3d, 0x0739f7, 0x8a5292, 0xea6bfb, 0x5fb11f, 0x8d5d08, +0x560330, 0x46fc7b, 0x6babf0, 0xcfbc20, 0x9af436, 0x1da9e3, +0x91615e, 0xe61b08, 0x659985, 0x5f14a0, 0x68408d, 0xffd880, +0x4d7327, 0x310606, 0x1556ca, 0x73a8c9, 0x60e27b, 0xc08c6b, +0x47c419, 0xc367cd, 0xdce809, 0x2a8359, 0xc4768b, 0x961ca6, +0xddaf44, 0xd15719, 0x053ea5, 0xff0705, 0x3f7e33, 0xe832c2, +0xde4f98, 0x327dbb, 0xc33d26, 0xef6b1e, 0x5ef89f, 0x3a1f35, +0xcaf27f, 0x1d87f1, 0x21907c, 0x7c246a, 0xfa6ed5, 0x772d30, +0x433b15, 0xc614b5, 0x9d19c3, 0xc2c4ad, 0x414d2c, 0x5d000c, +0x467d86, 0x2d71e3, 0x9ac69b, 0x006233, 0x7cd2b4, 0x97a7b4, +0xd55537, 0xf63ed7, 0x1810a3, 0xfc764d, 0x2a9d64, 0xabd770, +0xf87c63, 0x57b07a, 0xe71517, 0x5649c0, 0xd9d63b, 0x3884a7, +0xcb2324, 0x778ad6, 0x23545a, 0xb91f00, 0x1b0af1, 0xdfce19, +0xff319f, 0x6a1e66, 0x615799, 0x47fbac, 0xd87f7e, 0xb76522, +0x89e832, 0x60bfe6, 0xcdc4ef, 0x09366c, 0xd43f5d, 0xd7de16, +0xde3b58, 0x929bde, 0x2822d2, 0xe88628, 0x4d58e2, 0x32cac6, +0x16e308, 0xcb7de0, 0x50c017, 0xa71df3, 0x5be018, 0x34132e, +0x621283, 0x014883, 0x5b8ef5, 0x7fb0ad, 0xf2e91e, 0x434a48, +0xd36710, 0xd8ddaa, 0x425fae, 0xce616a, 0xa4280a, 0xb499d3, +0xf2a606, 0x7f775c, 0x83c2a3, 0x883c61, 0x78738a, 0x5a8caf, +0xbdd76f, 0x63a62d, 0xcbbff4, 0xef818d, 0x67c126, 0x45ca55, +0x36d9ca, 0xd2a828, 0x8d61c2, 0x77c912, 0x142604, 0x9b4612, +0xc459c4, 0x44c5c8, 0x91b24d, 0xf31700, 0xad43d4, 0xe54929, +0x10d5fd, 0xfcbe00, 0xcc941e, 0xeece70, 0xf53e13, 0x80f1ec, +0xc3e7b3, 0x28f8c7, 0x940593, 0x3e71c1, 0xb3092e, 0xf3450b, +0x9c1288, 0x7b20ab, 0x9fb52e, 0xc29247, 0x2f327b, 0x6d550c, +0x90a772, 0x1fe76b, 0x96cb31, 0x4a1679, 0xe27941, 0x89dff4, +0x9794e8, 0x84e6e2, 0x973199, 0x6bed88, 0x365f5f, 0x0efdbb, +0xb49a48, 0x6ca467, 0x427271, 0x325d8d, 0xb8159f, 0x09e5bc, +0x25318d, 0x3974f7, 0x1c0530, 0x010c0d, 0x68084b, 0x58ee2c, +0x90aa47, 0x02e774, 0x24d6bd, 0xa67df7, 0x72486e, 0xef169f, +0xa6948e, 0xf691b4, 0x5153d1, 0xf20acf, 0x339820, 0x7e4bf5, +0x6863b2, 0x5f3edd, 0x035d40, 0x7f8985, 0x295255, 0xc06437, +0x10d86d, 0x324832, 0x754c5b, 0xd4714e, 0x6e5445, 0xc1090b, +0x69f52a, 0xd56614, 0x9d0727, 0x50045d, 0xdb3bb4, 0xc576ea, +0x17f987, 0x7d6b49, 0xba271d, 0x296996, 0xacccc6, 0x5414ad, +0x6ae290, 0x89d988, 0x50722c, 0xbea404, 0x940777, 0x7030f3, +0x27fc00, 0xa871ea, 0x49c266, 0x3de064, 0x83dd97, 0x973fa3, +0xfd9443, 0x8c860d, 0xde4131, 0x9d3992, 0x8c70dd, 0xe7b717, +0x3bdf08, 0x2b3715, 0xa0805c, 0x93805a, 0x921110, 0xd8e80f, +0xaf806c, 0x4bffdb, 0x0f9038, 0x761859, 0x15a562, 0xbbcb61, +0xb989c7, 0xbd4010, 0x04f2d2, 0x277549, 0xf6b6eb, 0xbb22db, +0xaa140a, 0x2f2689, 0x768364, 0x333b09, 0x1a940e, 0xaa3a51, +0xc2a31d, 0xaeedaf, 0x12265c, 0x4dc26d, 0x9c7a2d, 0x9756c0, +0x833f03, 0xf6f009, 0x8c402b, 0x99316d, 0x07b439, 0x15200c, +0x5bc3d8, 0xc492f5, 0x4badc6, 0xa5ca4e, 0xcd37a7, 0x36a9e6, +0x9492ab, 0x6842dd, 0xde6319, 0xef8c76, 0x528b68, 0x37dbfc, +0xaba1ae, 0x3115df, 0xa1ae00, 0xdafb0c, 0x664d64, 0xb705ed, +0x306529, 0xbf5657, 0x3aff47, 0xb9f96a, 0xf3be75, 0xdf9328, +0x3080ab, 0xf68c66, 0x15cb04, 0x0622fa, 0x1de4d9, 0xa4b33d, +0x8f1b57, 0x09cd36, 0xe9424e, 0xa4be13, 0xb52333, 0x1aaaf0, +0xa8654f, 0xa5c1d2, 0x0f3f0b, 0xcd785b, 0x76f923, 0x048b7b, +0x721789, 0x53a6c6, 0xe26e6f, 0x00ebef, 0x584a9b, 0xb7dac4, +0xba66aa, 0xcfcf76, 0x1d02d1, 0x2df1b1, 0xc1998c, 0x77adc3, +0xda4886, 0xa05df7, 0xf480c6, 0x2ff0ac, 0x9aecdd, 0xbc5c3f, +0x6dded0, 0x1fc790, 0xb6db2a, 0x3a25a3, 0x9aaf00, 0x9353ad, +0x0457b6, 0xb42d29, 0x7e804b, 0xa707da, 0x0eaa76, 0xa1597b, +0x2a1216, 0x2db7dc, 0xfde5fa, 0xfedb89, 0xfdbe89, 0x6c76e4, +0xfca906, 0x70803e, 0x156e85, 0xff87fd, 0x073e28, 0x336761, +0x86182a, 0xeabd4d, 0xafe7b3, 0x6e6d8f, 0x396795, 0x5bbf31, +0x48d784, 0x16df30, 0x432dc7, 0x356125, 0xce70c9, 0xb8cb30, +0xfd6cbf, 0xa200a4, 0xe46c05, 0xa0dd5a, 0x476f21, 0xd21262, +0x845cb9, 0x496170, 0xe0566b, 0x015299, 0x375550, 0xb7d51e, +0xc4f133, 0x5f6e13, 0xe4305d, 0xa92e85, 0xc3b21d, 0x3632a1, +0xa4b708, 0xd4b1ea, 0x21f716, 0xe4698f, 0x77ff27, 0x80030c, +0x2d408d, 0xa0cd4f, 0x99a520, 0xd3a2b3, 0x0a5d2f, 0x42f9b4, +0xcbda11, 0xd0be7d, 0xc1db9b, 0xbd17ab, 0x81a2ca, 0x5c6a08, +0x17552e, 0x550027, 0xf0147f, 0x8607e1, 0x640b14, 0x8d4196, +0xdebe87, 0x2afdda, 0xb6256b, 0x34897b, 0xfef305, 0x9ebfb9, +0x4f6a68, 0xa82a4a, 0x5ac44f, 0xbcf82d, 0x985ad7, 0x95c7f4, +0x8d4d0d, 0xa63a20, 0x5f57a4, 0xb13f14, 0x953880, 0x0120cc, +0x86dd71, 0xb6dec9, 0xf560bf, 0x11654d, 0x6b0701, 0xacb08c, +0xd0c0b2, 0x485551, 0x0efb1e, 0xc37295, 0x3b06a3, 0x3540c0, +0x7bdc06, 0xcc45e0, 0xfa294e, 0xc8cad6, 0x41f3e8, 0xde647c, +0xd8649b, 0x31bed9, 0xc397a4, 0xd45877, 0xc5e369, 0x13daf0, +0x3c3aba, 0x461846, 0x5f7555, 0xf5bdd2, 0xc6926e, 0x5d2eac, +0xed440e, 0x423e1c, 0x87c461, 0xe9fd29, 0xf3d6e7, 0xca7c22, +0x35916f, 0xc5e008, 0x8dd7ff, 0xe26a6e, 0xc6fdb0, 0xc10893, +0x745d7c, 0xb2ad6b, 0x9d6ecd, 0x7b723e, 0x6a11c6, 0xa9cff7, +0xdf7329, 0xbac9b5, 0x5100b7, 0x0db2e2, 0x24ba74, 0x607de5, +0x8ad874, 0x2c150d, 0x0c1881, 0x94667e, 0x162901, 0x767a9f, +0xbefdfd, 0xef4556, 0x367ed9, 0x13d9ec, 0xb9ba8b, 0xfc97c4, +0x27a831, 0xc36ef1, 0x36c594, 0x56a8d8, 0xb5a8b4, 0x0ecccf, +0x2d8912, 0x34576f, 0x89562c, 0xe3ce99, 0xb920d6, 0xaa5e6b, +0x9c2a3e, 0xcc5f11, 0x4a0bfd, 0xfbf4e1, 0x6d3b8e, 0x2c86e2, +0x84d4e9, 0xa9b4fc, 0xd1eeef, 0xc9352e, 0x61392f, 0x442138, +0xc8d91b, 0x0afc81, 0x6a4afb, 0xd81c2f, 0x84b453, 0x8c994e, +0xcc2254, 0xdc552a, 0xd6c6c0, 0x96190b, 0xb8701a, 0x649569, +0x605a26, 0xee523f, 0x0f117f, 0x11b5f4, 0xf5cbfc, 0x2dbc34, +0xeebc34, 0xcc5de8, 0x605edd, 0x9b8e67, 0xef3392, 0xb817c9, +0x9b5861, 0xbc57e1, 0xc68351, 0x103ed8, 0x4871dd, 0xdd1c2d, +0xa118af, 0x462c21, 0xd7f359, 0x987ad9, 0xc0549e, 0xfa864f, +0xfc0656, 0xae79e5, 0x362289, 0x22ad38, 0xdc9367, 0xaae855, +0x382682, 0x9be7ca, 0xa40d51, 0xb13399, 0x0ed7a9, 0x480569, +0xf0b265, 0xa7887f, 0x974c88, 0x36d1f9, 0xb39221, 0x4a827b, +0x21cf98, 0xdc9f40, 0x5547dc, 0x3a74e1, 0x42eb67, 0xdf9dfe, +0x5fd45e, 0xa4677b, 0x7aacba, 0xa2f655, 0x23882b, 0x55ba41, +0x086e59, 0x862a21, 0x834739, 0xe6e389, 0xd49ee5, 0x40fb49, +0xe956ff, 0xca0f1c, 0x8a59c5, 0x2bfa94, 0xc5c1d3, 0xcfc50f, +0xae5adb, 0x86c547, 0x624385, 0x3b8621, 0x94792c, 0x876110, +0x7b4c2a, 0x1a2c80, 0x12bf43, 0x902688, 0x893c78, 0xe4c4a8, +0x7bdbe5, 0xc23ac4, 0xeaf426, 0x8a67f7, 0xbf920d, 0x2ba365, +0xb1933d, 0x0b7cbd, 0xdc51a4, 0x63dd27, 0xdde169, 0x19949a, +0x9529a8, 0x28ce68, 0xb4ed09, 0x209f44, 0xca984e, 0x638270, +0x237c7e, 0x32b90f, 0x8ef5a7, 0xe75614, 0x08f121, 0x2a9db5, +0x4d7e6f, 0x5119a5, 0xabf9b5, 0xd6df82, 0x61dd96, 0x023616, +0x9f3ac4, 0xa1a283, 0x6ded72, 0x7a8d39, 0xa9b882, 0x5c326b, +0x5b2746, 0xed3400, 0x7700d2, 0x55f4fc, 0x4d5901, 0x8071e0, +0xe13f89, 0xb295f3, 0x64a8f1, 0xaea74b, 0x38fc4c, 0xeab2bb, +0x47270b, 0xabc3a7, 0x34ba60, 0x52dd34, 0xf8563a, 0xeb7e8a, +0x31bb36, 0x5895b7, 0x47f7a9, 0x94c3aa, 0xd39225, 0x1e7f3e, +0xd8974e, 0xbba94f, 0xd8ae01, 0xe661b4, 0x393d8e, 0xa523aa, +0x33068e, 0x1633b5, 0x3bb188, 0x1d3a9d, 0x4013d0, 0xcc1be5, +0xf862e7, 0x3bf28f, 0x39b5bf, 0x0bc235, 0x22747e, 0xa247c0, +0xd52d1f, 0x19add3, 0x9094df, 0x9311d0, 0xb42b25, 0x496db2, +0xe264b2, 0x5ef135, 0x3bc6a4, 0x1a4ad0, 0xaac92e, 0x64e886, +0x573091, 0x982cfb, 0x311b1a, 0x08728b, 0xbdcee1, 0x60e142, +0xeb641d, 0xd0bba3, 0xe559d4, 0x597b8c, 0x2a4483, 0xf332ba, +0xf84867, 0x2c8d1b, 0x2fa9b0, 0x50f3dd, 0xf9f573, 0xdb61b4, +0xfe233e, 0x6c41a6, 0xeea318, 0x775a26, 0xbc5e5c, 0xcea708, +0x94dc57, 0xe20196, 0xf1e839, 0xbe4851, 0x5d2d2f, 0x4e9555, +0xd96ec2, 0xe7d755, 0x6304e0, 0xc02e0e, 0xfc40a0, 0xbbf9b3, +0x7125a7, 0x222dfb, 0xf619d8, 0x838c1c, 0x6619e6, 0xb20d55, +0xbb5137, 0x79e809, 0xaf9149, 0x0d73de, 0x0b0da5, 0xce7f58, +0xac1934, 0x724667, 0x7a1a13, 0x9e26bc, 0x4555e7, 0x585cb5, +0x711d14, 0x486991, 0x480d60, 0x56adab, 0xd62f64, 0x96ee0c, +0x212ff3, 0x5d6d88, 0xa67684, 0x95651e, 0xab9e0a, 0x4ddefe, +0x571010, 0x836a39, 0xf8ea31, 0x9e381d, 0xeac8b1, 0xcac96b, +0x37f21e, 0xd505e9, 0x984743, 0x9fc56c, 0x0331b7, 0x3b8bf8, +0x86e56a, 0x8dc343, 0x6230e7, 0x93cfd5, 0x6a8f2d, 0x733005, +0x1af021, 0xa09fcb, 0x7415a1, 0xd56b23, 0x6ff725, 0x2f4bc7, +0xb8a591, 0x7fac59, 0x5c55de, 0x212c38, 0xb13296, 0x5cff50, +0x366262, 0xfa7b16, 0xf4d9a6, 0x2acfe7, 0xf07403, 0xd4d604, +0x6fd916, 0x31b1bf, 0xcbb450, 0x5bd7c8, 0x0ce194, 0x6bd643, +0x4fd91c, 0xdf4543, 0x5f3453, 0xe2b5aa, 0xc9aec8, 0x131485, +0xf9d2bf, 0xbadb9e, 0x76f5b9, 0xaf15cf, 0xca3182, 0x14b56d, +0xe9fe4d, 0x50fc35, 0xf5aed5, 0xa2d0c1, 0xc96057, 0x192eb6, +0xe91d92, 0x07d144, 0xaea3c6, 0x343566, 0x26d5b4, 0x3161e2, +0x37f1a2, 0x209eff, 0x958e23, 0x493798, 0x35f4a6, 0x4bdc02, +0xc2be13, 0xbe80a0, 0x0b72a3, 0x115c5f, 0x1e1bd1, 0x0db4d3, +0x869e85, 0x96976b, 0x2ac91f, 0x8a26c2, 0x3070f0, 0x041412, +0xfc9fa5, 0xf72a38, 0x9c6878, 0xe2aa76, 0x50cfe1, 0x559274, +0x934e38, 0x0a92f7, 0x5533f0, 0xa63db4, 0x399971, 0xe2b755, +0xa98a7c, 0x008f19, 0xac54d2, 0x2ea0b4, 0xf5f3e0, 0x60c849, +0xffd269, 0xae52ce, 0x7a5fdd, 0xe9ce06, 0xfb0ae8, 0xa50cce, +0xea9d3e, 0x3766dd, 0xb834f5, 0x0da090, 0x846f88, 0x4ae3d5, +0x099a03, 0x2eae2d, 0xfcb40a, 0xfb9b33, 0xe281dd, 0x1b16ba, +0xd8c0af, 0xd96b97, 0xb52dc9, 0x9c277f, 0x5951d5, 0x21ccd6, +0xb6496b, 0x584562, 0xb3baf2, 0xa1a5c4, 0x7ca2cf, 0xa9b93d, +0x7b7b89, 0x483d38, +}; + +int32_t +__ieee754_rem_pio2l (long double x, long double *y) +{ + double tx[3], ty[3]; + int32_t se, j0; + u_int32_t i0, i1; + int sx; + int n, exp; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + sx = (se >> 15) & 1; + j0 = (se & 0x7fff) - 0x3fff; + + if (j0 < -1) + { + /* |x| < pi/4. */ + y[0] = x; + y[1] = 0; + return 0; + } + + if (j0 >= 0x8000) + { + /* x is infinite or NaN. */ + y[0] = x - x; + y[1] = y[0]; + return 0; + } + + /* Split the 64 bits of the mantissa into three 24-bit integers + stored in a double array. */ + exp = j0 - 23; + tx[0] = (double) (i0 >> 8); + tx[1] = (double) (((i0 << 16) | (i1 >> 16)) & 0xffffff); + tx[2] = (double) ((i1 << 8) & 0xffffff); + + n = __kernel_rem_pio2 (tx, ty, exp, 3, 2, two_over_pi); + + /* The result is now stored in two double values, we need to convert + it into two long double values. */ + if (sx == 0) + { + y[0] = (long double) ty[0] + (long double) ty[1]; + y[1] = ty[1] - (y[0] - ty[0]); + return n; + } + else + { + y[0] = -((long double) ty[0] + (long double) ty[1]); + y[1] = -ty[1] - (y[0] + ty[0]); + return -n; + } +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/e_sinhl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_sinhl.c new file mode 100644 index 0000000000..095b142621 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/e_sinhl.c @@ -0,0 +1,87 @@ +/* e_asinhl.c -- long double version of e_asinh.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* __ieee754_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 <float.h> +#include <math.h> +#include <math_private.h> + +static const long double one = 1.0, shuge = 1.0e4931L; + +long double +__ieee754_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(__builtin_expect(ix==0x7fff, 0)) 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 */ + math_check_force_underflow (x); + 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*__ieee754_expl(fabsl(x)); + + /* |x| in [log(maxdouble), overflowthreshold] */ + if (ix<0x400c || (ix == 0x400c && (i0 < 0xb174ddc0 + || (i0 == 0xb174ddc0 + && i1 <= 0x31aec0ea)))) { + w = __ieee754_expl(0.5*fabsl(x)); + t = h*w; + return t*w; + } + + /* |x| > overflowthreshold, sinhl(x) overflow */ + return x*shuge; +} +strong_alias (__ieee754_sinhl, __sinhl_finite) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/gamma_product.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/gamma_product.c new file mode 100644 index 0000000000..31931bbd17 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/gamma_product.c @@ -0,0 +1,43 @@ +/* Compute a product of X, X+1, ..., with an error estimate. + Copyright (C) 2013-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <float.h> + +/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N + - 1, in the form R * (1 + *EPS) where the return value R is an + approximation to the product and *EPS is set to indicate the + approximate error in the return value. X is such that all the + values X + 1, ..., X + N - 1 are exactly representable, and X_EPS / + X is small enough that factors quadratic in it can be + neglected. */ + +double +__gamma_product (double x, double x_eps, int n, double *eps) +{ + long double x_full = (long double) x + (long double) x_eps; + long double ret = x_full; + for (int i = 1; i < n; i++) + ret *= x_full + i; + + double fret = math_narrow_eval ((double) ret); + *eps = (ret - fret) / fret; + + return fret; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/gamma_productl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/gamma_productl.c new file mode 100644 index 0000000000..0f1ccc4a2d --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/gamma_productl.c @@ -0,0 +1,45 @@ +/* Compute a product of X, X+1, ..., with an error estimate. + Copyright (C) 2013-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <mul_splitl.h> + +/* Compute the product of X + X_EPS, X + X_EPS + 1, ..., X + X_EPS + N + - 1, in the form R * (1 + *EPS) where the return value R is an + approximation to the product and *EPS is set to indicate the + approximate error in the return value. X is such that all the + values X + 1, ..., X + N - 1 are exactly representable, and X_EPS / + X is small enough that factors quadratic in it can be + neglected. */ + +long double +__gamma_productl (long double x, long double x_eps, int n, long double *eps) +{ + SET_RESTORE_ROUNDL (FE_TONEAREST); + long double ret = x; + *eps = x_eps / x; + for (int i = 1; i < n; i++) + { + *eps += x_eps / (x + i); + long double lo; + mul_splitl (&ret, &lo, ret, x + i); + *eps += lo / ret; + } + return ret; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/include/bits/iscanonical.h b/REORG.TODO/sysdeps/ieee754/ldbl-96/include/bits/iscanonical.h new file mode 100644 index 0000000000..bee080bd29 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/include/bits/iscanonical.h @@ -0,0 +1,5 @@ +#include_next <bits/iscanonical.h> + +#ifndef _ISOMAC +libm_hidden_proto (__iscanonicall) +#endif diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/k_cosl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/k_cosl.c new file mode 100644 index 0000000000..8e3cd49f81 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/k_cosl.c @@ -0,0 +1,123 @@ +/* Extended-precision floating point cosine on <-pi/4,pi/4>. + Copyright (C) 1999-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Based on quad-precision cosine by Jakub Jelinek <jj@ultra.linux.cz> + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> + +/* The polynomials have not been optimized for extended-precision and + may contain more terms than needed. */ + +static const long double c[] = { +#define ONE c[0] + 1.00000000000000000000000000000000000E+00L, + +/* cos x ~ ONE + x^2 ( SCOS1 + SCOS2 * x^2 + ... + SCOS4 * x^6 + SCOS5 * x^8 ) + x in <0,1/256> */ +#define SCOS1 c[1] +#define SCOS2 c[2] +#define SCOS3 c[3] +#define SCOS4 c[4] +#define SCOS5 c[5] +-5.00000000000000000000000000000000000E-01L, + 4.16666666666666666666666666556146073E-02L, +-1.38888888888888888888309442601939728E-03L, + 2.48015873015862382987049502531095061E-05L, +-2.75573112601362126593516899592158083E-07L, + +/* cos x ~ ONE + x^2 ( COS1 + COS2 * x^2 + ... + COS7 * x^12 + COS8 * x^14 ) + x in <0,0.1484375> */ +#define COS1 c[6] +#define COS2 c[7] +#define COS3 c[8] +#define COS4 c[9] +#define COS5 c[10] +#define COS6 c[11] +#define COS7 c[12] +#define COS8 c[13] +-4.99999999999999999999999999999999759E-01L, + 4.16666666666666666666666666651287795E-02L, +-1.38888888888888888888888742314300284E-03L, + 2.48015873015873015867694002851118210E-05L, +-2.75573192239858811636614709689300351E-07L, + 2.08767569877762248667431926878073669E-09L, +-1.14707451049343817400420280514614892E-11L, + 4.77810092804389587579843296923533297E-14L, + +/* sin x ~ ONE * x + x^3 ( SSIN1 + SSIN2 * x^2 + ... + SSIN4 * x^6 + SSIN5 * x^8 ) + x in <0,1/256> */ +#define SSIN1 c[14] +#define SSIN2 c[15] +#define SSIN3 c[16] +#define SSIN4 c[17] +#define SSIN5 c[18] +-1.66666666666666666666666666666666659E-01L, + 8.33333333333333333333333333146298442E-03L, +-1.98412698412698412697726277416810661E-04L, + 2.75573192239848624174178393552189149E-06L, +-2.50521016467996193495359189395805639E-08L, +}; + +#define SINCOSL_COS_HI 0 +#define SINCOSL_COS_LO 1 +#define SINCOSL_SIN_HI 2 +#define SINCOSL_SIN_LO 3 +extern const long double __sincosl_table[]; + +long double +__kernel_cosl(long double x, long double y) +{ + long double h, l, z, sin_l, cos_l_m1; + int index; + + if (signbit (x)) + { + x = -x; + y = -y; + } + if (x < 0.1484375L) + { + /* Argument is small enough to approximate it by a Chebyshev + polynomial of degree 16. */ + if (x < 0x1p-33L) + if (!((int)x)) return ONE; /* generate inexact */ + z = x * x; + return ONE + (z*(COS1+z*(COS2+z*(COS3+z*(COS4+ + z*(COS5+z*(COS6+z*(COS7+z*COS8)))))))); + } + else + { + /* So that we don't have to use too large polynomial, we find + l and h such that x = l + h, where fabsl(l) <= 1.0/256 with 83 + possible values for h. We look up cosl(h) and sinl(h) in + pre-computed tables, compute cosl(l) and sinl(l) using a + Chebyshev polynomial of degree 10(11) and compute + cosl(h+l) = cosl(h)cosl(l) - sinl(h)sinl(l). */ + index = (int) (128 * (x - (0.1484375L - 1.0L / 256.0L))); + h = 0.1484375L + index / 128.0; + index *= 4; + l = y - (h - x); + z = l * l; + sin_l = l*(ONE+z*(SSIN1+z*(SSIN2+z*(SSIN3+z*(SSIN4+z*SSIN5))))); + cos_l_m1 = z*(SCOS1+z*(SCOS2+z*(SCOS3+z*(SCOS4+z*SCOS5)))); + return __sincosl_table [index + SINCOSL_COS_HI] + + (__sincosl_table [index + SINCOSL_COS_LO] + - (__sincosl_table [index + SINCOSL_SIN_HI] * sin_l + - __sincosl_table [index + SINCOSL_COS_HI] * cos_l_m1)); + } +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/k_sinl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/k_sinl.c new file mode 100644 index 0000000000..d56023aa8d --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/k_sinl.c @@ -0,0 +1,130 @@ +/* Quad-precision floating point sine on <-pi/4,pi/4>. + Copyright (C) 1999-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Based on quad-precision sine by Jakub Jelinek <jj@ultra.linux.cz> + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* The polynomials have not been optimized for extended-precision and + may contain more terms than needed. */ + +#include <float.h> +#include <math.h> +#include <math_private.h> + +/* The polynomials have not been optimized for extended-precision and + may contain more terms than needed. */ + +static const long double c[] = { +#define ONE c[0] + 1.00000000000000000000000000000000000E+00L, + +/* cos x ~ ONE + x^2 ( SCOS1 + SCOS2 * x^2 + ... + SCOS4 * x^6 + SCOS5 * x^8 ) + x in <0,1/256> */ +#define SCOS1 c[1] +#define SCOS2 c[2] +#define SCOS3 c[3] +#define SCOS4 c[4] +#define SCOS5 c[5] +-5.00000000000000000000000000000000000E-01L, + 4.16666666666666666666666666556146073E-02L, +-1.38888888888888888888309442601939728E-03L, + 2.48015873015862382987049502531095061E-05L, +-2.75573112601362126593516899592158083E-07L, + +/* sin x ~ ONE * x + x^3 ( SIN1 + SIN2 * x^2 + ... + SIN7 * x^12 + SIN8 * x^14 ) + x in <0,0.1484375> */ +#define SIN1 c[6] +#define SIN2 c[7] +#define SIN3 c[8] +#define SIN4 c[9] +#define SIN5 c[10] +#define SIN6 c[11] +#define SIN7 c[12] +#define SIN8 c[13] +-1.66666666666666666666666666666666538e-01L, + 8.33333333333333333333333333307532934e-03L, +-1.98412698412698412698412534478712057e-04L, + 2.75573192239858906520896496653095890e-06L, +-2.50521083854417116999224301266655662e-08L, + 1.60590438367608957516841576404938118e-10L, +-7.64716343504264506714019494041582610e-13L, + 2.81068754939739570236322404393398135e-15L, + +/* sin x ~ ONE * x + x^3 ( SSIN1 + SSIN2 * x^2 + ... + SSIN4 * x^6 + SSIN5 * x^8 ) + x in <0,1/256> */ +#define SSIN1 c[14] +#define SSIN2 c[15] +#define SSIN3 c[16] +#define SSIN4 c[17] +#define SSIN5 c[18] +-1.66666666666666666666666666666666659E-01L, + 8.33333333333333333333333333146298442E-03L, +-1.98412698412698412697726277416810661E-04L, + 2.75573192239848624174178393552189149E-06L, +-2.50521016467996193495359189395805639E-08L, +}; + +#define SINCOSL_COS_HI 0 +#define SINCOSL_COS_LO 1 +#define SINCOSL_SIN_HI 2 +#define SINCOSL_SIN_LO 3 +extern const long double __sincosl_table[]; + +long double +__kernel_sinl(long double x, long double y, int iy) +{ + long double absx, h, l, z, sin_l, cos_l_m1; + int index; + + absx = fabsl (x); + if (absx < 0.1484375L) + { + /* Argument is small enough to approximate it by a Chebyshev + polynomial of degree 17. */ + if (absx < 0x1p-33L) + { + math_check_force_underflow (x); + if (!((int)x)) return x; /* generate inexact */ + } + z = x * x; + return x + (x * (z*(SIN1+z*(SIN2+z*(SIN3+z*(SIN4+ + z*(SIN5+z*(SIN6+z*(SIN7+z*SIN8))))))))); + } + else + { + /* So that we don't have to use too large polynomial, we find + l and h such that x = l + h, where fabsl(l) <= 1.0/256 with 83 + possible values for h. We look up cosl(h) and sinl(h) in + pre-computed tables, compute cosl(l) and sinl(l) using a + Chebyshev polynomial of degree 10(11) and compute + sinl(h+l) = sinl(h)cosl(l) + cosl(h)sinl(l). */ + index = (int) (128 * (absx - (0.1484375L - 1.0L / 256.0L))); + h = 0.1484375L + index / 128.0; + index *= 4; + if (iy) + l = (x < 0 ? -y : y) - (h - absx); + else + l = absx - h; + z = l * l; + sin_l = l*(ONE+z*(SSIN1+z*(SSIN2+z*(SSIN3+z*(SSIN4+z*SSIN5))))); + cos_l_m1 = z*(SCOS1+z*(SCOS2+z*(SCOS3+z*(SCOS4+z*SCOS5)))); + z = __sincosl_table [index + SINCOSL_SIN_HI] + + (__sincosl_table [index + SINCOSL_SIN_LO] + + (__sincosl_table [index + SINCOSL_SIN_HI] * cos_l_m1) + + (__sincosl_table [index + SINCOSL_COS_HI] * sin_l)); + return (x < 0) ? -z : z; + } +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/k_tanl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/k_tanl.c new file mode 100644 index 0000000000..f8641d5ce4 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/k_tanl.c @@ -0,0 +1,152 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* + Long double expansions are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* __kernel_tanl( x, y, k ) + * kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854 + * Input x is assumed to be bounded by ~pi/4 in magnitude. + * Input y is the tail of x. + * Input k indicates whether tan (if k=1) or + * -1/tan (if k= -1) is returned. + * + * Algorithm + * 1. Since tan(-x) = -tan(x), we need only to consider positive x. + * 2. if x < 2^-33, return x with inexact if x!=0. + * 3. tan(x) is approximated by a rational form x + x^3 / 3 + x^5 R(x^2) + * on [0,0.67433]. + * + * Note: tan(x+y) = tan(x) + tan'(x)*y + * ~ tan(x) + (1+x*x)*y + * Therefore, for better accuracy in computing tan(x+y), let + * r = x^3 * R(x^2) + * then + * tan(x+y) = x + (x^3 / 3 + (x^2 *(r+y)+y)) + * + * 4. For x in [0.67433,pi/4], let y = pi/4 - x, then + * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y)) + * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y))) + */ + +#include <float.h> +#include <math.h> +#include <math_private.h> +#include <libc-diag.h> + +static const long double + one = 1.0L, + pio4hi = 0xc.90fdaa22168c235p-4L, + pio4lo = -0x3.b399d747f23e32ecp-68L, + + /* tan x = x + x^3 / 3 + x^5 T(x^2)/U(x^2) + 0 <= x <= 0.6743316650390625 + Peak relative error 8.0e-36 */ + TH = 3.333333333333333333333333333333333333333E-1L, + T0 = -1.813014711743583437742363284336855889393E7L, + T1 = 1.320767960008972224312740075083259247618E6L, + T2 = -2.626775478255838182468651821863299023956E4L, + T3 = 1.764573356488504935415411383687150199315E2L, + T4 = -3.333267763822178690794678978979803526092E-1L, + + U0 = -1.359761033807687578306772463253710042010E8L, + U1 = 6.494370630656893175666729313065113194784E7L, + U2 = -4.180787672237927475505536849168729386782E6L, + U3 = 8.031643765106170040139966622980914621521E4L, + U4 = -5.323131271912475695157127875560667378597E2L; + /* 1.000000000000000000000000000000000000000E0 */ + + +long double +__kernel_tanl (long double x, long double y, int iy) +{ + long double z, r, v, w, s; + long double absx = fabsl (x); + int sign; + + if (absx < 0x1p-33) + { + if ((int) x == 0) + { /* generate inexact */ + if (x == 0 && iy == -1) + return one / fabsl (x); + else if (iy == 1) + { + math_check_force_underflow_nonneg (absx); + return x; + } + else + return -one / x; + } + } + if (absx >= 0.6743316650390625L) + { + if (signbit (x)) + { + x = -x; + y = -y; + sign = -1; + } + else + sign = 1; + z = pio4hi - x; + w = pio4lo - y; + x = z + w; + y = 0.0; + } + z = x * x; + r = T0 + z * (T1 + z * (T2 + z * (T3 + z * T4))); + v = U0 + z * (U1 + z * (U2 + z * (U3 + z * (U4 + z)))); + r = r / v; + + s = z * x; + r = y + z * (s * r + y); + r += TH * s; + w = x + r; + if (absx >= 0.6743316650390625L) + { + v = (long double) iy; + w = (v - 2.0 * (x - (w * w / (w + v) - r))); + /* SIGN is set for arguments that reach this code, but not + otherwise, resulting in warnings that it may be used + uninitialized although in the cases where it is used it has + always been set. */ + DIAG_PUSH_NEEDS_COMMENT; + DIAG_IGNORE_NEEDS_COMMENT (4.8, "-Wmaybe-uninitialized"); + if (sign < 0) + w = -w; + DIAG_POP_NEEDS_COMMENT; + return w; + } + if (iy == 1) + return w; + else + return -1.0 / (x + r); +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/ldbl2mpn.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/ldbl2mpn.c new file mode 100644 index 0000000000..425078e1de --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/ldbl2mpn.c @@ -0,0 +1,94 @@ +/* Copyright (C) 1995-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include "gmp.h" +#include "gmp-impl.h" +#include "longlong.h" +#include <ieee754.h> +#include <float.h> +#include <math.h> +#include <stdlib.h> + +/* Convert a `long double' in IEEE854 standard double-precision format to a + multi-precision integer representing the significand scaled up by its + number of bits (64 for long double) and an integral power of two + (MPN frexpl). */ + +mp_size_t +__mpn_extract_long_double (mp_ptr res_ptr, mp_size_t size, + int *expt, int *is_neg, + long double value) +{ + union ieee854_long_double u; + u.d = value; + + *is_neg = u.ieee.negative; + *expt = (int) u.ieee.exponent - IEEE854_LONG_DOUBLE_BIAS; + +#if BITS_PER_MP_LIMB == 32 + res_ptr[0] = u.ieee.mantissa1; /* Low-order 32 bits of fraction. */ + res_ptr[1] = u.ieee.mantissa0; /* High-order 32 bits. */ + #define N 2 +#elif BITS_PER_MP_LIMB == 64 + /* Hopefully the compiler will combine the two bitfield extracts + and this composition into just the original quadword extract. */ + res_ptr[0] = ((mp_limb_t) u.ieee.mantissa0 << 32) | u.ieee.mantissa1; + #define N 1 +#else + #error "mp_limb size " BITS_PER_MP_LIMB "not accounted for" +#endif + + if (u.ieee.exponent == 0) + { + /* A biased exponent of zero is a special case. + Either it is a zero or it is a denormal number. */ + if (res_ptr[0] == 0 && res_ptr[N - 1] == 0) /* Assumes N<=2. */ + /* It's zero. */ + *expt = 0; + else + { + /* It is a denormal number, meaning it has no implicit leading + one bit, and its exponent is in fact the format minimum. */ + int cnt; + + if (res_ptr[N - 1] != 0) + { + count_leading_zeros (cnt, res_ptr[N - 1]); + if (cnt != 0) + { +#if N == 2 + res_ptr[N - 1] = res_ptr[N - 1] << cnt + | (res_ptr[0] >> (BITS_PER_MP_LIMB - cnt)); + res_ptr[0] <<= cnt; +#else + res_ptr[N - 1] <<= cnt; +#endif + } + *expt = LDBL_MIN_EXP - 1 - cnt; + } + else + { + count_leading_zeros (cnt, res_ptr[0]); + res_ptr[N - 1] = res_ptr[0] << cnt; + res_ptr[0] = 0; + *expt = LDBL_MIN_EXP - 1 - BITS_PER_MP_LIMB - cnt; + } + } + } + + return N; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_negl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_negl.c new file mode 100644 index 0000000000..36beb764be --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_negl.c @@ -0,0 +1,418 @@ +/* lgammal expanding around zeros. + Copyright (C) 2015-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <math_private.h> + +static const long double lgamma_zeros[][2] = + { + { -0x2.74ff92c01f0d82acp+0L, 0x1.360cea0e5f8ed3ccp-68L }, + { -0x2.bf6821437b201978p+0L, -0x1.95a4b4641eaebf4cp-64L }, + { -0x3.24c1b793cb35efb8p+0L, -0xb.e699ad3d9ba6545p-68L }, + { -0x3.f48e2a8f85fca17p+0L, -0xd.4561291236cc321p-68L }, + { -0x4.0a139e16656030cp+0L, -0x3.9f0b0de18112ac18p-64L }, + { -0x4.fdd5de9bbabf351p+0L, -0xd.0aa4076988501d8p-68L }, + { -0x5.021a95fc2db64328p+0L, -0x2.4c56e595394decc8p-64L }, + { -0x5.ffa4bd647d0357ep+0L, 0x2.b129d342ce12071cp-64L }, + { -0x6.005ac9625f233b6p+0L, -0x7.c2d96d16385cb868p-68L }, + { -0x6.fff2fddae1bbff4p+0L, 0x2.9d949a3dc02de0cp-64L }, + { -0x7.000cff7b7f87adf8p+0L, 0x3.b7d23246787d54d8p-64L }, + { -0x7.fffe5fe05673c3c8p+0L, -0x2.9e82b522b0ca9d3p-64L }, + { -0x8.0001a01459fc9f6p+0L, -0xc.b3cec1cec857667p-68L }, + { -0x8.ffffd1c425e81p+0L, 0x3.79b16a8b6da6181cp-64L }, + { -0x9.00002e3bb47d86dp+0L, -0x6.d843fedc351deb78p-64L }, + { -0x9.fffffb606bdfdcdp+0L, -0x6.2ae77a50547c69dp-68L }, + { -0xa.0000049f93bb992p+0L, -0x7.b45d95e15441e03p-64L }, + { -0xa.ffffff9466e9f1bp+0L, -0x3.6dacd2adbd18d05cp-64L }, + { -0xb.0000006b9915316p+0L, 0x2.69a590015bf1b414p-64L }, + { -0xb.fffffff70893874p+0L, 0x7.821be533c2c36878p-64L }, + { -0xc.00000008f76c773p+0L, -0x1.567c0f0250f38792p-64L }, + { -0xc.ffffffff4f6dcf6p+0L, -0x1.7f97a5ffc757d548p-64L }, + { -0xd.00000000b09230ap+0L, 0x3.f997c22e46fc1c9p-64L }, + { -0xd.fffffffff36345bp+0L, 0x4.61e7b5c1f62ee89p-64L }, + { -0xe.000000000c9cba5p+0L, -0x4.5e94e75ec5718f78p-64L }, + { -0xe.ffffffffff28c06p+0L, -0xc.6604ef30371f89dp-68L }, + { -0xf.0000000000d73fap+0L, 0xc.6642f1bdf07a161p-68L }, + { -0xf.fffffffffff28cp+0L, -0x6.0c6621f512e72e5p-64L }, + { -0x1.000000000000d74p+4L, 0x6.0c6625ebdb406c48p-64L }, + { -0x1.0ffffffffffff356p+4L, -0x9.c47e7a93e1c46a1p-64L }, + { -0x1.1000000000000caap+4L, 0x9.c47e7a97778935ap-64L }, + { -0x1.1fffffffffffff4cp+4L, 0x1.3c31dcbecd2f74d4p-64L }, + { -0x1.20000000000000b4p+4L, -0x1.3c31dcbeca4c3b3p-64L }, + { -0x1.2ffffffffffffff6p+4L, -0x8.5b25cbf5f545ceep-64L }, + { -0x1.300000000000000ap+4L, 0x8.5b25cbf5f547e48p-64L }, + { -0x1.4p+4L, 0x7.950ae90080894298p-64L }, + { -0x1.4p+4L, -0x7.950ae9008089414p-64L }, + { -0x1.5p+4L, 0x5.c6e3bdb73d5c63p-68L }, + { -0x1.5p+4L, -0x5.c6e3bdb73d5c62f8p-68L }, + { -0x1.6p+4L, 0x4.338e5b6dfe14a518p-72L }, + { -0x1.6p+4L, -0x4.338e5b6dfe14a51p-72L }, + { -0x1.7p+4L, 0x2.ec368262c7033b3p-76L }, + { -0x1.7p+4L, -0x2.ec368262c7033b3p-76L }, + { -0x1.8p+4L, 0x1.f2cf01972f577ccap-80L }, + { -0x1.8p+4L, -0x1.f2cf01972f577ccap-80L }, + { -0x1.9p+4L, 0x1.3f3ccdd165fa8d4ep-84L }, + { -0x1.9p+4L, -0x1.3f3ccdd165fa8d4ep-84L }, + { -0x1.ap+4L, 0xc.4742fe35272cd1cp-92L }, + { -0x1.ap+4L, -0xc.4742fe35272cd1cp-92L }, + { -0x1.bp+4L, 0x7.46ac70b733a8c828p-96L }, + { -0x1.bp+4L, -0x7.46ac70b733a8c828p-96L }, + { -0x1.cp+4L, 0x4.2862898d42174ddp-100L }, + { -0x1.cp+4L, -0x4.2862898d42174ddp-100L }, + { -0x1.dp+4L, 0x2.4b3f31686b15af58p-104L }, + { -0x1.dp+4L, -0x2.4b3f31686b15af58p-104L }, + { -0x1.ep+4L, 0x1.3932c5047d60e60cp-108L }, + { -0x1.ep+4L, -0x1.3932c5047d60e60cp-108L }, + { -0x1.fp+4L, 0xa.1a6973c1fade217p-116L }, + { -0x1.fp+4L, -0xa.1a6973c1fade217p-116L }, + { -0x2p+4L, 0x5.0d34b9e0fd6f10b8p-120L }, + { -0x2p+4L, -0x5.0d34b9e0fd6f10b8p-120L }, + { -0x2.1p+4L, 0x2.73024a9ba1aa36a8p-124L }, + }; + +static const long double e_hi = 0x2.b7e151628aed2a6cp+0L; +static const long double e_lo = -0x1.408ea77f630b0c38p-64L; + +/* Coefficients B_2k / 2k(2k-1) of x^-(2k-1) in Stirling's + approximation to lgamma function. */ + +static const long double lgamma_coeff[] = + { + 0x1.5555555555555556p-4L, + -0xb.60b60b60b60b60bp-12L, + 0x3.4034034034034034p-12L, + -0x2.7027027027027028p-12L, + 0x3.72a3c5631fe46aep-12L, + -0x7.daac36664f1f208p-12L, + 0x1.a41a41a41a41a41ap-8L, + -0x7.90a1b2c3d4e5f708p-8L, + 0x2.dfd2c703c0cfff44p-4L, + -0x1.6476701181f39edcp+0L, + 0xd.672219167002d3ap+0L, + -0x9.cd9292e6660d55bp+4L, + 0x8.911a740da740da7p+8L, + -0x8.d0cc570e255bf5ap+12L, + 0xa.8d1044d3708d1c2p+16L, + -0xe.8844d8a169abbc4p+20L, + }; + +#define NCOEFF (sizeof (lgamma_coeff) / sizeof (lgamma_coeff[0])) + +/* Polynomial approximations to (|gamma(x)|-1)(x-n)/(x-x0), where n is + the integer end-point of the half-integer interval containing x and + x0 is the zero of lgamma in that half-integer interval. Each + polynomial is expressed in terms of x-xm, where xm is the midpoint + of the interval for which the polynomial applies. */ + +static const long double poly_coeff[] = + { + /* Interval [-2.125, -2] (polynomial degree 13). */ + -0x1.0b71c5c54d42eb6cp+0L, + -0xc.73a1dc05f349517p-4L, + -0x1.ec841408528b6baep-4L, + -0xe.37c9da26fc3b492p-4L, + -0x1.03cd87c5178991ap-4L, + -0xe.ae9ada65ece2f39p-4L, + 0x9.b1185505edac18dp-8L, + -0xe.f28c130b54d3cb2p-4L, + 0x2.6ec1666cf44a63bp-4L, + -0xf.57cb2774193bbd5p-4L, + 0x4.5ae64671a41b1c4p-4L, + -0xf.f48ea8b5bd3a7cep-4L, + 0x6.7d73788a8d30ef58p-4L, + -0x1.11e0e4b506bd272ep+0L, + /* Interval [-2.25, -2.125] (polynomial degree 13). */ + -0xf.2930890d7d675a8p-4L, + -0xc.a5cfde054eab5cdp-4L, + 0x3.9c9e0fdebb0676e4p-4L, + -0x1.02a5ad35605f0d8cp+0L, + 0x9.6e9b1185d0b92edp-4L, + -0x1.4d8332f3d6a3959p+0L, + 0x1.1c0c8cacd0ced3eap+0L, + -0x1.c9a6f592a67b1628p+0L, + 0x1.d7e9476f96aa4bd6p+0L, + -0x2.921cedb488bb3318p+0L, + 0x2.e8b3fd6ca193e4c8p+0L, + -0x3.cb69d9d6628e4a2p+0L, + 0x4.95f12c73b558638p+0L, + -0x5.d392d0b97c02ab6p+0L, + /* Interval [-2.375, -2.25] (polynomial degree 14). */ + -0xd.7d28d505d618122p-4L, + -0xe.69649a304098532p-4L, + 0xb.0d74a2827d055c5p-4L, + -0x1.924b09228531c00ep+0L, + 0x1.d49b12bccee4f888p+0L, + -0x3.0898bb7dbb21e458p+0L, + 0x4.207a6cad6fa10a2p+0L, + -0x6.39ee630b46093ad8p+0L, + 0x8.e2e25211a3fb5ccp+0L, + -0xd.0e85ccd8e79c08p+0L, + 0x1.2e45882bc17f9e16p+4L, + -0x1.b8b6e841815ff314p+4L, + 0x2.7ff8bf7504fa04dcp+4L, + -0x3.c192e9c903352974p+4L, + 0x5.8040b75f4ef07f98p+4L, + /* Interval [-2.5, -2.375] (polynomial degree 15). */ + -0xb.74ea1bcfff94b2cp-4L, + -0x1.2a82bd590c375384p+0L, + 0x1.88020f828b968634p+0L, + -0x3.32279f040eb80fa4p+0L, + 0x5.57ac825175943188p+0L, + -0x9.c2aedcfe10f129ep+0L, + 0x1.12c132f2df02881ep+4L, + -0x1.ea94e26c0b6ffa6p+4L, + 0x3.66b4a8bb0290013p+4L, + -0x6.0cf735e01f5990bp+4L, + 0xa.c10a8db7ae99343p+4L, + -0x1.31edb212b315feeap+8L, + 0x2.1f478592298b3ebp+8L, + -0x3.c546da5957ace6ccp+8L, + 0x7.0e3d2a02579ba4bp+8L, + -0xc.b1ea961c39302f8p+8L, + /* Interval [-2.625, -2.5] (polynomial degree 16). */ + -0x3.d10108c27ebafad4p-4L, + 0x1.cd557caff7d2b202p+0L, + 0x3.819b4856d3995034p+0L, + 0x6.8505cbad03dd3bd8p+0L, + 0xb.c1b2e653aa0b924p+0L, + 0x1.50a53a38f05f72d6p+4L, + 0x2.57ae00cbd06efb34p+4L, + 0x4.2b1563077a577e9p+4L, + 0x7.6989ed790138a7f8p+4L, + 0xd.2dd28417b4f8406p+4L, + 0x1.76e1b71f0710803ap+8L, + 0x2.9a7a096254ac032p+8L, + 0x4.a0e6109e2a039788p+8L, + 0x8.37ea17a93c877b2p+8L, + 0xe.9506a641143612bp+8L, + 0x1.b680ed4ea386d52p+12L, + 0x3.28a2130c8de0ae84p+12L, + /* Interval [-2.75, -2.625] (polynomial degree 15). */ + -0x6.b5d252a56e8a7548p-4L, + 0x1.28d60383da3ac72p+0L, + 0x1.db6513ada8a6703ap+0L, + 0x2.e217118f9d34aa7cp+0L, + 0x4.450112c5cbd6256p+0L, + 0x6.4af99151e972f92p+0L, + 0x9.2db598b5b183cd6p+0L, + 0xd.62bef9c9adcff6ap+0L, + 0x1.379f290d743d9774p+4L, + 0x1.c58271ff823caa26p+4L, + 0x2.93a871b87a06e73p+4L, + 0x3.bf9db66103d7ec98p+4L, + 0x5.73247c111fbf197p+4L, + 0x7.ec8b9973ba27d008p+4L, + 0xb.eca5f9619b39c03p+4L, + 0x1.18f2e46411c78b1cp+8L, + /* Interval [-2.875, -2.75] (polynomial degree 14). */ + -0x8.a41b1e4f36ff88ep-4L, + 0xc.da87d3b69dc0f34p-4L, + 0x1.1474ad5c36158ad2p+0L, + 0x1.761ecb90c5553996p+0L, + 0x1.d279bff9ae234f8p+0L, + 0x2.4e5d0055a16c5414p+0L, + 0x2.d57545a783902f8cp+0L, + 0x3.8514eec263aa9f98p+0L, + 0x4.5235e338245f6fe8p+0L, + 0x5.562b1ef200b256c8p+0L, + 0x6.8ec9782b93bd565p+0L, + 0x8.14baf4836483508p+0L, + 0x9.efaf35dc712ea79p+0L, + 0xc.8431f6a226507a9p+0L, + 0xf.80358289a768401p+0L, + /* Interval [-3, -2.875] (polynomial degree 13). */ + -0xa.046d667e468f3e4p-4L, + 0x9.70b88dcc006c216p-4L, + 0xa.a8a39421c86ce9p-4L, + 0xd.2f4d1363f321e89p-4L, + 0xd.ca9aa1a3ab2f438p-4L, + 0xf.cf09c31f05d02cbp-4L, + 0x1.04b133a195686a38p+0L, + 0x1.22b54799d0072024p+0L, + 0x1.2c5802b869a36ae8p+0L, + 0x1.4aadf23055d7105ep+0L, + 0x1.5794078dd45c55d6p+0L, + 0x1.7759069da18bcf0ap+0L, + 0x1.8e672cefa4623f34p+0L, + 0x1.b2acfa32c17145e6p+0L, + }; + +static const size_t poly_deg[] = + { + 13, + 13, + 14, + 15, + 16, + 15, + 14, + 13, + }; + +static const size_t poly_end[] = + { + 13, + 27, + 42, + 58, + 75, + 91, + 106, + 120, + }; + +/* Compute sin (pi * X) for -0.25 <= X <= 0.5. */ + +static long double +lg_sinpi (long double x) +{ + if (x <= 0.25L) + return __sinl (M_PIl * x); + else + return __cosl (M_PIl * (0.5L - x)); +} + +/* Compute cos (pi * X) for -0.25 <= X <= 0.5. */ + +static long double +lg_cospi (long double x) +{ + if (x <= 0.25L) + return __cosl (M_PIl * x); + else + return __sinl (M_PIl * (0.5L - x)); +} + +/* Compute cot (pi * X) for -0.25 <= X <= 0.5. */ + +static long double +lg_cotpi (long double x) +{ + return lg_cospi (x) / lg_sinpi (x); +} + +/* Compute lgamma of a negative argument -33 < X < -2, setting + *SIGNGAMP accordingly. */ + +long double +__lgamma_negl (long double x, int *signgamp) +{ + /* Determine the half-integer region X lies in, handle exact + integers and determine the sign of the result. */ + int i = __floorl (-2 * x); + if ((i & 1) == 0 && i == -2 * x) + return 1.0L / 0.0L; + long double xn = ((i & 1) == 0 ? -i / 2 : (-i - 1) / 2); + i -= 4; + *signgamp = ((i & 2) == 0 ? -1 : 1); + + SET_RESTORE_ROUNDL (FE_TONEAREST); + + /* Expand around the zero X0 = X0_HI + X0_LO. */ + long double x0_hi = lgamma_zeros[i][0], x0_lo = lgamma_zeros[i][1]; + long double xdiff = x - x0_hi - x0_lo; + + /* For arguments in the range -3 to -2, use polynomial + approximations to an adjusted version of the gamma function. */ + if (i < 2) + { + int j = __floorl (-8 * x) - 16; + long double xm = (-33 - 2 * j) * 0.0625L; + long double x_adj = x - xm; + size_t deg = poly_deg[j]; + size_t end = poly_end[j]; + long double g = poly_coeff[end]; + for (size_t j = 1; j <= deg; j++) + g = g * x_adj + poly_coeff[end - j]; + return __log1pl (g * xdiff / (x - xn)); + } + + /* The result we want is log (sinpi (X0) / sinpi (X)) + + log (gamma (1 - X0) / gamma (1 - X)). */ + long double x_idiff = fabsl (xn - x), x0_idiff = fabsl (xn - x0_hi - x0_lo); + long double log_sinpi_ratio; + if (x0_idiff < x_idiff * 0.5L) + /* Use log not log1p to avoid inaccuracy from log1p of arguments + close to -1. */ + log_sinpi_ratio = __ieee754_logl (lg_sinpi (x0_idiff) + / lg_sinpi (x_idiff)); + else + { + /* Use log1p not log to avoid inaccuracy from log of arguments + close to 1. X0DIFF2 has positive sign if X0 is further from + XN than X is from XN, negative sign otherwise. */ + long double x0diff2 = ((i & 1) == 0 ? xdiff : -xdiff) * 0.5L; + long double sx0d2 = lg_sinpi (x0diff2); + long double cx0d2 = lg_cospi (x0diff2); + log_sinpi_ratio = __log1pl (2 * sx0d2 + * (-sx0d2 + cx0d2 * lg_cotpi (x_idiff))); + } + + long double log_gamma_ratio; + long double y0 = 1 - x0_hi; + long double y0_eps = -x0_hi + (1 - y0) - x0_lo; + long double y = 1 - x; + long double y_eps = -x + (1 - y); + /* We now wish to compute LOG_GAMMA_RATIO + = log (gamma (Y0 + Y0_EPS) / gamma (Y + Y_EPS)). XDIFF + accurately approximates the difference Y0 + Y0_EPS - Y - + Y_EPS. Use Stirling's approximation. First, we may need to + adjust into the range where Stirling's approximation is + sufficiently accurate. */ + long double log_gamma_adj = 0; + if (i < 8) + { + int n_up = (9 - i) / 2; + long double ny0, ny0_eps, ny, ny_eps; + ny0 = y0 + n_up; + ny0_eps = y0 - (ny0 - n_up) + y0_eps; + y0 = ny0; + y0_eps = ny0_eps; + ny = y + n_up; + ny_eps = y - (ny - n_up) + y_eps; + y = ny; + y_eps = ny_eps; + long double prodm1 = __lgamma_productl (xdiff, y - n_up, y_eps, n_up); + log_gamma_adj = -__log1pl (prodm1); + } + long double log_gamma_high + = (xdiff * __log1pl ((y0 - e_hi - e_lo + y0_eps) / e_hi) + + (y - 0.5L + y_eps) * __log1pl (xdiff / y) + log_gamma_adj); + /* Compute the sum of (B_2k / 2k(2k-1))(Y0^-(2k-1) - Y^-(2k-1)). */ + long double y0r = 1 / y0, yr = 1 / y; + long double y0r2 = y0r * y0r, yr2 = yr * yr; + long double rdiff = -xdiff / (y * y0); + long double bterm[NCOEFF]; + long double dlast = rdiff, elast = rdiff * yr * (yr + y0r); + bterm[0] = dlast * lgamma_coeff[0]; + for (size_t j = 1; j < NCOEFF; j++) + { + long double dnext = dlast * y0r2 + elast; + long double enext = elast * yr2; + bterm[j] = dnext * lgamma_coeff[j]; + dlast = dnext; + elast = enext; + } + long double log_gamma_low = 0; + for (size_t j = 0; j < NCOEFF; j++) + log_gamma_low += bterm[NCOEFF - 1 - j]; + log_gamma_ratio = log_gamma_high + log_gamma_low; + + return log_sinpi_ratio + log_gamma_ratio; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_product.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_product.c new file mode 100644 index 0000000000..46be5df762 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_product.c @@ -0,0 +1,37 @@ +/* Compute a product of 1 + (T/X), 1 + (T/(X+1)), .... + Copyright (C) 2015-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <float.h> + +/* Compute the product of 1 + (T / (X + X_EPS)), 1 + (T / (X + X_EPS + + 1)), ..., 1 + (T / (X + X_EPS + N - 1)), minus 1. X is such that + all the values X + 1, ..., X + N - 1 are exactly representable, and + X_EPS / X is small enough that factors quadratic in it can be + neglected. */ + +double +__lgamma_product (double t, double x, double x_eps, int n) +{ + long double x_full = (long double) x + (long double) x_eps; + long double ret = 0; + for (int i = 0; i < n; i++) + ret += (t / (x_full + i)) * (1 + ret); + return ret; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_productl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_productl.c new file mode 100644 index 0000000000..cd6f2f3156 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/lgamma_productl.c @@ -0,0 +1,52 @@ +/* Compute a product of 1 + (T/X), 1 + (T/(X+1)), .... + Copyright (C) 2015-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <mul_splitl.h> + +/* Compute the product of 1 + (T / (X + X_EPS)), 1 + (T / (X + X_EPS + + 1)), ..., 1 + (T / (X + X_EPS + N - 1)), minus 1. X is such that + all the values X + 1, ..., X + N - 1 are exactly representable, and + X_EPS / X is small enough that factors quadratic in it can be + neglected. */ + +long double +__lgamma_productl (long double t, long double x, long double x_eps, int n) +{ + long double ret = 0, ret_eps = 0; + for (int i = 0; i < n; i++) + { + long double xi = x + i; + long double quot = t / xi; + long double mhi, mlo; + mul_splitl (&mhi, &mlo, quot, xi); + long double quot_lo = (t - mhi - mlo) / xi - t * x_eps / (xi * xi); + /* We want (1 + RET + RET_EPS) * (1 + QUOT + QUOT_LO) - 1. */ + long double rhi, rlo; + mul_splitl (&rhi, &rlo, ret, quot); + long double rpq = ret + quot; + long double rpq_eps = (ret - rpq) + quot; + long double nret = rpq + rhi; + long double nret_eps = (rpq - nret) + rhi; + ret_eps += (rpq_eps + nret_eps + rlo + ret_eps * quot + + quot_lo + quot_lo * (ret + ret_eps)); + ret = nret; + } + return ret + ret_eps; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/math_ldbl.h b/REORG.TODO/sysdeps/ieee754/ldbl-96/math_ldbl.h new file mode 100644 index 0000000000..ef897065b7 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/math_ldbl.h @@ -0,0 +1,120 @@ +/* Manipulation of the bit representation of 'long double' quantities. + Copyright (C) 1999-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#ifndef _MATH_LDBL_H_ +#define _MATH_LDBL_H_ 1 + +#include <stdint.h> +#include <endian.h> + +/* A union which permits us to convert between a long double and + three 32 bit ints. */ + +#if __FLOAT_WORD_ORDER == __BIG_ENDIAN + +typedef union +{ + long double value; + struct + { + int sign_exponent:16; + unsigned int empty:16; + uint32_t msw; + uint32_t lsw; + } parts; +} ieee_long_double_shape_type; + +#endif + +#if __FLOAT_WORD_ORDER == __LITTLE_ENDIAN + +typedef union +{ + long double value; + struct + { + uint32_t lsw; + uint32_t msw; + int sign_exponent:16; + unsigned int empty:16; + } parts; +} ieee_long_double_shape_type; + +#endif + +/* Get three 32 bit ints from a double. */ + +#define GET_LDOUBLE_WORDS(exp,ix0,ix1,d) \ +do { \ + ieee_long_double_shape_type ew_u; \ + ew_u.value = (d); \ + (exp) = ew_u.parts.sign_exponent; \ + (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) \ +do { \ + ieee_long_double_shape_type iw_u; \ + iw_u.parts.sign_exponent = (exp); \ + iw_u.parts.msw = (ix0); \ + iw_u.parts.lsw = (ix1); \ + (d) = iw_u.value; \ +} while (0) + +/* Get the more significant 32 bits of a long double mantissa. */ + +#define GET_LDOUBLE_MSW(v,d) \ +do { \ + ieee_long_double_shape_type sh_u; \ + sh_u.value = (d); \ + (v) = sh_u.parts.msw; \ +} while (0) + +/* Set the more significant 32 bits of a long double mantissa from an int. */ + +#define SET_LDOUBLE_MSW(d,v) \ +do { \ + ieee_long_double_shape_type sh_u; \ + sh_u.value = (d); \ + sh_u.parts.msw = (v); \ + (d) = sh_u.value; \ +} while (0) + +/* Get int from the exponent of a long double. */ + +#define GET_LDOUBLE_EXP(exp,d) \ +do { \ + ieee_long_double_shape_type ge_u; \ + ge_u.value = (d); \ + (exp) = ge_u.parts.sign_exponent; \ +} while (0) + +/* Set exponent of a long double from an int. */ + +#define SET_LDOUBLE_EXP(d,exp) \ +do { \ + ieee_long_double_shape_type se_u; \ + se_u.value = (d); \ + se_u.parts.sign_exponent = (exp); \ + (d) = se_u.value; \ +} while (0) + +#endif /* math_ldbl.h */ diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/mpn2ldbl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/mpn2ldbl.c new file mode 100644 index 0000000000..715efb40b2 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/mpn2ldbl.c @@ -0,0 +1,46 @@ +/* Copyright (C) 1995-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include "gmp.h" +#include "gmp-impl.h" +#include <ieee754.h> +#include <float.h> +#include <math.h> + +/* Convert a multi-precision integer of the needed number of bits (64 for + long double) and an integral power of two to a `long double' in IEEE854 + extended-precision format. */ + +long double +__mpn_construct_long_double (mp_srcptr frac_ptr, int expt, int sign) +{ + union ieee854_long_double u; + + u.ieee.negative = sign; + u.ieee.exponent = expt + IEEE854_LONG_DOUBLE_BIAS; +#if BITS_PER_MP_LIMB == 32 + u.ieee.mantissa1 = frac_ptr[0]; + u.ieee.mantissa0 = frac_ptr[1]; +#elif BITS_PER_MP_LIMB == 64 + u.ieee.mantissa1 = frac_ptr[0] & (((mp_limb_t) 1 << 32) - 1); + u.ieee.mantissa0 = frac_ptr[0] >> 32; +#else + #error "mp_limb size " BITS_PER_MP_LIMB "not accounted for" +#endif + + return u.d; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/printf_fphex.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/printf_fphex.c new file mode 100644 index 0000000000..0df9462d91 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/printf_fphex.c @@ -0,0 +1,95 @@ +/* Print floating point number in hexadecimal notation according to ISO C99. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#ifndef LONG_DOUBLE_DENORM_BIAS +# define LONG_DOUBLE_DENORM_BIAS (IEEE854_LONG_DOUBLE_BIAS - 1) +#endif + +#define PRINT_FPHEX_LONG_DOUBLE \ +do { \ + /* The "strange" 80 bit format on ix86 and m68k has an explicit \ + leading digit in the 64 bit mantissa. */ \ + unsigned long long int num; \ + union ieee854_long_double u; \ + u.d = fpnum.ldbl; \ + \ + assert (sizeof (long double) == 12); \ + \ + num = (((unsigned long long int) u.ieee.mantissa0) << 32 \ + | u.ieee.mantissa1); \ + \ + zero_mantissa = num == 0; \ + \ + if (sizeof (unsigned long int) > 6) \ + { \ + numstr = _itoa_word (num, numbuf + sizeof numbuf, 16, \ + info->spec == 'A'); \ + wnumstr = _itowa_word (num, \ + wnumbuf + sizeof (wnumbuf) / sizeof (wchar_t),\ + 16, info->spec == 'A'); \ + } \ + else \ + { \ + numstr = _itoa (num, numbuf + sizeof numbuf, 16, info->spec == 'A');\ + wnumstr = _itowa (num, \ + wnumbuf + sizeof (wnumbuf) / sizeof (wchar_t), \ + 16, info->spec == 'A'); \ + } \ + \ + /* Fill with zeroes. */ \ + while (numstr > numbuf + (sizeof numbuf - 64 / 4)) \ + { \ + *--numstr = '0'; \ + *--wnumstr = L'0'; \ + } \ + \ + /* We use a full nibble for the leading digit. */ \ + leading = *numstr++; \ + wnumstr++; \ + \ + /* We have 3 bits from the mantissa in the leading nibble. \ + Therefore we are here using `IEEE854_LONG_DOUBLE_BIAS + 3'. */ \ + exponent = u.ieee.exponent; \ + \ + if (exponent == 0) \ + { \ + if (zero_mantissa) \ + expnegative = 0; \ + else \ + { \ + /* This is a denormalized number. */ \ + expnegative = 1; \ + /* This is a hook for the m68k long double format, where the \ + exponent bias is the same for normalized and denormalized \ + numbers. */ \ + exponent = LONG_DOUBLE_DENORM_BIAS + 3; \ + } \ + } \ + else if (exponent >= IEEE854_LONG_DOUBLE_BIAS + 3) \ + { \ + expnegative = 0; \ + exponent -= IEEE854_LONG_DOUBLE_BIAS + 3; \ + } \ + else \ + { \ + expnegative = 1; \ + exponent = -(exponent - (IEEE854_LONG_DOUBLE_BIAS + 3)); \ + } \ +} while (0) + +#include <stdio-common/printf_fphex.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_asinhl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_asinhl.c new file mode 100644 index 0000000000..da49ea5988 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_asinhl.c @@ -0,0 +1,65 @@ +/* s_asinhl.c -- long double version of s_asinh.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* 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 <float.h> +#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(__builtin_expect(ix< 0x3fde, 0)) { /* |x|<2**-34 */ + math_check_force_underflow (x); + if(huge+x>one) return x; /* return x inexact except 0 */ + } + if(__builtin_expect(ix>0x4020,0)) { /* |x| > 2**34 */ + if(ix==0x7fff) return x+x; /* x is inf or NaN */ + w = __ieee754_logl(fabsl(x))+ln2; + } else { + long double xa = fabsl(x); + if (ix>0x4000) { /* 2**34 > |x| > 2.0 */ + w = __ieee754_logl(2.0*xa+one/(__ieee754_sqrtl(xa*xa+one)+xa)); + } else { /* 2.0 > |x| > 2**-28 */ + t = xa*xa; + w =__log1pl(xa+t/(one+__ieee754_sqrtl(one+t))); + } + } + return __copysignl(w, x); +} +weak_alias (__asinhl, asinhl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_cbrtl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_cbrtl.c new file mode 100644 index 0000000000..5712fce2e9 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_cbrtl.c @@ -0,0 +1,70 @@ +/* Compute cubic root of double value. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Dirk Alboth <dirka@uni-paderborn.de> and + Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> + + +#define CBRT2 1.2599210498948731648 /* 2^(1/3) */ +#define SQR_CBRT2 1.5874010519681994748 /* 2^(2/3) */ + +/* We don't use long double values here since U need not be computed + with full precision. */ +static const double factor[5] = +{ + 1.0 / SQR_CBRT2, + 1.0 / CBRT2, + 1.0, + CBRT2, + SQR_CBRT2 +}; + +static const long double third = 0.3333333333333333333333333L; + +long double +__cbrtl (long double x) +{ + long double xm, u; + int xe; + + /* Reduce X. XM now is an range 1.0 to 0.5. */ + xm = __frexpl (fabsl (x), &xe); + + /* If X is not finite or is null return it (with raising exceptions + if necessary. + Note: *Our* version of `frexp' sets XE to zero if the argument is + Inf or NaN. This is not portable but faster. */ + if (xe == 0 && fpclassify (x) <= FP_ZERO) + return x + x; + + u = (((-1.34661104733595206551E-1 * xm + + 5.46646013663955245034E-1) * xm + - 9.54382247715094465250E-1) * xm + + 1.13999833547172932737E0) * xm + + 4.02389795645447521269E-1; + + u *= factor[2 + xe % 3]; + u = __ldexpl (x > 0.0 ? u : -u, xe / 3); + + u -= (u - (x / (u * u))) * third; + u -= (u - (x / (u * u))) * third; + return u; +} +weak_alias (__cbrtl, cbrtl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_copysignl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_copysignl.c new file mode 100644 index 0000000000..b1c442452f --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_copysignl.c @@ -0,0 +1,38 @@ +/* s_copysignl.c -- long double version of s_copysign.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* + * copysignl(long double x, long double y) + * copysignl(x,y) returns a value with the magnitude of x and + * with the sign bit of y. + */ + +#include <math.h> +#include <math_private.h> + +long double __copysignl(long double x, long double y) +{ + u_int32_t es1,es2; + GET_LDOUBLE_EXP(es1,x); + GET_LDOUBLE_EXP(es2,y); + SET_LDOUBLE_EXP(x,(es1&0x7fff)|(es2&0x8000)); + return x; +} +weak_alias (__copysignl, copysignl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_cosl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_cosl.c new file mode 100644 index 0000000000..8b0b7d3cc2 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_cosl.c @@ -0,0 +1,88 @@ +/* s_cosl.c -- long double version of s_cos.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* cosl(x) + * Return cosine function of x. + * + * kernel function: + * __kernel_sinl ... sine function on [-pi/4,pi/4] + * __kernel_cosl ... cosine function on [-pi/4,pi/4] + * __ieee754_rem_pio2l ... argument reduction routine + * + * Method. + * Let S,C and T denote the sin, cos and tan respectively on + * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 + * in [-pi/4 , +pi/4], and let n = k mod 4. + * We have + * + * n sin(x) cos(x) tan(x) + * ---------------------------------------------------------- + * 0 S C T + * 1 C -S -1/T + * 2 -S -C T + * 3 -C S -1/T + * ---------------------------------------------------------- + * + * Special cases: + * Let trig be any of sin, cos, or tan. + * trig(+-INF) is NaN, with signals; + * trig(NaN) is that NaN; + * + * Accuracy: + * TRIG(x) returns trig(x) nearly rounded + */ + +#include <errno.h> +#include <math.h> +#include <math_private.h> + +long double __cosl(long double x) +{ + long double y[2],z=0.0; + int32_t n, se, i0, i1; + + /* High word of x. */ + GET_LDOUBLE_WORDS(se,i0,i1,x); + + /* |x| ~< pi/4 */ + se &= 0x7fff; + if(se < 0x3ffe || (se == 0x3ffe && i0 <= 0xc90fdaa2)) + return __kernel_cosl(x,z); + + /* cos(Inf or NaN) is NaN */ + else if (se==0x7fff) { + if (i1 == 0 && i0 == 0x80000000) + __set_errno (EDOM); + return x-x; + } + + /* argument reduction needed */ + else { + n = __ieee754_rem_pio2l(x,y); + switch(n&3) { + case 0: return __kernel_cosl(y[0],y[1]); + case 1: return -__kernel_sinl(y[0],y[1],1); + case 2: return -__kernel_cosl(y[0],y[1]); + default: + return __kernel_sinl(y[0],y[1],1); + } + } +} +weak_alias (__cosl, cosl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_erfl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_erfl.c new file mode 100644 index 0000000000..d00adb1000 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_erfl.c @@ -0,0 +1,451 @@ +/* + * ==================================================== + * 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. + * ==================================================== + */ + +/* Long double expansions are + Copyright (C) 2001 Stephen L. Moshier <moshier@na-net.ornl.gov> + and are incorporated herein by permission of the author. The author + reserves the right to distribute this material elsewhere under different + copying permissions. These modifications are distributed here under + the following terms: + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* 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 <errno.h> +#include <float.h> +#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, + + 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) + { + /* Avoid spurious underflow. */ + long double ret = 0.0625 * (16.0 * x + (16.0 * efx) * x); + math_check_force_underflow (ret); + return ret; + } + 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 = + __ieee754_expl (-z * z - 0.5625) * __ieee754_expl ((z - x) * (z + x) + + R / S); + if ((se & 0x8000) == 0) + return one - r / x; + else + return r / x - one; +} + +weak_alias (__erfl, erfl) +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 = __ieee754_expl (-z * z - 0.5625) * + __ieee754_expl ((z - x) * (z + x) + R / S); + if ((se & 0x8000) == 0) + { + long double ret = r / x; + if (ret == 0) + __set_errno (ERANGE); + return ret; + } + else + return two - r / x; + } + else + { + if ((se & 0x8000) == 0) + { + __set_errno (ERANGE); + return tiny * tiny; + } + else + return two - tiny; + } +} + +weak_alias (__erfcl, erfcl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fma.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fma.c new file mode 100644 index 0000000000..370592074e --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fma.c @@ -0,0 +1,101 @@ +/* Compute x * y + z as ternary operation. + Copyright (C) 2010-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Jakub Jelinek <jakub@redhat.com>, 2010. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <fenv.h> +#include <ieee754.h> +#include <math_private.h> + +/* This implementation uses rounding to odd to avoid problems with + double rounding. See a paper by Boldo and Melquiond: + http://www.lri.fr/~melquion/doc/08-tc.pdf */ + +double +__fma (double x, double y, double z) +{ + if (__glibc_unlikely (isinf (z))) + { + /* If z is Inf, but x and y are finite, the result should be + z rather than NaN. */ + if (isfinite (x) && isfinite (y)) + return (z + x) + y; + return (x * y) + z; + } + + /* Ensure correct sign of exact 0 + 0. */ + if (__glibc_unlikely ((x == 0 || y == 0) && z == 0)) + { + x = math_opt_barrier (x); + return x * y + z; + } + + fenv_t env; + feholdexcept (&env); + fesetround (FE_TONEAREST); + + /* Multiplication m1 + m2 = x * y using Dekker's algorithm. */ +#define C ((1ULL << (LDBL_MANT_DIG + 1) / 2) + 1) + long double x1 = (long double) x * C; + long double y1 = (long double) y * C; + long double m1 = (long double) x * y; + x1 = (x - x1) + x1; + y1 = (y - y1) + y1; + long double x2 = x - x1; + long double y2 = y - y1; + long double m2 = (((x1 * y1 - m1) + x1 * y2) + x2 * y1) + x2 * y2; + + /* Addition a1 + a2 = z + m1 using Knuth's algorithm. */ + long double a1 = z + m1; + long double t1 = a1 - z; + long double t2 = a1 - t1; + t1 = m1 - t1; + t2 = z - t2; + long double a2 = t1 + t2; + /* Ensure the arithmetic is not scheduled after feclearexcept call. */ + math_force_eval (m2); + math_force_eval (a2); + feclearexcept (FE_INEXACT); + + /* If the result is an exact zero, ensure it has the correct sign. */ + if (a1 == 0 && m2 == 0) + { + feupdateenv (&env); + /* Ensure that round-to-nearest value of z + m1 is not reused. */ + z = math_opt_barrier (z); + return z + m1; + } + + fesetround (FE_TOWARDZERO); + /* Perform m2 + a2 addition with round to odd. */ + a2 = a2 + m2; + + /* Add that to a1 again using rounding to odd. */ + union ieee854_long_double u; + u.d = a1 + a2; + if ((u.ieee.mantissa1 & 1) == 0 && u.ieee.exponent != 0x7fff) + u.ieee.mantissa1 |= fetestexcept (FE_INEXACT) != 0; + feupdateenv (&env); + + /* Add finally round to double precision. */ + return u.d; +} +#ifndef __fma +weak_alias (__fma, fma) +#endif diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fmal.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fmal.c new file mode 100644 index 0000000000..1f3fa1ea1e --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fmal.c @@ -0,0 +1,296 @@ +/* Compute x * y + z as ternary operation. + Copyright (C) 2010-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Jakub Jelinek <jakub@redhat.com>, 2010. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <fenv.h> +#include <ieee754.h> +#include <math_private.h> +#include <tininess.h> + +/* This implementation uses rounding to odd to avoid problems with + double rounding. See a paper by Boldo and Melquiond: + http://www.lri.fr/~melquion/doc/08-tc.pdf */ + +long double +__fmal (long double x, long double y, long double z) +{ + union ieee854_long_double u, v, w; + int adjust = 0; + u.d = x; + v.d = y; + w.d = z; + if (__builtin_expect (u.ieee.exponent + v.ieee.exponent + >= 0x7fff + IEEE854_LONG_DOUBLE_BIAS + - LDBL_MANT_DIG, 0) + || __builtin_expect (u.ieee.exponent >= 0x7fff - LDBL_MANT_DIG, 0) + || __builtin_expect (v.ieee.exponent >= 0x7fff - LDBL_MANT_DIG, 0) + || __builtin_expect (w.ieee.exponent >= 0x7fff - LDBL_MANT_DIG, 0) + || __builtin_expect (u.ieee.exponent + v.ieee.exponent + <= IEEE854_LONG_DOUBLE_BIAS + LDBL_MANT_DIG, 0)) + { + /* If z is Inf, but x and y are finite, the result should be + z rather than NaN. */ + if (w.ieee.exponent == 0x7fff + && u.ieee.exponent != 0x7fff + && v.ieee.exponent != 0x7fff) + return (z + x) + y; + /* If z is zero and x are y are nonzero, compute the result + as x * y to avoid the wrong sign of a zero result if x * y + underflows to 0. */ + if (z == 0 && x != 0 && y != 0) + return x * y; + /* If x or y or z is Inf/NaN, or if x * y is zero, compute as + x * y + z. */ + if (u.ieee.exponent == 0x7fff + || v.ieee.exponent == 0x7fff + || w.ieee.exponent == 0x7fff + || x == 0 + || y == 0) + return x * y + z; + /* If fma will certainly overflow, compute as x * y. */ + if (u.ieee.exponent + v.ieee.exponent + > 0x7fff + IEEE854_LONG_DOUBLE_BIAS) + return x * y; + /* If x * y is less than 1/4 of LDBL_TRUE_MIN, neither the + result nor whether there is underflow depends on its exact + value, only on its sign. */ + if (u.ieee.exponent + v.ieee.exponent + < IEEE854_LONG_DOUBLE_BIAS - LDBL_MANT_DIG - 2) + { + int neg = u.ieee.negative ^ v.ieee.negative; + long double tiny = neg ? -0x1p-16445L : 0x1p-16445L; + if (w.ieee.exponent >= 3) + return tiny + z; + /* Scaling up, adding TINY and scaling down produces the + correct result, because in round-to-nearest mode adding + TINY has no effect and in other modes double rounding is + harmless. But it may not produce required underflow + exceptions. */ + v.d = z * 0x1p65L + tiny; + if (TININESS_AFTER_ROUNDING + ? v.ieee.exponent < 66 + : (w.ieee.exponent == 0 + || (w.ieee.exponent == 1 + && w.ieee.negative != neg + && w.ieee.mantissa1 == 0 + && w.ieee.mantissa0 == 0x80000000))) + { + long double force_underflow = x * y; + math_force_eval (force_underflow); + } + return v.d * 0x1p-65L; + } + if (u.ieee.exponent + v.ieee.exponent + >= 0x7fff + IEEE854_LONG_DOUBLE_BIAS - LDBL_MANT_DIG) + { + /* Compute 1p-64 times smaller result and multiply + at the end. */ + if (u.ieee.exponent > v.ieee.exponent) + u.ieee.exponent -= LDBL_MANT_DIG; + else + v.ieee.exponent -= LDBL_MANT_DIG; + /* If x + y exponent is very large and z exponent is very small, + it doesn't matter if we don't adjust it. */ + if (w.ieee.exponent > LDBL_MANT_DIG) + w.ieee.exponent -= LDBL_MANT_DIG; + adjust = 1; + } + else if (w.ieee.exponent >= 0x7fff - LDBL_MANT_DIG) + { + /* Similarly. + If z exponent is very large and x and y exponents are + very small, adjust them up to avoid spurious underflows, + rather than down. */ + if (u.ieee.exponent + v.ieee.exponent + <= IEEE854_LONG_DOUBLE_BIAS + 2 * LDBL_MANT_DIG) + { + if (u.ieee.exponent > v.ieee.exponent) + u.ieee.exponent += 2 * LDBL_MANT_DIG + 2; + else + v.ieee.exponent += 2 * LDBL_MANT_DIG + 2; + } + else if (u.ieee.exponent > v.ieee.exponent) + { + if (u.ieee.exponent > LDBL_MANT_DIG) + u.ieee.exponent -= LDBL_MANT_DIG; + } + else if (v.ieee.exponent > LDBL_MANT_DIG) + v.ieee.exponent -= LDBL_MANT_DIG; + w.ieee.exponent -= LDBL_MANT_DIG; + adjust = 1; + } + else if (u.ieee.exponent >= 0x7fff - LDBL_MANT_DIG) + { + u.ieee.exponent -= LDBL_MANT_DIG; + if (v.ieee.exponent) + v.ieee.exponent += LDBL_MANT_DIG; + else + v.d *= 0x1p64L; + } + else if (v.ieee.exponent >= 0x7fff - LDBL_MANT_DIG) + { + v.ieee.exponent -= LDBL_MANT_DIG; + if (u.ieee.exponent) + u.ieee.exponent += LDBL_MANT_DIG; + else + u.d *= 0x1p64L; + } + else /* if (u.ieee.exponent + v.ieee.exponent + <= IEEE854_LONG_DOUBLE_BIAS + LDBL_MANT_DIG) */ + { + if (u.ieee.exponent > v.ieee.exponent) + u.ieee.exponent += 2 * LDBL_MANT_DIG + 2; + else + v.ieee.exponent += 2 * LDBL_MANT_DIG + 2; + if (w.ieee.exponent <= 4 * LDBL_MANT_DIG + 6) + { + if (w.ieee.exponent) + w.ieee.exponent += 2 * LDBL_MANT_DIG + 2; + else + w.d *= 0x1p130L; + adjust = -1; + } + /* Otherwise x * y should just affect inexact + and nothing else. */ + } + x = u.d; + y = v.d; + z = w.d; + } + + /* Ensure correct sign of exact 0 + 0. */ + if (__glibc_unlikely ((x == 0 || y == 0) && z == 0)) + { + x = math_opt_barrier (x); + return x * y + z; + } + + fenv_t env; + feholdexcept (&env); + fesetround (FE_TONEAREST); + + /* Multiplication m1 + m2 = x * y using Dekker's algorithm. */ +#define C ((1LL << (LDBL_MANT_DIG + 1) / 2) + 1) + long double x1 = x * C; + long double y1 = y * C; + long double m1 = x * y; + x1 = (x - x1) + x1; + y1 = (y - y1) + y1; + long double x2 = x - x1; + long double y2 = y - y1; + long double m2 = (((x1 * y1 - m1) + x1 * y2) + x2 * y1) + x2 * y2; + + /* Addition a1 + a2 = z + m1 using Knuth's algorithm. */ + long double a1 = z + m1; + long double t1 = a1 - z; + long double t2 = a1 - t1; + t1 = m1 - t1; + t2 = z - t2; + long double a2 = t1 + t2; + /* Ensure the arithmetic is not scheduled after feclearexcept call. */ + math_force_eval (m2); + math_force_eval (a2); + feclearexcept (FE_INEXACT); + + /* If the result is an exact zero, ensure it has the correct sign. */ + if (a1 == 0 && m2 == 0) + { + feupdateenv (&env); + /* Ensure that round-to-nearest value of z + m1 is not reused. */ + z = math_opt_barrier (z); + return z + m1; + } + + fesetround (FE_TOWARDZERO); + /* Perform m2 + a2 addition with round to odd. */ + u.d = a2 + m2; + + if (__glibc_likely (adjust == 0)) + { + if ((u.ieee.mantissa1 & 1) == 0 && u.ieee.exponent != 0x7fff) + u.ieee.mantissa1 |= fetestexcept (FE_INEXACT) != 0; + feupdateenv (&env); + /* Result is a1 + u.d. */ + return a1 + u.d; + } + else if (__glibc_likely (adjust > 0)) + { + if ((u.ieee.mantissa1 & 1) == 0 && u.ieee.exponent != 0x7fff) + u.ieee.mantissa1 |= fetestexcept (FE_INEXACT) != 0; + feupdateenv (&env); + /* Result is a1 + u.d, scaled up. */ + return (a1 + u.d) * 0x1p64L; + } + else + { + if ((u.ieee.mantissa1 & 1) == 0) + u.ieee.mantissa1 |= fetestexcept (FE_INEXACT) != 0; + v.d = a1 + u.d; + /* Ensure the addition is not scheduled after fetestexcept call. */ + math_force_eval (v.d); + int j = fetestexcept (FE_INEXACT) != 0; + feupdateenv (&env); + /* Ensure the following computations are performed in default rounding + mode instead of just reusing the round to zero computation. */ + asm volatile ("" : "=m" (u) : "m" (u)); + /* If a1 + u.d is exact, the only rounding happens during + scaling down. */ + if (j == 0) + return v.d * 0x1p-130L; + /* If result rounded to zero is not subnormal, no double + rounding will occur. */ + if (v.ieee.exponent > 130) + return (a1 + u.d) * 0x1p-130L; + /* If v.d * 0x1p-130L with round to zero is a subnormal above + or equal to LDBL_MIN / 2, then v.d * 0x1p-130L shifts mantissa + down just by 1 bit, which means v.ieee.mantissa1 |= j would + change the round bit, not sticky or guard bit. + v.d * 0x1p-130L never normalizes by shifting up, + so round bit plus sticky bit should be already enough + for proper rounding. */ + if (v.ieee.exponent == 130) + { + /* If the exponent would be in the normal range when + rounding to normal precision with unbounded exponent + range, the exact result is known and spurious underflows + must be avoided on systems detecting tininess after + rounding. */ + if (TININESS_AFTER_ROUNDING) + { + w.d = a1 + u.d; + if (w.ieee.exponent == 131) + return w.d * 0x1p-130L; + } + /* v.ieee.mantissa1 & 2 is LSB bit of the result before rounding, + v.ieee.mantissa1 & 1 is the round bit and j is our sticky + bit. */ + w.d = 0.0L; + w.ieee.mantissa1 = ((v.ieee.mantissa1 & 3) << 1) | j; + w.ieee.negative = v.ieee.negative; + v.ieee.mantissa1 &= ~3U; + v.d *= 0x1p-130L; + w.d *= 0x1p-2L; + return v.d + w.d; + } + v.ieee.mantissa1 |= j; + return v.d * 0x1p-130L; + } +} +weak_alias (__fmal, fmal) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_frexpl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_frexpl.c new file mode 100644 index 0000000000..799880f373 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_frexpl.c @@ -0,0 +1,61 @@ +/* s_frexpl.c -- long double version of s_frexp.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* + * for non-zero x + * x = frexpl(arg,&exp); + * return a long double fp quantity x such that 0.5 <= |x| <1.0 + * and the corresponding binary exponent "exp". That is + * arg = x*2^exp. + * If arg is inf, 0.0, or NaN, then frexpl(arg,&exp) returns arg + * with *exp=0. + */ + +#include <float.h> +#include <math.h> +#include <math_private.h> + +static const long double +#if LDBL_MANT_DIG == 64 +two65 = 3.68934881474191032320e+19L; /* 0x4040, 0x80000000, 0x00000000 */ +#else +# error "Cannot handle this MANT_DIG" +#endif + + +long double __frexpl(long double x, int *eptr) +{ + u_int32_t se, hx, ix, lx; + GET_LDOUBLE_WORDS(se,hx,lx,x); + ix = 0x7fff&se; + *eptr = 0; + if(ix==0x7fff||((ix|hx|lx)==0)) return x + x; /* 0,inf,nan */ + if (ix==0x0000) { /* subnormal */ + x *= two65; + GET_LDOUBLE_EXP(se,x); + ix = se&0x7fff; + *eptr = -65; + } + *eptr += ix-16382; + se = (se & 0x8000) | 0x3ffe; + SET_LDOUBLE_EXP(x,se); + return x; +} +weak_alias (__frexpl, frexpl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpl.c new file mode 100644 index 0000000000..e323b4c25b --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpl.c @@ -0,0 +1,4 @@ +#define UNSIGNED 0 +#define INEXACT 0 +#define FUNC fromfpl +#include <s_fromfpl_main.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpl_main.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpl_main.c new file mode 100644 index 0000000000..05de1fa6c0 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpl_main.c @@ -0,0 +1,84 @@ +/* Round to integer type. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <errno.h> +#include <fenv.h> +#include <math.h> +#include <math_private.h> +#include <stdbool.h> +#include <stdint.h> + +#define BIAS 0x3fff +#define MANT_DIG 64 + +#if UNSIGNED +# define RET_TYPE uintmax_t +#else +# define RET_TYPE intmax_t +#endif + +#include <fromfp.h> + +RET_TYPE +FUNC (long double x, int round, unsigned int width) +{ + if (width > INTMAX_WIDTH) + width = INTMAX_WIDTH; + uint16_t se; + uint32_t hx, lx; + GET_LDOUBLE_WORDS (se, hx, lx, x); + bool negative = (se & 0x8000) != 0; + if (width == 0) + return fromfp_domain_error (negative, width); + if ((hx | lx) == 0) + return 0; + int exponent = se & 0x7fff; + exponent -= BIAS; + int max_exponent = fromfp_max_exponent (negative, width); + if (exponent > max_exponent) + return fromfp_domain_error (negative, width); + + uint64_t ix = (((uint64_t) hx) << 32) | lx; + uintmax_t uret; + bool half_bit, more_bits; + if (exponent >= MANT_DIG - 1) + { + uret = ix; + /* Exponent 63; no shifting required. */ + half_bit = false; + more_bits = false; + } + else if (exponent >= -1) + { + uint64_t h = 1ULL << (MANT_DIG - 2 - exponent); + half_bit = (ix & h) != 0; + more_bits = (ix & (h - 1)) != 0; + if (exponent == -1) + uret = 0; + else + uret = ix >> (MANT_DIG - 1 - exponent); + } + else + { + uret = 0; + half_bit = false; + more_bits = true; + } + return fromfp_round_and_return (negative, uret, half_bit, more_bits, round, + exponent, max_exponent, width); +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpxl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpxl.c new file mode 100644 index 0000000000..2f3189d7de --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_fromfpxl.c @@ -0,0 +1,4 @@ +#define UNSIGNED 0 +#define INEXACT 1 +#define FUNC fromfpxl +#include <s_fromfpl_main.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_getpayloadl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_getpayloadl.c new file mode 100644 index 0000000000..6efe97baee --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_getpayloadl.c @@ -0,0 +1,32 @@ +/* Get NaN payload. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <stdint.h> + +long double +getpayloadl (const long double *x) +{ + uint16_t se __attribute__ ((unused)); + uint32_t hx, lx; + GET_LDOUBLE_WORDS (se, hx, lx, *x); + hx &= 0x3fffffff; + uint64_t ix = ((uint64_t) hx << 32) | lx; + return (long double) ix; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_iscanonicall.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_iscanonicall.c new file mode 100644 index 0000000000..820a45e3a8 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_iscanonicall.c @@ -0,0 +1,44 @@ +/* Test whether long double value is canonical. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <math_private.h> +#include <stdbool.h> +#include <stdint.h> + +int +__iscanonicall (long double x) +{ + uint32_t se, i0, i1 __attribute__ ((unused)); + + GET_LDOUBLE_WORDS (se, i0, i1, x); + int32_t ix = se & 0x7fff; + bool mant_high = (i0 & 0x80000000) != 0; + + if (LDBL_MIN_EXP == -16381) + /* Intel variant: the high mantissa bit should have a value + determined by the exponent. */ + return ix > 0 ? mant_high : !mant_high; + else + /* M68K variant: both values of the high bit are valid for the + greatest and smallest exponents, while other exponents require + the high bit to be set. */ + return ix == 0 || ix == 0x7fff || mant_high; +} +libm_hidden_def (__iscanonicall) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_issignalingl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_issignalingl.c new file mode 100644 index 0000000000..f659bb7b35 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_issignalingl.c @@ -0,0 +1,44 @@ +/* Test for signaling NaN. + Copyright (C) 2013-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <nan-high-order-bit.h> + +int +__issignalingl (long double x) +{ + u_int32_t exi, hxi, lxi; + GET_LDOUBLE_WORDS (exi, hxi, lxi, x); +#if HIGH_ORDER_BIT_IS_SET_FOR_SNAN +# error not implemented +#else + /* To keep the following comparison simple, toggle the quiet/signaling bit, + so that it is set for sNaNs. This is inverse to IEEE 754-2008 (as well as + common practice for IEEE 754-1985). */ + hxi ^= 0x40000000; + /* If lxi != 0, then set any suitable bit of the significand in hxi. */ + hxi |= (lxi | -lxi) >> 31; + /* We do not recognize a pseudo NaN as sNaN; they're invalid on 80387 and + later. */ + /* We have to compare for greater (instead of greater or equal), because x's + significand being all-zero designates infinity not NaN. */ + return ((exi & 0x7fff) == 0x7fff) && (hxi > 0xc0000000); +#endif +} +libm_hidden_def (__issignalingl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_llrintl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_llrintl.c new file mode 100644 index 0000000000..53d33c3999 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_llrintl.c @@ -0,0 +1,91 @@ +/* Round argument to nearest integral value according to current rounding + direction. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <fenv.h> +#include <limits.h> +#include <math.h> + +#include <math_private.h> + +static const long double two63[2] = +{ + 9.223372036854775808000000e+18, /* 0x403E, 0x00000000, 0x00000000 */ + -9.223372036854775808000000e+18 /* 0xC03E, 0x00000000, 0x00000000 */ +}; + + +long long int +__llrintl (long double x) +{ + int32_t se,j0; + u_int32_t i0, i1; + long long int result; + long double w; + long double t; + int sx; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + + sx = (se >> 15) & 1; + j0 = (se & 0x7fff) - 0x3fff; + + if (j0 < (int32_t) (8 * sizeof (long long int)) - 1) + { + if (j0 >= 63) + result = (((long long int) i0 << 32) | i1) << (j0 - 63); + else + { +#if defined FE_INVALID || defined FE_INEXACT + /* X < LLONG_MAX + 1 implied by J0 < 63. */ + if (x > (long double) LLONG_MAX) + { + /* In the event of overflow we must raise the "invalid" + exception, but not "inexact". */ + t = __nearbyintl (x); + feraiseexcept (t == LLONG_MAX ? FE_INEXACT : FE_INVALID); + } + else +#endif + { + w = two63[sx] + x; + t = w - two63[sx]; + } + GET_LDOUBLE_WORDS (se, i0, i1, t); + j0 = (se & 0x7fff) - 0x3fff; + + if (j0 < 0) + result = 0; + else if (j0 <= 31) + result = i0 >> (31 - j0); + else + result = ((long long int) i0 << (j0 - 31)) | (i1 >> (63 - j0)); + } + } + else + { + /* The number is too large. It is left implementation defined + what happens. */ + return (long long int) x; + } + + return sx ? -result : result; +} + +weak_alias (__llrintl, llrintl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_llroundl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_llroundl.c new file mode 100644 index 0000000000..f113fabd1a --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_llroundl.c @@ -0,0 +1,89 @@ +/* Round long double value to long long int. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <fenv.h> +#include <limits.h> +#include <math.h> + +#include <math_private.h> + + +long long int +__llroundl (long double x) +{ + int32_t j0; + u_int32_t se, i1, i0; + long long int result; + int sign; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + j0 = (se & 0x7fff) - 0x3fff; + sign = (se & 0x8000) != 0 ? -1 : 1; + + if (j0 < 31) + { + if (j0 < 0) + return j0 < -1 ? 0 : sign; + else + { + u_int32_t j = i0 + (0x40000000 >> j0); + if (j < i0) + { + j >>= 1; + j |= 0x80000000; + ++j0; + } + + result = j >> (31 - j0); + } + } + else if (j0 < (int32_t) (8 * sizeof (long long int)) - 1) + { + if (j0 >= 63) + result = (((long long int) i0 << 32) | i1) << (j0 - 63); + else + { + u_int32_t j = i1 + (0x80000000 >> (j0 - 31)); + + result = (long long int) i0; + if (j < i1) + ++result; + + if (j0 > 31) + { + result = (result << (j0 - 31)) | (j >> (63 - j0)); +#ifdef FE_INVALID + if (sign == 1 && result == LLONG_MIN) + /* Rounding brought the value out of range. */ + feraiseexcept (FE_INVALID); +#endif + } + } + } + else + { + /* The number is too large. It is left implementation defined + what happens. */ + return (long long int) x; + } + + return sign * result; +} + +weak_alias (__llroundl, llroundl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_lrintl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_lrintl.c new file mode 100644 index 0000000000..02dafe67f3 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_lrintl.c @@ -0,0 +1,126 @@ +/* Round argument to nearest integral value according to current rounding + direction. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <fenv.h> +#include <limits.h> +#include <math.h> + +#include <math_private.h> + +static const long double two63[2] = +{ + 9.223372036854775808000000e+18, /* 0x403E, 0x00000000, 0x00000000 */ + -9.223372036854775808000000e+18 /* 0xC03E, 0x00000000, 0x00000000 */ +}; + + +long int +__lrintl (long double x) +{ + int32_t se,j0; + u_int32_t i0, i1; + long int result; + long double w; + long double t; + int sx; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + + sx = (se >> 15) & 1; + j0 = (se & 0x7fff) - 0x3fff; + + if (j0 < 31) + { +#if defined FE_INVALID || defined FE_INEXACT + /* X < LONG_MAX + 1 implied by J0 < 31. */ + if (sizeof (long int) == 4 + && x > (long double) LONG_MAX) + { + /* In the event of overflow we must raise the "invalid" + exception, but not "inexact". */ + t = __nearbyintl (x); + feraiseexcept (t == LONG_MAX ? FE_INEXACT : FE_INVALID); + } + else +#endif + { + w = two63[sx] + x; + t = w - two63[sx]; + } + GET_LDOUBLE_WORDS (se, i0, i1, t); + j0 = (se & 0x7fff) - 0x3fff; + + result = (j0 < 0 ? 0 : i0 >> (31 - j0)); + } + else if (j0 < (int32_t) (8 * sizeof (long int)) - 1) + { + if (j0 >= 63) + result = ((long int) i0 << (j0 - 31)) | (i1 << (j0 - 63)); + else + { +#if defined FE_INVALID || defined FE_INEXACT + /* X < LONG_MAX + 1 implied by J0 < 63. */ + if (sizeof (long int) == 8 + && x > (long double) LONG_MAX) + { + /* In the event of overflow we must raise the "invalid" + exception, but not "inexact". */ + t = __nearbyintl (x); + feraiseexcept (t == LONG_MAX ? FE_INEXACT : FE_INVALID); + } + else +#endif + { + w = two63[sx] + x; + t = w - two63[sx]; + } + GET_LDOUBLE_WORDS (se, i0, i1, t); + j0 = (se & 0x7fff) - 0x3fff; + + if (j0 == 31) + result = (long int) i0; + else + result = ((long int) i0 << (j0 - 31)) | (i1 >> (63 - j0)); + } + } + else + { + /* The number is too large. Unless it rounds to LONG_MIN, + FE_INVALID must be raised and the return value is + unspecified. */ +#if defined FE_INVALID || defined FE_INEXACT + if (sizeof (long int) == 4 + && x < (long double) LONG_MIN + && x > (long double) LONG_MIN - 1.0L) + { + /* If truncation produces LONG_MIN, the cast will not raise + the exception, but may raise "inexact". */ + t = __nearbyintl (x); + feraiseexcept (t == LONG_MIN ? FE_INEXACT : FE_INVALID); + return LONG_MIN; + } +#endif + return (long int) x; + } + + return sx ? -result : result; +} + +weak_alias (__lrintl, lrintl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_lroundl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_lroundl.c new file mode 100644 index 0000000000..7f418e6142 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_lroundl.c @@ -0,0 +1,111 @@ +/* Round long double value to long int. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <fenv.h> +#include <limits.h> +#include <math.h> + +#include <math_private.h> + + +long int +__lroundl (long double x) +{ + int32_t j0; + u_int32_t se, i1, i0; + long int result; + int sign; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + j0 = (se & 0x7fff) - 0x3fff; + sign = (se & 0x8000) != 0 ? -1 : 1; + + if (j0 < 31) + { + if (j0 < 0) + return j0 < -1 ? 0 : sign; + else + { + u_int32_t j = i0 + (0x40000000 >> j0); + if (j < i0) + { + j >>= 1; + j |= 0x80000000; + ++j0; + } + + result = j >> (31 - j0); +#ifdef FE_INVALID + if (sizeof (long int) == 4 + && sign == 1 + && result == LONG_MIN) + /* Rounding brought the value out of range. */ + feraiseexcept (FE_INVALID); +#endif + } + } + else if (j0 < (int32_t) (8 * sizeof (long int)) - 1) + { + if (j0 >= 63) + result = ((long int) i0 << (j0 - 31)) | (i1 << (j0 - 63)); + else + { + u_int32_t j = i1 + (0x80000000 >> (j0 - 31)); + unsigned long int ures = i0; + + if (j < i1) + ++ures; + + if (j0 == 31) + result = ures; + else + { + result = (ures << (j0 - 31)) | (j >> (63 - j0)); +#ifdef FE_INVALID + if (sizeof (long int) == 8 + && sign == 1 + && result == LONG_MIN) + /* Rounding brought the value out of range. */ + feraiseexcept (FE_INVALID); +#endif + } + } + } + else + { + /* The number is too large. Unless it rounds to LONG_MIN, + FE_INVALID must be raised and the return value is + unspecified. */ +#ifdef FE_INVALID + if (sizeof (long int) == 4 + && x <= (long double) LONG_MIN - 0.5L) + { + /* If truncation produces LONG_MIN, the cast will not raise + the exception, but may raise "inexact". */ + feraiseexcept (FE_INVALID); + return LONG_MIN; + } +#endif + return (long int) x; + } + + return sign * result; +} + +weak_alias (__lroundl, lroundl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_modfl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_modfl.c new file mode 100644 index 0000000000..e9401d0f5d --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_modfl.c @@ -0,0 +1,73 @@ +/* s_modfl.c -- long double version of s_modf.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * 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,j0; + u_int32_t i,se; + GET_LDOUBLE_WORDS(se,i0,i1,x); + j0 = (se&0x7fff)-0x3fff; /* exponent of x */ + if(j0<32) { /* integer part in high x */ + if(j0<0) { /* |x|<1 */ + SET_LDOUBLE_WORDS(*iptr,se&0x8000,0,0); /* *iptr = +-0 */ + return x; + } else { + i = (0x7fffffff)>>j0; + 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 (__builtin_expect(j0>63, 0)) { /* no fraction part */ + *iptr = x*one; + /* We must handle NaNs separately. */ + if (j0 == 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))>>(j0-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; + } + } +} +weak_alias (__modfl, modfl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nexttoward.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nexttoward.c new file mode 100644 index 0000000000..3d0382eac9 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nexttoward.c @@ -0,0 +1,86 @@ +/* s_nexttoward.c + * Conversion from s_nextafter.c by Ulrich Drepper, Cygnus Support, + * drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* IEEE functions + * nexttoward(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include <errno.h> +#include <math.h> +#include <math_private.h> +#include <float.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 */ + double u; + INSERT_WORDS(x,(esy&0x8000)<<16,1); /* return +-minsub */ + u = math_opt_barrier (x); + u = u * u; + math_force_eval (u); /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if (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 (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) { + double u = x+x; /* overflow */ + math_force_eval (u); + __set_errno (ERANGE); + } + if(hy<0x00100000) { + double u = x*x; /* underflow */ + math_force_eval (u); /* raise underflow flag */ + __set_errno (ERANGE); + } + INSERT_WORDS(x,hx,lx); + return x; +} +weak_alias (__nexttoward, nexttoward) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nexttowardf.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nexttowardf.c new file mode 100644 index 0000000000..ae7538942f --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nexttowardf.c @@ -0,0 +1,74 @@ +/* s_nexttowardf.c -- float version of s_nextafter.c. + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +#include <errno.h> +#include <math.h> +#include <math_private.h> +#include <float.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 */ + float u; + SET_FLOAT_WORD(x,((esy&0x8000)<<16)|1);/* return +-minsub*/ + u = math_opt_barrier (x); + u = u * u; + math_force_eval (u); /* raise underflow flag */ + return x; + } + if(hx>=0) { /* x > 0 */ + if(x > y) { /* x -= ulp */ + hx -= 1; + } else { /* x < y, x += ulp */ + hx += 1; + } + } else { /* x < 0 */ + if(x < y) { /* x -= ulp */ + hx -= 1; + } else { /* x > y, x += ulp */ + hx += 1; + } + } + hy = hx&0x7f800000; + if(hy>=0x7f800000) { + float u = x+x; /* overflow */ + math_force_eval (u); + __set_errno (ERANGE); + } + if(hy<0x00800000) { + float u = x*x; /* underflow */ + math_force_eval (u); /* raise underflow flag */ + __set_errno (ERANGE); + } + SET_FLOAT_WORD(x,hx); + return x; +} +weak_alias (__nexttowardf, nexttowardf) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nextupl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nextupl.c new file mode 100644 index 0000000000..aa66eaf106 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_nextupl.c @@ -0,0 +1,84 @@ +/* Return the least floating-point number greater than X. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> + +/* Return the least floating-point number greater than X. */ +long double +__nextupl (long double x) +{ + u_int32_t hx, ix; + u_int32_t lx; + int32_t esx; + + GET_LDOUBLE_WORDS (esx, hx, lx, x); + ix = esx & 0x7fff; + + if (((ix == 0x7fff) && (((hx & 0x7fffffff) | lx) != 0))) /* x is nan. */ + return x + x; + if ((ix | hx | lx) == 0) + return LDBL_TRUE_MIN; + if (esx >= 0) + { /* x > 0. */ + if (isinf (x)) + return x; + lx += 1; + if (lx == 0) + { + hx += 1; +#if LDBL_MIN_EXP == -16381 + if (hx == 0 || (esx == 0 && hx == 0x80000000)) +#else + if (hx == 0) +#endif + { + esx += 1; + hx |= 0x80000000; + } + } + } + else + { /* x < 0. */ + if (lx == 0) + { +#if LDBL_MIN_EXP == -16381 + if (hx <= 0x80000000 && esx != 0xffff8000) + { + esx -= 1; + hx = hx - 1; + if ((esx & 0x7fff) > 0) + hx |= 0x80000000; + } + else + hx -= 1; +#else + if (ix != 0 && hx == 0x80000000) + hx = 0; + if (hx == 0) + esx -= 1; + hx -= 1; +#endif + } + lx -= 1; + } + SET_LDOUBLE_WORDS (x, esx, hx, lx); + return x; +} + +weak_alias (__nextupl, nextupl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_remquol.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_remquol.c new file mode 100644 index 0000000000..ee9a6a7d2a --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_remquol.c @@ -0,0 +1,111 @@ +/* Compute remainder and a congruent to the quotient. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> + +#include <math_private.h> + + +static const long double zero = 0.0; + + +long double +__remquol (long double x, long double p, int *quo) +{ + int32_t ex,ep,hx,hp; + u_int32_t sx,lx,lp; + int cquo,qs; + + GET_LDOUBLE_WORDS (ex, hx, lx, x); + GET_LDOUBLE_WORDS (ep, hp, lp, p); + sx = ex & 0x8000; + qs = (sx ^ (ep & 0x8000)) >> 15; + ep &= 0x7fff; + ex &= 0x7fff; + + /* Purge off exception values. */ + if ((ep | hp | lp) == 0) + return (x * p) / (x * p); /* p = 0 */ + if ((ex == 0x7fff) /* x not finite */ + || ((ep == 0x7fff) /* p is NaN */ + && (((hp & 0x7fffffff) | lp) != 0))) + return (x * p) / (x * p); + + if (ep <= 0x7ffb) + x = __ieee754_fmodl (x, 8 * p); /* now x < 8p */ + + if (((ex - ep) | (hx - hp) | (lx - lp)) == 0) + { + *quo = qs ? -1 : 1; + return zero * x; + } + + x = fabsl (x); + p = fabsl (p); + cquo = 0; + + if (ep <= 0x7ffc && x >= 4 * p) + { + x -= 4 * p; + cquo += 4; + } + if (ep <= 0x7ffd && x >= 2 * p) + { + x -= 2 * p; + cquo += 2; + } + + if (ep < 0x0002) + { + if (x + x > p) + { + x -= p; + ++cquo; + if (x + x >= p) + { + x -= p; + ++cquo; + } + } + } + else + { + long double p_half = 0.5 * p; + if (x > p_half) + { + x -= p; + ++cquo; + if (x >= p_half) + { + x -= p; + ++cquo; + } + } + } + + *quo = qs ? -cquo : cquo; + + /* Ensure correct sign of zero result in round-downward mode. */ + if (x == 0.0L) + x = 0.0L; + if (sx) + x = -x; + return x; +} +weak_alias (__remquol, remquol) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_roundevenl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_roundevenl.c new file mode 100644 index 0000000000..dab6aa6558 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_roundevenl.c @@ -0,0 +1,124 @@ +/* Round to nearest integer value, rounding halfway cases to even. + ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <stdint.h> + +#define BIAS 0x3fff +#define MANT_DIG 64 +#define MAX_EXP (2 * BIAS + 1) + +long double +roundevenl (long double x) +{ + uint16_t se; + uint32_t hx, lx; + GET_LDOUBLE_WORDS (se, hx, lx, x); + int exponent = se & 0x7fff; + if (exponent >= BIAS + MANT_DIG - 1) + { + /* Integer, infinity or NaN. */ + if (exponent == MAX_EXP) + /* Infinity or NaN; quiet signaling NaNs. */ + return x + x; + else + return x; + } + else if (exponent >= BIAS + MANT_DIG - 32) + { + /* Not necessarily an integer; integer bit is in low word. + Locate the bits with exponents 0 and -1. */ + int int_pos = (BIAS + MANT_DIG - 1) - exponent; + int half_pos = int_pos - 1; + uint32_t half_bit = 1U << half_pos; + uint32_t int_bit = 1U << int_pos; + if ((lx & (int_bit | (half_bit - 1))) != 0) + { + /* No need to test whether HALF_BIT is set. */ + lx += half_bit; + if (lx < half_bit) + { + hx++; + if (hx == 0) + { + hx = 0x80000000; + se++; + } + } + } + lx &= ~(int_bit - 1); + } + else if (exponent == BIAS + MANT_DIG - 33) + { + /* Not necessarily an integer; integer bit is bottom of high + word, half bit is top of low word. */ + if (((hx & 1) | (lx & 0x7fffffff)) != 0) + { + lx += 0x80000000; + if (lx < 0x80000000) + { + hx++; + if (hx == 0) + { + hx = 0x80000000; + se++; + } + } + } + lx = 0; + } + else if (exponent >= BIAS) + { + /* At least 1; not necessarily an integer, integer bit and half + bit are in the high word. Locate the bits with exponents 0 + and -1. */ + int int_pos = (BIAS + MANT_DIG - 33) - exponent; + int half_pos = int_pos - 1; + uint32_t half_bit = 1U << half_pos; + uint32_t int_bit = 1U << int_pos; + if (((hx & (int_bit | (half_bit - 1))) | lx) != 0) + { + hx += half_bit; + if (hx < half_bit) + { + hx = 0x80000000; + se++; + } + } + hx &= ~(int_bit - 1); + lx = 0; + } + else if (exponent == BIAS - 1 && (hx > 0x80000000 || lx != 0)) + { + /* Interval (0.5, 1). */ + se = (se & 0x8000) | 0x3fff; + hx = 0x80000000; + lx = 0; + } + else + { + /* Rounds to 0. */ + se &= 0x8000; + hx = 0; + lx = 0; + } + SET_LDOUBLE_WORDS (x, se, hx, lx); + return x; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_roundl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_roundl.c new file mode 100644 index 0000000000..d8918d2874 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_roundl.c @@ -0,0 +1,92 @@ +/* Round long double to integer away from zero. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> + +#include <math_private.h> + + +long double +__roundl (long double x) +{ + int32_t j0; + u_int32_t se, i1, i0; + + GET_LDOUBLE_WORDS (se, i0, i1, x); + j0 = (se & 0x7fff) - 0x3fff; + if (j0 < 31) + { + if (j0 < 0) + { + se &= 0x8000; + i0 = i1 = 0; + if (j0 == -1) + { + se |= 0x3fff; + i0 = 0x80000000; + } + } + else + { + u_int32_t i = 0x7fffffff >> j0; + if (((i0 & i) | i1) == 0) + /* X is integral. */ + return x; + + u_int32_t j = i0 + (0x40000000 >> j0); + if (j < i0) + se += 1; + i0 = (j & ~i) | 0x80000000; + i1 = 0; + } + } + else if (j0 > 62) + { + if (j0 == 0x4000) + /* Inf or NaN. */ + return x + x; + else + return x; + } + else + { + u_int32_t i = 0xffffffff >> (j0 - 31); + if ((i1 & i) == 0) + /* X is integral. */ + return x; + + u_int32_t j = i1 + (1 << (62 - j0)); + if (j < i1) + { + u_int32_t k = i0 + 1; + if (k < i0) + { + se += 1; + k |= 0x80000000; + } + i0 = k; + } + i1 = j; + i1 &= ~i; + } + + SET_LDOUBLE_WORDS (x, se, i0, i1); + return x; +} +weak_alias (__roundl, roundl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_scalblnl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_scalblnl.c new file mode 100644 index 0000000000..457e999c6c --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_scalblnl.c @@ -0,0 +1,60 @@ +/* s_scalbnl.c -- long double version of s_scalbn.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * scalbnl (long double x, int n) + * scalbnl(x,n) returns x* 2**n computed by exponent + * manipulation rather than by actually performing an + * exponentiation or a multiplication. + */ + +#include <math.h> +#include <math_private.h> + +static const long double +two63 = 0x1p63L, +twom64 = 0x1p-64L, +huge = 1.0e+4900L, +tiny = 1.0e-4900L; + +long double +__scalblnl (long double x, long int n) +{ + int32_t k,es,hx,lx; + GET_LDOUBLE_WORDS(es,hx,lx,x); + k = es&0x7fff; /* extract exponent */ + if (__builtin_expect(k==0, 0)) { /* 0 or subnormal x */ + if ((lx|(hx&0x7fffffff))==0) return x; /* +-0 */ + x *= two63; + GET_LDOUBLE_EXP(es,x); + k = (es&0x7fff) - 63; + } + if (__builtin_expect(k==0x7fff, 0)) return x+x; /* NaN or Inf */ + if (__builtin_expect(n< -50000, 0)) + return tiny*__copysignl(tiny,x); + if (__builtin_expect(n> 50000 || k+n > 0x7ffe, 0)) + return huge*__copysignl(huge,x); /* overflow */ + /* Now k and n are bounded we know that k = k+n does not + overflow. */ + k = k+n; + if (__builtin_expect(k > 0, 1)) /* normal result */ + {SET_LDOUBLE_EXP(x,(es&0x8000)|k); return x;} + if (k <= -64) + return tiny*__copysignl(tiny,x); /*underflow*/ + k += 64; /* subnormal result */ + SET_LDOUBLE_EXP(x,(es&0x8000)|k); + return x*twom64; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadl.c new file mode 100644 index 0000000000..1aba33e6e2 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadl.c @@ -0,0 +1,3 @@ +#define SIG 0 +#define FUNC setpayloadl +#include <s_setpayloadl_main.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadl_main.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadl_main.c new file mode 100644 index 0000000000..c2fd0401d7 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadl_main.c @@ -0,0 +1,68 @@ +/* Set NaN payload. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <nan-high-order-bit.h> +#include <stdint.h> + +#define SET_HIGH_BIT (HIGH_ORDER_BIT_IS_SET_FOR_SNAN ? SIG : !SIG) +#define BIAS 0x3fff +#define PAYLOAD_DIG 62 +#define EXPLICIT_MANT_DIG 63 + +int +FUNC (long double *x, long double payload) +{ + uint32_t hx, lx; + uint16_t exponent; + GET_LDOUBLE_WORDS (exponent, hx, lx, payload); + /* Test if argument is (a) negative or too large; (b) too small, + except for 0 when allowed; (c) not an integer. */ + if (exponent >= BIAS + PAYLOAD_DIG + || (exponent < BIAS && !(SET_HIGH_BIT + && exponent == 0 && hx == 0 && lx == 0))) + { + SET_LDOUBLE_WORDS (*x, 0, 0, 0); + return 1; + } + int shift = BIAS + EXPLICIT_MANT_DIG - exponent; + if (shift < 32 + ? (lx & ((1U << shift) - 1)) != 0 + : (lx != 0 || (hx & ((1U << (shift - 32)) - 1)) != 0)) + { + SET_LDOUBLE_WORDS (*x, 0, 0, 0); + return 1; + } + if (exponent != 0) + { + if (shift >= 32) + { + lx = hx >> (shift - 32); + hx = 0; + } + else if (shift != 0) + { + lx = (lx >> shift) | (hx << (32 - shift)); + hx >>= shift; + } + } + hx |= 0x80000000 | (SET_HIGH_BIT ? 0x40000000 : 0); + SET_LDOUBLE_WORDS (*x, 0x7fff, hx, lx); + return 0; +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadsigl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadsigl.c new file mode 100644 index 0000000000..d97e2c8206 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_setpayloadsigl.c @@ -0,0 +1,3 @@ +#define SIG 1 +#define FUNC setpayloadsigl +#include <s_setpayloadl_main.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_signbitl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_signbitl.c new file mode 100644 index 0000000000..d430eb8600 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_signbitl.c @@ -0,0 +1,26 @@ +/* Return nonzero value if number is negative. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> + +int +__signbitl (long double x) +{ + return __builtin_signbitl (x); +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_sincosl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_sincosl.c new file mode 100644 index 0000000000..7d33c97162 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_sincosl.c @@ -0,0 +1,76 @@ +/* Compute sine and cosine of argument. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <errno.h> +#include <math.h> + +#include <math_private.h> + + +void +__sincosl (long double x, long double *sinx, long double *cosx) +{ + int32_t se, i0, i1 __attribute__ ((unused)); + + /* High word of x. */ + GET_LDOUBLE_WORDS (se, i0, i1, x); + + /* |x| ~< pi/4 */ + se &= 0x7fff; + if (se < 0x3ffe || (se == 0x3ffe && i0 <= 0xc90fdaa2)) + { + *sinx = __kernel_sinl (x, 0.0, 0); + *cosx = __kernel_cosl (x, 0.0); + } + else if (se == 0x7fff) + { + /* sin(Inf or NaN) is NaN */ + *sinx = *cosx = x - x; + if (isinf (x)) + __set_errno (EDOM); + } + else + { + /* Argument reduction needed. */ + long double y[2]; + int n; + + n = __ieee754_rem_pio2l (x, y); + switch (n & 3) + { + case 0: + *sinx = __kernel_sinl (y[0], y[1], 1); + *cosx = __kernel_cosl (y[0], y[1]); + break; + case 1: + *sinx = __kernel_cosl (y[0], y[1]); + *cosx = -__kernel_sinl (y[0], y[1], 1); + break; + case 2: + *sinx = -__kernel_sinl (y[0], y[1], 1); + *cosx = -__kernel_cosl (y[0], y[1]); + break; + default: + *sinx = -__kernel_cosl (y[0], y[1]); + *cosx = __kernel_sinl (y[0], y[1], 1); + break; + } + } +} +weak_alias (__sincosl, sincosl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_sinl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_sinl.c new file mode 100644 index 0000000000..11e1899822 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_sinl.c @@ -0,0 +1,88 @@ +/* s_sinl.c -- long double version of s_sin.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* sinl(x) + * Return sine function of x. + * + * kernel function: + * __kernel_sinl ... sine function on [-pi/4,pi/4] + * __kernel_cosl ... cose function on [-pi/4,pi/4] + * __ieee754_rem_pio2l ... argument reduction routine + * + * Method. + * Let S,C and T denote the sin, cos and tan respectively on + * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 + * in [-pi/4 , +pi/4], and let n = k mod 4. + * We have + * + * n sin(x) cos(x) tan(x) + * ---------------------------------------------------------- + * 0 S C T + * 1 C -S -1/T + * 2 -S -C T + * 3 -C S -1/T + * ---------------------------------------------------------- + * + * Special cases: + * Let trig be any of sin, cos, or tan. + * trig(+-INF) is NaN, with signals; + * trig(NaN) is that NaN; + * + * Accuracy: + * TRIG(x) returns trig(x) nearly rounded + */ + +#include <errno.h> +#include <math.h> +#include <math_private.h> + +long double __sinl(long double x) +{ + long double y[2],z=0.0; + int32_t n, se, i0, i1; + + /* High word of x. */ + GET_LDOUBLE_WORDS(se,i0,i1,x); + + /* |x| ~< pi/4 */ + se &= 0x7fff; + if(se < 0x3ffe || (se == 0x3ffe && i0 <= 0xc90fdaa2)) + return __kernel_sinl(x,z,0); + + /* sin(Inf or NaN) is NaN */ + else if (se==0x7fff) { + if (i1 == 0 && i0 == 0x80000000) + __set_errno (EDOM); + return x-x; + } + + /* argument reduction needed */ + else { + n = __ieee754_rem_pio2l(x,y); + switch(n&3) { + case 0: return __kernel_sinl(y[0],y[1],1); + case 1: return __kernel_cosl(y[0],y[1]); + case 2: return -__kernel_sinl(y[0],y[1],1); + default: + return -__kernel_cosl(y[0],y[1]); + } + } +} +weak_alias (__sinl, sinl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_tanhl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_tanhl.c new file mode 100644 index 0000000000..38edf9f75e --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_tanhl.c @@ -0,0 +1,90 @@ +/* s_tanhl.c -- long double version of s_tanh.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* 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 <float.h> +#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 j0,j1,ix; + + /* High word of |x|. */ + GET_LDOUBLE_WORDS(se,j0,j1,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 && j0 < 0xb8000000u)) {/* |x|<23 */ + if ((ix|j0|j1) == 0) + return x; /* x == +- 0 */ + if (ix<0x3fc8) /* |x|<2**-55 */ + { + math_check_force_underflow (x); + 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; +} +weak_alias (__tanhl, tanhl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_tanl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_tanl.c new file mode 100644 index 0000000000..3fbe4a8f6b --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_tanl.c @@ -0,0 +1,81 @@ +/* s_tanl.c -- long double version of s_tan.c. + * Conversion to long double by Ulrich Drepper, + * Cygnus Support, drepper@cygnus.com. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#if defined(LIBM_SCCS) && !defined(lint) +static char rcsid[] = "$NetBSD: $"; +#endif + +/* tanl(x) + * Return tangent function of x. + * + * kernel function: + * __kernel_tanl ... tangent function on [-pi/4,pi/4] + * __ieee754_rem_pio2l ... argument reduction routine + * + * Method. + * Let S,C and T denote the sin, cos and tan respectively on + * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2 + * in [-pi/4 , +pi/4], and let n = k mod 4. + * We have + * + * n sin(x) cos(x) tan(x) + * ---------------------------------------------------------- + * 0 S C T + * 1 C -S -1/T + * 2 -S -C T + * 3 -C S -1/T + * ---------------------------------------------------------- + * + * Special cases: + * Let trig be any of sin, cos, or tan. + * trig(+-INF) is NaN, with signals; + * trig(NaN) is that NaN; + * + * Accuracy: + * TRIG(x) returns trig(x) nearly rounded + */ + +#include <errno.h> +#include <math.h> +#include <math_private.h> + +long double __tanl(long double x) +{ + long double y[2],z=0.0; + int32_t n, se, i0, i1; + + /* High word of x. */ + GET_LDOUBLE_WORDS(se,i0,i1,x); + + /* |x| ~< pi/4 */ + se &= 0x7fff; + if(se <= 0x3ffe) return __kernel_tanl(x,z,1); + + /* tan(Inf or NaN) is NaN */ + else if (se==0x7fff) { + if (i1 == 0 && i0 == 0x80000000) + __set_errno (EDOM); + return x-x; + } + + /* argument reduction needed */ + else { + n = __ieee754_rem_pio2l(x,y); + return __kernel_tanl(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even + -1 -- n odd */ + } +} +weak_alias (__tanl, tanl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_totalorderl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_totalorderl.c new file mode 100644 index 0000000000..16accad1ff --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_totalorderl.c @@ -0,0 +1,57 @@ +/* Total order operation. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <math_private.h> +#include <nan-high-order-bit.h> +#include <stdint.h> + +int +totalorderl (long double x, long double y) +{ + int16_t expx, expy; + uint32_t hx, hy; + uint32_t lx, ly; + GET_LDOUBLE_WORDS (expx, hx, lx, x); + GET_LDOUBLE_WORDS (expy, hy, ly, y); + if (LDBL_MIN_EXP == -16382) + { + /* M68K variant: for the greatest exponent, the high mantissa + bit is not significant and both values of it are valid, so + set it before comparing. For the Intel variant, only one + value of the high mantissa bit is valid for each exponent, so + this is not necessary. */ + if ((expx & 0x7fff) == 0x7fff) + hx |= 0x80000000; + if ((expy & 0x7fff) == 0x7fff) + hy |= 0x80000000; + } +#if HIGH_ORDER_BIT_IS_SET_FOR_SNAN +# error not implemented +#endif + uint32_t x_sign = expx >> 15; + uint32_t y_sign = expy >> 15; + expx ^= x_sign >> 17; + hx ^= x_sign; + lx ^= x_sign; + expy ^= y_sign >> 17; + hy ^= y_sign; + ly ^= y_sign; + return expx < expy || (expx == expy && (hx < hy || (hx == hy && lx <= ly))); +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_totalordermagl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_totalordermagl.c new file mode 100644 index 0000000000..6b370b2ade --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_totalordermagl.c @@ -0,0 +1,51 @@ +/* Total order operation on absolute values. ldbl-96 version. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <math_private.h> +#include <nan-high-order-bit.h> +#include <stdint.h> + +int +totalordermagl (long double x, long double y) +{ + uint16_t expx, expy; + uint32_t hx, hy; + uint32_t lx, ly; + GET_LDOUBLE_WORDS (expx, hx, lx, x); + GET_LDOUBLE_WORDS (expy, hy, ly, y); + expx &= 0x7fff; + expy &= 0x7fff; + if (LDBL_MIN_EXP == -16382) + { + /* M68K variant: for the greatest exponent, the high mantissa + bit is not significant and both values of it are valid, so + set it before comparing. For the Intel variant, only one + value of the high mantissa bit is valid for each exponent, so + this is not necessary. */ + if (expx == 0x7fff) + hx |= 0x80000000; + if (expy == 0x7fff) + hy |= 0x80000000; + } +#if HIGH_ORDER_BIT_IS_SET_FOR_SNAN +# error not implemented +#endif + return expx < expy || (expx == expy && (hx < hy || (hx == hy && lx <= ly))); +} diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_ufromfpl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_ufromfpl.c new file mode 100644 index 0000000000..c686daa4a7 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_ufromfpl.c @@ -0,0 +1,4 @@ +#define UNSIGNED 1 +#define INEXACT 0 +#define FUNC ufromfpl +#include <s_fromfpl_main.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/s_ufromfpxl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_ufromfpxl.c new file mode 100644 index 0000000000..906066c83c --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/s_ufromfpxl.c @@ -0,0 +1,4 @@ +#define UNSIGNED 1 +#define INEXACT 1 +#define FUNC ufromfpxl +#include <s_fromfpl_main.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/strtod_nan_ldouble.h b/REORG.TODO/sysdeps/ieee754/ldbl-96/strtod_nan_ldouble.h new file mode 100644 index 0000000000..e847b13b40 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/strtod_nan_ldouble.h @@ -0,0 +1,30 @@ +/* Convert string for NaN payload to corresponding NaN. For ldbl-96. + Copyright (C) 1997-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#define FLOAT long double +#define SET_MANTISSA(flt, mant) \ + do \ + { \ + union ieee854_long_double u; \ + u.d = (flt); \ + u.ieee_nan.mantissa0 = (mant) >> 32; \ + u.ieee_nan.mantissa1 = (mant); \ + if ((u.ieee.mantissa0 | u.ieee.mantissa1) != 0) \ + (flt) = u.d; \ + } \ + while (0) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/strtold_l.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/strtold_l.c new file mode 100644 index 0000000000..251f91ba9d --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/strtold_l.c @@ -0,0 +1,37 @@ +/* Copyright (C) 1999-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> + +/* The actual implementation for all floating point sizes is in strtod.c. + These macros tell it to produce the `long double' version, `strtold'. */ + +#define FLOAT long double +#define FLT LDBL +#ifdef USE_WIDE_CHAR +# define STRTOF wcstold_l +# define __STRTOF __wcstold_l +# define STRTOF_NAN __wcstold_nan +#else +# define STRTOF strtold_l +# define __STRTOF __strtold_l +# define STRTOF_NAN __strtold_nan +#endif +#define MPN2FLOAT __mpn_construct_long_double +#define FLOAT_HUGE_VAL HUGE_VALL + +#include <stdlib/strtod_l.c> diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/t_sincosl.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/t_sincosl.c new file mode 100644 index 0000000000..77bf9cfdba --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/t_sincosl.c @@ -0,0 +1,483 @@ +/* Extended-precision floating point sine and cosine tables. + Copyright (C) 1999-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Based on quad-precision tables by Jakub Jelinek <jj@ultra.linux.cz> + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +/* For 0.1484375 + n/128.0, n=0..82 this table contains + first 64 bits of cosine, then at least 64 additional + bits and the same for sine. + 0.1484375+82.0/128.0 is the smallest number among above defined numbers + larger than pi/4. + Computed using MPFR: + + #include <stdio.h> + #include <mpfr.h> + + int + main (void) + { + int j; + mpfr_t t, b, i, rs, rc, ts, tc, tsl, tcl; + mpfr_init2 (b, 64); + mpfr_init2 (i, 64); + mpfr_init2 (t, 64); + mpfr_set_str (b, "0.1484375", 0, MPFR_RNDN); + mpfr_set_str (i, "0x1p-7", 0, MPFR_RNDN); + mpfr_init2 (rs, 300); + mpfr_init2 (rc, 300); + mpfr_init2 (ts, 64); + mpfr_init2 (tc, 64); + mpfr_init2 (tsl, 64); + mpfr_init2 (tcl, 64); + for (j = 0; j <= 82; j++) + { + mpfr_mul_ui (t, i, j, MPFR_RNDN); + mpfr_add (t, t, b, MPFR_RNDN); + printf (" /" "* x = 0.1484375 + %d/128. *" "/\n", j); + mpfr_cos (rc, t, MPFR_RNDN); + mpfr_sin (rs, t, MPFR_RNDN); + mpfr_set (tc, rc, MPFR_RNDN); + mpfr_set (ts, rs, MPFR_RNDN); + mpfr_sub (tcl, rc, tc, MPFR_RNDN); + mpfr_sub (tsl, rs, ts, MPFR_RNDN); + mpfr_printf (" %.17RaL,\n", tc); + mpfr_printf (" %.17RaL,\n", tcl); + mpfr_printf (" %.17RaL,\n", ts); + mpfr_printf (" %.17RaL,\n", tsl); + } + return 0; + } + +*/ + +const long double __sincosl_table[] = { + /* x = 0.1484375 + 0/128. */ + 0xf.d2f5320e1b7902100p-4L, + -0x6.4b225d06708635580p-68L, + 0x2.5dc50bc95711d0d80p-4L, + 0x1.787d108fd438cf5a0p-68L, + /* x = 0.1484375 + 1/128. */ + 0xf.ce1a053e621438b00p-4L, + 0x6.d60c76e8c45bf0a80p-68L, + 0x2.7d66258bacd96a400p-4L, + -0x1.4cca4c9a3782a6bc0p-68L, + /* x = 0.1484375 + 2/128. */ + 0xf.c8ffa01ba68074100p-4L, + 0x7.e05962b0d9fdf2000p-68L, + 0x2.9cfd49b8be4f66540p-4L, + -0x1.89354fe340fbd96c0p-68L, + /* x = 0.1484375 + 3/128. */ + 0xf.c3a6170f767ac7300p-4L, + 0x5.d63d99a9d439e1d80p-68L, + 0x2.bc89f9f424de54840p-4L, + 0x1.de7ce03b2514952c0p-68L, + /* x = 0.1484375 + 4/128. */ + 0xf.be0d7f7fef11e7100p-4L, + -0x5.5bc47540b095ba800p-68L, + 0x2.dc0bb80b49a97ffc0p-4L, + -0xc.b1722e07246208500p-72L, + /* x = 0.1484375 + 5/128. */ + 0xf.b835efcf670dd2d00p-4L, + -0x1.90186db968115ec20p-68L, + 0x2.fb8205f75e56a2b40p-4L, + 0x1.6a1c4792f85625880p-68L, + /* x = 0.1484375 + 6/128. */ + 0xf.b21f7f5c156696b00p-4L, + 0xa.c1fe28ac5fd766700p-76L, + 0x3.1aec65df552876f80p-4L, + 0x2.ece9a235671324700p-72L, + /* x = 0.1484375 + 7/128. */ + 0xf.abca467fb3cb8f200p-4L, + -0x2.f960fe2715cc521c0p-68L, + 0x3.3a4a5a19d86246700p-4L, + 0x1.0f602c44df4fa5140p-68L, + /* x = 0.1484375 + 8/128. */ + 0xf.a5365e8f1d3ca2800p-4L, + -0x4.1e24a289519b26800p-68L, + 0x3.599b652f40ec999c0p-4L, + 0x1.f12a0a4c8561de160p-68L, + /* x = 0.1484375 + 9/128. */ + 0xf.9e63e1d9e8b6f6f00p-4L, + 0x2.e296bae5b5ed9c100p-68L, + 0x3.78df09db8c332ce00p-4L, + 0xd.2b53d865582e45200p-72L, + /* x = 0.1484375 + 10/128. */ + 0xf.9752eba9fff6b9900p-4L, + -0x7.bd415254fab56cd00p-68L, + 0x3.9814cb10513453cc0p-4L, + -0x6.84de43e3595cc8500p-72L, + /* x = 0.1484375 + 11/128. */ + 0xf.90039843324f9b900p-4L, + 0x4.0416c1984b6cbed00p-68L, + 0x3.b73c2bf6b4b9f6680p-4L, + 0xe.f9499c81f0d965100p-72L, + /* x = 0.1484375 + 12/128. */ + 0xf.887604e2c39dbb200p-4L, + 0xe.4ec5825059a78a000p-72L, + 0x3.d654aff15cb457a00p-4L, + 0xf.ca854698aba330400p-72L, + /* x = 0.1484375 + 13/128. */ + 0xf.80aa4fbef750ba800p-4L, + -0x7.c2cc346a06b075c00p-68L, + 0x3.f55dda9e62aed7500p-4L, + 0x1.3bd7b8e6a3d1635e0p-68L, + /* x = 0.1484375 + 14/128. */ + 0xf.78a098069792dab00p-4L, + -0x4.3611bda6e483a5980p-68L, + 0x4.14572fd94556e6480p-4L, + -0xc.29dfd8ec7722b8400p-72L, + /* x = 0.1484375 + 15/128. */ + 0xf.7058fde0788dfc800p-4L, + 0x5.b8fe88789e4f42500p-72L, + 0x4.334033bcd90d66080p-4L, + -0x3.0a0c93e2b47bbae40p-68L, + /* x = 0.1484375 + 16/128. */ + 0xf.67d3a26af7d07aa00p-4L, + 0x4.bd6d42af8c0068000p-68L, + 0x4.52186aa5377ab2080p-4L, + 0x3.bf2524f52e3a06a80p-68L, + /* x = 0.1484375 + 17/128. */ + 0xf.5f10a7bb77d3dfa00p-4L, + 0xc.1da8b578427832800p-72L, + 0x4.70df5931ae1d94600p-4L, + 0x7.6fe0dcff47fe31b80p-72L, + /* x = 0.1484375 + 18/128. */ + 0xf.561030ddd7a789600p-4L, + 0xe.a9f4a32c652155500p-72L, + 0x4.8f948446abcd6b100p-4L, + -0x8.0334eff185e4d9100p-72L, + /* x = 0.1484375 + 19/128. */ + 0xf.4cd261d3e6c15bb00p-4L, + 0x3.69c8758630d2ac000p-68L, + 0x4.ae37710fad27c8a80p-4L, + 0x2.9c4cf96c03519b9c0p-68L, + /* x = 0.1484375 + 20/128. */ + 0xf.43575f94d4f6b2700p-4L, + 0x2.f5fb76b14d2a64ac0p-68L, + 0x4.ccc7a50127e1de100p-4L, + -0x3.494bf3cfd39ae0840p-68L, + /* x = 0.1484375 + 21/128. */ + 0xf.399f500c9e9fd3800p-4L, + -0x5.166a8d9c254778900p-68L, + 0x4.eb44a5da74f600200p-4L, + 0x7.aaa090f0734e28880p-72L, + /* x = 0.1484375 + 22/128. */ + 0xf.2faa5a1b74e82fd00p-4L, + 0x6.1fa05f9177380e900p-68L, + 0x5.09adf9a7b9a5a0f80p-4L, + -0x1.c75705c59f5e66be0p-68L, + /* x = 0.1484375 + 23/128. */ + 0xf.2578a595224dd2e00p-4L, + 0x6.bfa2eb2f99cc67500p-68L, + 0x5.280326c3cf4818200p-4L, + 0x3.ba6bb08eac82c2080p-68L, + /* x = 0.1484375 + 24/128. */ + 0xf.1b0a5b406b526d900p-4L, + -0x7.93aa0152372f23380p-68L, + 0x5.4643b3da29de9b380p-4L, + -0x2.8eaa110f0ccd04c00p-68L, + /* x = 0.1484375 + 25/128. */ + 0xf.105fa4d66b607a600p-4L, + 0x7.d44e0427252044380p-68L, + 0x5.646f27e8bd65cbe00p-4L, + 0x3.a5d61ff0657229100p-68L, + /* x = 0.1484375 + 26/128. */ + 0xf.0578ad01ede708000p-4L, + -0x5.c63f6239467b50100p-68L, + 0x5.82850a41e1dd46c80p-4L, + -0x9.fd15dbb3244403200p-76L, + /* x = 0.1484375 + 27/128. */ + 0xe.fa559f5ec3aec3a00p-4L, + 0x4.eb03319278a2d4200p-68L, + 0x5.a084e28e35fda2780p-4L, + -0x9.202444aace28b3100p-72L, + /* x = 0.1484375 + 28/128. */ + 0xe.eef6a879146af0c00p-4L, + -0x6.46a15d15f53f2c200p-72L, + 0x5.be6e38ce809554280p-4L, + 0x3.c14ee9da0d3648400p-68L, + /* x = 0.1484375 + 29/128. */ + 0xe.e35bf5ccac8905300p-4L, + -0x3.26e2248cb2c5b81c0p-68L, + 0x5.dc40955d9084f4880p-4L, + 0x2.94675a2498de5d840p-68L, + /* x = 0.1484375 + 30/128. */ + 0xe.d785b5c44741b4500p-4L, + -0x6.c3a943462cc75eb00p-68L, + 0x5.f9fb80f21b5364a00p-4L, + -0x3.bcdabf5af1dd3ad00p-68L, + /* x = 0.1484375 + 31/128. */ + 0xe.cb7417b8d4ee3ff00p-4L, + -0x3.c8545bf8c55b70e00p-68L, + 0x6.179e84a09a5258a80p-4L, + -0x3.f164a0531fc1ada00p-68L, + /* x = 0.1484375 + 32/128. */ + 0xe.bf274bf0bda4f6200p-4L, + 0x4.47e56a09362679900p-68L, + 0x6.352929dd264bd4480p-4L, + 0x2.02ea766325d8aa8c0p-68L, + /* x = 0.1484375 + 33/128. */ + 0xe.b29f839f201fd1400p-4L, + -0x4.6c8697d86e9587100p-68L, + 0x6.529afa7d51b129600p-4L, + 0x3.1ec197c0a840a11c0p-68L, + /* x = 0.1484375 + 34/128. */ + 0xe.a5dcf0e30cf03e700p-4L, + -0x6.8910f4e13d9aea080p-68L, + 0x6.6ff380ba014410a00p-4L, + -0x1.c65cdf4f5c05a02a0p-68L, + /* x = 0.1484375 + 35/128. */ + 0xe.98dfc6c6be031e600p-4L, + 0xd.d3089cbdd18a75b00p-72L, + 0x6.8d324731433279700p-4L, + 0x3.bc712bcc4ccddc480p-68L, + /* x = 0.1484375 + 36/128. */ + 0xe.8ba8393eca7821b00p-4L, + -0x5.a9c27cb6e49efee80p-68L, + 0x6.aa56d8e8249db4e80p-4L, + 0x3.60a761fe3f9e559c0p-68L, + /* x = 0.1484375 + 37/128. */ + 0xe.7e367d2956cfb1700p-4L, + -0x4.955ee1abe632ffa80p-68L, + 0x6.c760c14c8585a5200p-4L, + -0x2.42cb99f5193ad5380p-68L, + /* x = 0.1484375 + 38/128. */ + 0xe.708ac84d4172a3e00p-4L, + 0x2.737662213429e1400p-68L, + 0x6.e44f8c36eb10a1c80p-4L, + -0xa.d2f6c3ff0b2b84600p-72L, + /* x = 0.1484375 + 39/128. */ + 0xe.62a551594b970a700p-4L, + 0x7.0b15d41d4c0e48400p-68L, + 0x7.0122c5ec5028c8d00p-4L, + -0xc.c540b02cbf333c800p-76L, + /* x = 0.1484375 + 40/128. */ + 0xe.54864fe33e8575d00p-4L, + -0x5.40a42f1a30e4e5780p-68L, + 0x7.1dd9fb1ff46778500p-4L, + 0x3.acb970a9f6729c700p-68L, + /* x = 0.1484375 + 41/128. */ + 0xe.462dfc670d421ab00p-4L, + 0x3.d1a15901228f146c0p-68L, + 0x7.3a74b8f52947b6800p-4L, + 0x1.baf6928eb3fb02180p-68L, + /* x = 0.1484375 + 42/128. */ + 0xe.379c9045f29d51800p-4L, + -0x3.b7f755b683dfa84c0p-68L, + 0x7.56f28d011d9852880p-4L, + 0x2.44a75fc29c779bd80p-68L, + /* x = 0.1484375 + 43/128. */ + 0xe.28d245c58baef7200p-4L, + 0x2.25e232abc003c4380p-68L, + 0x7.7353054ca72690d80p-4L, + -0x3.391e8e0266194c600p-68L, + /* x = 0.1484375 + 44/128. */ + 0xe.19cf580eeec046b00p-4L, + -0x5.ebdd058b7f8131080p-68L, + 0x7.8f95b0560a9a3bd80p-4L, + -0x1.2084267e23c739ee0p-68L, + /* x = 0.1484375 + 45/128. */ + 0xe.0a94032dbea7cee00p-4L, + -0x4.222625d0505267a80p-68L, + 0x7.abba1d12c17bfa200p-4L, + -0x2.6d0f26c09f2126680p-68L, + /* x = 0.1484375 + 46/128. */ + 0xd.fb20840f3a9b36f00p-4L, + 0x7.ae2c515342890b600p-68L, + 0x7.c7bfdaf13e5ed1700p-4L, + 0x2.12f8a7525bfb113c0p-68L, + /* x = 0.1484375 + 47/128. */ + 0xd.eb7518814a7a93200p-4L, + -0x4.433773ef632be3b00p-68L, + 0x7.e3a679daaf25c6780p-4L, + -0x1.abd434bfd72f69be0p-68L, + /* x = 0.1484375 + 48/128. */ + 0xd.db91ff31879917300p-4L, + -0x4.2dbad2f5c7760ae80p-68L, + 0x7.ff6d8a34bd5e8fa80p-4L, + -0x2.b368b7d24aea62100p-68L, + /* x = 0.1484375 + 49/128. */ + 0xd.cb7777ac420705100p-4L, + 0x6.8f31e3eb780ce9c80p-68L, + 0x8.1b149ce34caa5a500p-4L, + -0x1.9af072f602b295580p-68L, + /* x = 0.1484375 + 50/128. */ + 0xd.bb25c25b8260c1500p-4L, + -0x9.1843671366e48f400p-72L, + 0x8.369b434a372da7f00p-4L, + -0x4.a3758e01c931e1f80p-68L, + /* x = 0.1484375 + 51/128. */ + 0xd.aa9d2086082706400p-4L, + -0x2.1ae3f617aa166cd00p-72L, + 0x8.52010f4f080052100p-4L, + 0x3.78bd8dd614753d080p-68L, + /* x = 0.1484375 + 52/128. */ + 0xd.99ddd44e44a43d500p-4L, + -0x2.b5c5c126adfbef900p-68L, + 0x8.6d45935ab396cb500p-4L, + -0x1.bde17dd211ab0caa0p-68L, + /* x = 0.1484375 + 53/128. */ + 0xd.88e820b1526311e00p-4L, + -0x2.a9e1043f3e565ac80p-68L, + 0x8.8868625b4e1dbb200p-4L, + 0x3.13310133022527200p-68L, + /* x = 0.1484375 + 54/128. */ + 0xd.77bc4985e93a60800p-4L, + -0x3.6279746f944394400p-68L, + 0x8.a3690fc5bfc11c000p-4L, + -0x6.aca1d8c657aed0b80p-68L, + /* x = 0.1484375 + 55/128. */ + 0xd.665a937b4ef2b1f00p-4L, + 0x6.d51bad6d988a44180p-68L, + 0x8.be472f9776d809b00p-4L, + -0xd.477e8edbc29c29900p-72L, + /* x = 0.1484375 + 56/128. */ + 0xd.54c3441844897fd00p-4L, + -0x7.07ac0f9aa0e459680p-68L, + 0x8.d902565817ee78400p-4L, + -0x6.431c32ed7f9fee680p-68L, + /* x = 0.1484375 + 57/128. */ + 0xd.42f6a1b9f0168ce00p-4L, + -0xf.ce3d09c3726cfb200p-72L, + 0x8.f39a191b2ba612300p-4L, + -0x5.c05b0be2a5c002c00p-68L, + /* x = 0.1484375 + 58/128. */ + 0xd.30f4f392c357ab000p-4L, + 0x6.61c5fa8a7d9b26600p-68L, + 0x9.0e0e0d81ca6787900p-4L, + 0x6.cc92c8ea8c2815c00p-68L, + /* x = 0.1484375 + 59/128. */ + 0xd.1ebe81a95ee752e00p-4L, + 0x4.8a26bcd32d6e92300p-68L, + 0x9.285dc9bc45dd9ea00p-4L, + 0x3.d02457bcce59c4180p-68L, + /* x = 0.1484375 + 60/128. */ + 0xd.0c5394d7722281900p-4L, + 0x5.e25736c0357470800p-68L, + 0x9.4288e48bd0335fc00p-4L, + 0x4.1c4cbd2920497a900p-68L, + /* x = 0.1484375 + 61/128. */ + 0xc.f9b476c897c25c600p-4L, + -0x4.018af22c0cf715080p-68L, + 0x9.5c8ef544210ec0c00p-4L, + -0x6.e3b642d55f617ae80p-68L, + /* x = 0.1484375 + 62/128. */ + 0xc.e6e171f92f2e27f00p-4L, + 0x3.2225327ec440ddb00p-68L, + 0x9.766f93cd18413a700p-4L, + -0x5.503e303903d754480p-68L, + /* x = 0.1484375 + 63/128. */ + 0xc.d3dad1b5328a2e400p-4L, + 0x5.9f993f4f510881a00p-68L, + 0x9.902a58a45e27bed00p-4L, + 0x6.8412b426b675ed500p-68L, + /* x = 0.1484375 + 64/128. */ + 0xc.c0a0e21709883a400p-4L, + -0xf.f6ee1ee5f811c4300p-76L, + 0x9.a9bedcdf01b38da00p-4L, + -0x6.c0c287df87e21d700p-68L, + /* x = 0.1484375 + 65/128. */ + 0xc.ad33f00658fe5e800p-4L, + 0x2.04bbc0f3a66a0e6c0p-68L, + 0x9.c32cba2b14156ef00p-4L, + 0x5.256c4f857991ca680p-72L, + /* x = 0.1484375 + 66/128. */ + 0xc.99944936cf48c8900p-4L, + 0x1.1ff93fe64b3ddb7a0p-68L, + 0x9.dc738ad14204e6900p-4L, + -0x6.53a7d2f07a7d9a700p-68L, + /* x = 0.1484375 + 67/128. */ + 0xc.85c23c26ed7b6f000p-4L, + 0x1.4ef546c4792968220p-68L, + 0x9.f592e9b66a9cf9000p-4L, + 0x6.a3c7aa3c101998480p-68L, + /* x = 0.1484375 + 68/128. */ + 0xc.71be181ecd6875d00p-4L, + -0x1.d25a9ea5fc335df80p-68L, + 0xa.0e8a725d33c828c00p-4L, + 0x1.1fa50fd9e9a15ffe0p-68L, + /* x = 0.1484375 + 69/128. */ + 0xc.5d882d2ee48030c00p-4L, + 0x7.c07d28e981e348080p-68L, + 0xa.2759c0e79c3558200p-4L, + 0x5.27c32b55f5405c180p-68L, + /* x = 0.1484375 + 70/128. */ + 0xc.4920cc2ec38fb8900p-4L, + 0x1.b38827db08884fc60p-68L, + 0xa.400072188acf49d00p-4L, + -0x2.94e8c7da1fc7cb900p-68L, + /* x = 0.1484375 + 71/128. */ + 0xc.348846bbd36313400p-4L, + -0x7.001d401622ec7e600p-68L, + 0xa.587e23555bb080800p-4L, + 0x6.d02b9c662cdd29300p-68L, + /* x = 0.1484375 + 72/128. */ + 0xc.1fbeef380e4ffdd00p-4L, + 0x5.a613ec8722f644000p-68L, + 0xa.70d272a76a8d4b700p-4L, + -0x2.5f136f8ed448b7480p-68L, + /* x = 0.1484375 + 73/128. */ + 0xc.0ac518c8b6ae71100p-4L, + -0x4.5c85c1146f34ea500p-68L, + 0xa.88fcfebd9a8dd4800p-4L, + -0x1.d0c3891061dbc66e0p-68L, + /* x = 0.1484375 + 74/128. */ + 0xb.f59b17550a4406800p-4L, + 0x7.5969296567cf3e380p-68L, + 0xa.a0fd66eddb9212300p-4L, + 0x2.c28520d3911b8a040p-68L, + /* x = 0.1484375 + 75/128. */ + 0xb.e0413f84f2a771c00p-4L, + 0x6.14946a88cbf4da200p-68L, + 0xa.b8d34b36acd987200p-4L, + 0x1.0ed343ec65d7e3ae0p-68L, + /* x = 0.1484375 + 76/128. */ + 0xb.cab7e6bfb2a14aa00p-4L, + -0x4.edd3a8b5c89413680p-68L, + 0xa.d07e4c409d08c5000p-4L, + -0x5.c56fa844f53db4780p-68L, + /* x = 0.1484375 + 77/128. */ + 0xb.b4ff632a908f73f00p-4L, + -0x3.eae7c6346266c4b00p-68L, + 0xa.e7fe0b5fc786b2e00p-4L, + -0x6.991e2950ebf5b7780p-68L, + /* x = 0.1484375 + 78/128. */ + 0xb.9f180ba77dd075100p-4L, + 0x6.28e135a9508299000p-68L, + 0xa.ff522a954f2ba1700p-4L, + -0x2.621023be91cc0a180p-68L, + /* x = 0.1484375 + 79/128. */ + 0xb.890237d3bb3c28500p-4L, + -0x4.9eb5fac6fe9405f00p-68L, + 0xb.167a4c90d63c42400p-4L, + 0x4.cf5493b7cc23bd400p-68L, + /* x = 0.1484375 + 80/128. */ + 0xb.72be40067aaf2c000p-4L, + 0x5.0dbdb7a14c3d7d500p-68L, + 0xb.2d7614b1f3aaa2500p-4L, + -0x2.0d291df5881e35c00p-68L, + /* x = 0.1484375 + 81/128. */ + 0xb.5c4c7d4f7dae91600p-4L, + -0x5.3879330b4e5b67300p-68L, + 0xb.44452709a59752900p-4L, + 0x5.913765434a59d1100p-72L, + /* x = 0.1484375 + 82/128. */ + 0xb.45ad4975b1294cb00p-4L, + -0x2.35b30bf1370dd5980p-68L, + 0xb.5ae7285bc10cf5100p-4L, + 0x5.753847e8f8b7a3100p-68L, +}; diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/test-canonical-ldbl-96.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/test-canonical-ldbl-96.c new file mode 100644 index 0000000000..3254097754 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/test-canonical-ldbl-96.c @@ -0,0 +1,141 @@ +/* Test iscanonical and canonicalizel for ldbl-96. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <math_ldbl.h> +#include <stdbool.h> +#include <stdint.h> +#include <stdio.h> + +struct test +{ + bool sign; + uint16_t exponent; + bool high; + uint64_t mantissa; + bool canonical; +}; + +#define M68K_VARIANT (LDBL_MIN_EXP == -16382) + +static const struct test tests[] = + { + { false, 0, true, 0, M68K_VARIANT }, + { true, 0, true, 0, M68K_VARIANT }, + { false, 0, true, 1, M68K_VARIANT }, + { true, 0, true, 1, M68K_VARIANT }, + { false, 0, true, 0x100000000ULL, M68K_VARIANT }, + { true, 0, true, 0x100000000ULL, M68K_VARIANT }, + { false, 0, false, 0, true }, + { true, 0, false, 0, true }, + { false, 0, false, 1, true }, + { true, 0, false, 1, true }, + { false, 0, false, 0x100000000ULL, true }, + { true, 0, false, 0x100000000ULL, true }, + { false, 1, true, 0, true }, + { true, 1, true, 0, true }, + { false, 1, true, 1, true }, + { true, 1, true, 1, true }, + { false, 1, true, 0x100000000ULL, true }, + { true, 1, true, 0x100000000ULL, true }, + { false, 1, false, 0, false }, + { true, 1, false, 0, false }, + { false, 1, false, 1, false }, + { true, 1, false, 1, false }, + { false, 1, false, 0x100000000ULL, false }, + { true, 1, false, 0x100000000ULL, false }, + { false, 0x7ffe, true, 0, true }, + { true, 0x7ffe, true, 0, true }, + { false, 0x7ffe, true, 1, true }, + { true, 0x7ffe, true, 1, true }, + { false, 0x7ffe, true, 0x100000000ULL, true }, + { true, 0x7ffe, true, 0x100000000ULL, true }, + { false, 0x7ffe, false, 0, false }, + { true, 0x7ffe, false, 0, false }, + { false, 0x7ffe, false, 1, false }, + { true, 0x7ffe, false, 1, false }, + { false, 0x7ffe, false, 0x100000000ULL, false }, + { true, 0x7ffe, false, 0x100000000ULL, false }, + { false, 0x7fff, true, 0, true }, + { true, 0x7fff, true, 0, true }, + { false, 0x7fff, true, 1, true }, + { true, 0x7fff, true, 1, true }, + { false, 0x7fff, true, 0x100000000ULL, true }, + { true, 0x7fff, true, 0x100000000ULL, true }, + { false, 0x7fff, false, 0, M68K_VARIANT }, + { true, 0x7fff, false, 0, M68K_VARIANT }, + { false, 0x7fff, false, 1, M68K_VARIANT }, + { true, 0x7fff, false, 1, M68K_VARIANT }, + { false, 0x7fff, false, 0x100000000ULL, M68K_VARIANT }, + { true, 0x7fff, false, 0x100000000ULL, M68K_VARIANT }, + }; + +static int +do_test (void) +{ + int result = 0; + + for (size_t i = 0; i < sizeof (tests) / sizeof (tests[0]); i++) + { + long double ld; + SET_LDOUBLE_WORDS (ld, tests[i].exponent | (tests[i].sign << 15), + (tests[i].mantissa >> 32) | (tests[i].high << 31), + tests[i].mantissa & 0xffffffffULL); + bool canonical = iscanonical (ld); + if (canonical == tests[i].canonical) + { + printf ("PASS: iscanonical test %zu\n", i); + long double ldc = 12345.0L; + bool canonicalize_ret = canonicalizel (&ldc, &ld); + if (canonicalize_ret == !canonical) + { + printf ("PASS: canonicalizel test %zu\n", i); + bool canon_ok; + if (!canonical) + canon_ok = ldc == 12345.0L; + else if (isnan (ld)) + canon_ok = isnan (ldc) && !issignaling (ldc); + else + canon_ok = ldc == ld; + if (canon_ok) + printf ("PASS: canonicalized value test %zu\n", i); + else + { + printf ("FAIL: canonicalized value test %zu\n", i); + result = 1; + } + } + else + { + printf ("FAIL: canonicalizel test %zu\n", i); + result = 1; + } + } + else + { + printf ("FAIL: iscanonical test %zu\n", i); + result = 1; + } + } + + return result; +} + +#define TEST_FUNCTION do_test () +#include "../test-skeleton.c" diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/test-totalorderl-ldbl-96.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/test-totalorderl-ldbl-96.c new file mode 100644 index 0000000000..4e01f15aa9 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/test-totalorderl-ldbl-96.c @@ -0,0 +1,82 @@ +/* Test totalorderl and totalordermagl for ldbl-96. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <float.h> +#include <math.h> +#include <math_ldbl.h> +#include <stdbool.h> +#include <stdint.h> +#include <stdio.h> + +static const uint64_t tests[] = + { + 0, 1, 0x4000000000000000ULL, 0x4000000000000001ULL, + 0x7fffffffffffffffULL + }; + +static int +do_test (void) +{ + int result = 0; + + if (LDBL_MIN_EXP == -16382) + for (size_t i = 0; i < sizeof (tests) / sizeof (tests[0]); i++) + { + long double ldx, ldy, ldnx, ldny; + /* Verify that the high bit of the mantissa is ignored for + infinities and NaNs for the M68K variant of this + format. */ + SET_LDOUBLE_WORDS (ldx, 0x7fff, + tests[i] >> 32, tests[i] & 0xffffffffULL); + SET_LDOUBLE_WORDS (ldy, 0x7fff, + (tests[i] >> 32) | 0x80000000, + tests[i] & 0xffffffffULL); + SET_LDOUBLE_WORDS (ldnx, 0xffff, + tests[i] >> 32, tests[i] & 0xffffffffULL); + SET_LDOUBLE_WORDS (ldny, 0xffff, + (tests[i] >> 32) | 0x80000000, + tests[i] & 0xffffffffULL); + bool to1 = totalorderl (ldx, ldy); + bool to2 = totalorderl (ldy, ldx); + bool to3 = totalorderl (ldnx, ldny); + bool to4 = totalorderl (ldny, ldnx); + if (to1 && to2 && to3 && to4) + printf ("PASS: test %zu\n", i); + else + { + printf ("FAIL: test %zu\n", i); + result = 1; + } + to1 = totalordermagl (ldx, ldy); + to2 = totalordermagl (ldy, ldx); + to3 = totalordermagl (ldnx, ldny); + to4 = totalordermagl (ldny, ldnx); + if (to1 && to2 && to3 && to4) + printf ("PASS: test %zu (totalordermagl)\n", i); + else + { + printf ("FAIL: test %zu (totalordermagl)\n", i); + result = 1; + } + } + + return result; +} + +#define TEST_FUNCTION do_test () +#include "../test-skeleton.c" diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/w_expl_compat.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/w_expl_compat.c new file mode 100644 index 0000000000..a0b852a3e2 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/w_expl_compat.c @@ -0,0 +1,34 @@ +/* Copyright (C) 2011-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Ulrich Drepper <drepper@gmail.com>, 2011. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> + +/* wrapper expl */ +long double +__expl (long double x) +{ + long double z = __ieee754_expl (x); + if (__builtin_expect (!isfinite (z) || z == 0, 0) + && isfinite (x) && _LIB_VERSION != _IEEE_) + return __kernel_standard_l (x, x, 206 + !!signbit (x)); + + return z; +} +hidden_def (__expl) +weak_alias (__expl, expl) diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/x2y2m1.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/x2y2m1.c new file mode 100644 index 0000000000..a20e89309e --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/x2y2m1.c @@ -0,0 +1,39 @@ +/* Compute x^2 + y^2 - 1, without large cancellation error. + Copyright (C) 2012-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <float.h> + +#if FLT_EVAL_METHOD == 0 + +# include <sysdeps/ieee754/dbl-64/x2y2m1.c> + +#else + +/* Return X^2 + Y^2 - 1, computed without large cancellation error. + It is given that 1 > X >= Y >= epsilon / 2, and that X^2 + Y^2 >= + 0.5. */ + +double +__x2y2m1 (double x, double y) +{ + return (double) __x2y2m1l (x, y); +} + +#endif diff --git a/REORG.TODO/sysdeps/ieee754/ldbl-96/x2y2m1l.c b/REORG.TODO/sysdeps/ieee754/ldbl-96/x2y2m1l.c new file mode 100644 index 0000000000..a301fb3589 --- /dev/null +++ b/REORG.TODO/sysdeps/ieee754/ldbl-96/x2y2m1l.c @@ -0,0 +1,75 @@ +/* Compute x^2 + y^2 - 1, without large cancellation error. + Copyright (C) 2012-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with the GNU C Library; if not, see + <http://www.gnu.org/licenses/>. */ + +#include <math.h> +#include <math_private.h> +#include <mul_splitl.h> +#include <stdlib.h> + +/* Calculate X + Y exactly and store the result in *HI + *LO. It is + given that |X| >= |Y| and the values are small enough that no + overflow occurs. */ + +static inline void +add_split (long double *hi, long double *lo, long double x, long double y) +{ + /* Apply Dekker's algorithm. */ + *hi = x + y; + *lo = (x - *hi) + y; +} + +/* Compare absolute values of floating-point values pointed to by P + and Q for qsort. */ + +static int +compare (const void *p, const void *q) +{ + long double pld = fabsl (*(const long double *) p); + long double qld = fabsl (*(const long double *) q); + if (pld < qld) + return -1; + else if (pld == qld) + return 0; + else + return 1; +} + +/* Return X^2 + Y^2 - 1, computed without large cancellation error. + It is given that 1 > X >= Y >= epsilon / 2, and that X^2 + Y^2 >= + 0.5. */ + +long double +__x2y2m1l (long double x, long double y) +{ + long double vals[5]; + SET_RESTORE_ROUNDL (FE_TONEAREST); + mul_splitl (&vals[1], &vals[0], x, x); + mul_splitl (&vals[3], &vals[2], y, y); + vals[4] = -1.0L; + qsort (vals, 5, sizeof (long double), compare); + /* Add up the values so that each element of VALS has absolute value + at most equal to the last set bit of the next nonzero + element. */ + for (size_t i = 0; i <= 3; i++) + { + add_split (&vals[i + 1], &vals[i], vals[i + 1], vals[i]); + qsort (vals + i + 1, 4 - i, sizeof (long double), compare); + } + /* Now any error from this addition will be small. */ + return vals[4] + vals[3] + vals[2] + vals[1] + vals[0]; +} |