diff options
| author | Zack Weinberg <zackw@panix.com> | 2017-06-08 15:39:03 -0400 |
|---|---|---|
| committer | Zack Weinberg <zackw@panix.com> | 2017-06-08 15:39:03 -0400 |
| commit | 5046dbb4a7eba5eccfd258f92f4735c9ffc8d069 (patch) | |
| tree | 4470480d904b65cf14ca524f96f79eca818c3eaf /REORG.TODO/sysdeps/ieee754/ldbl-96 | |
| parent | 199fc19d3aaaf57944ef036e15904febe877fc93 (diff) | |
| download | glibc-5046dbb4a7eba5eccfd258f92f4735c9ffc8d069.tar.gz glibc-5046dbb4a7eba5eccfd258f92f4735c9ffc8d069.tar.xz glibc-5046dbb4a7eba5eccfd258f92f4735c9ffc8d069.zip | |
Prepare for radical source tree reorganization. zack/build-layout-experiment
All top-level files and directories are moved into a temporary storage directory, REORG.TODO, except for files that will certainly still exist in their current form at top level when we're done (COPYING, COPYING.LIB, LICENSES, NEWS, README), all old ChangeLog files (which are moved to the new directory OldChangeLogs, instead), and the generated file INSTALL (which is just deleted; in the new order, there will be no generated files checked into version control).
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]; +} |