Blame sysdeps/ieee754/ldbl-128ibm/e_expl.c

Packit 6c4009
/* Quad-precision floating point e^x.
Packit 6c4009
   Copyright (C) 1999-2018 Free Software Foundation, Inc.
Packit 6c4009
   This file is part of the GNU C Library.
Packit 6c4009
   Contributed by Jakub Jelinek <jj@ultra.linux.cz>
Packit 6c4009
   Partly based on double-precision code
Packit 6c4009
   by Geoffrey Keating <geoffk@ozemail.com.au>
Packit 6c4009
Packit 6c4009
   The GNU C Library is free software; you can redistribute it and/or
Packit 6c4009
   modify it under the terms of the GNU Lesser General Public
Packit 6c4009
   License as published by the Free Software Foundation; either
Packit 6c4009
   version 2.1 of the License, or (at your option) any later version.
Packit 6c4009
Packit 6c4009
   The GNU C Library is distributed in the hope that it will be useful,
Packit 6c4009
   but WITHOUT ANY WARRANTY; without even the implied warranty of
Packit 6c4009
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Packit 6c4009
   Lesser General Public License for more details.
Packit 6c4009
Packit 6c4009
   You should have received a copy of the GNU Lesser General Public
Packit 6c4009
   License along with the GNU C Library; if not, see
Packit 6c4009
   <http://www.gnu.org/licenses/>.  */
Packit 6c4009
Packit 6c4009
/* The basic design here is from
Packit 6c4009
   Abraham Ziv, "Fast Evaluation of Elementary Mathematical Functions with
Packit 6c4009
   Correctly Rounded Last Bit", ACM Trans. Math. Soft., 17 (3), September 1991,
Packit 6c4009
   pp. 410-423.
Packit 6c4009
Packit 6c4009
   We work with number pairs where the first number is the high part and
Packit 6c4009
   the second one is the low part. Arithmetic with the high part numbers must
Packit 6c4009
   be exact, without any roundoff errors.
Packit 6c4009
Packit 6c4009
   The input value, X, is written as
Packit 6c4009
   X = n * ln(2)_0 + arg1[t1]_0 + arg2[t2]_0 + x
Packit 6c4009
       - n * ln(2)_1 + arg1[t1]_1 + arg2[t2]_1 + xl
Packit 6c4009
Packit 6c4009
   where:
Packit 6c4009
   - n is an integer, 16384 >= n >= -16495;
Packit 6c4009
   - ln(2)_0 is the first 93 bits of ln(2), and |ln(2)_0-ln(2)-ln(2)_1| < 2^-205
Packit 6c4009
   - t1 is an integer, 89 >= t1 >= -89
Packit 6c4009
   - t2 is an integer, 65 >= t2 >= -65
Packit 6c4009
   - |arg1[t1]-t1/256.0| < 2^-53
Packit 6c4009
   - |arg2[t2]-t2/32768.0| < 2^-53
Packit 6c4009
   - x + xl is whatever is left, |x + xl| < 2^-16 + 2^-53
Packit 6c4009
Packit 6c4009
   Then e^x is approximated as
Packit 6c4009
Packit 6c4009
   e^x = 2^n_1 ( 2^n_0 e^(arg1[t1]_0 + arg1[t1]_1) e^(arg2[t2]_0 + arg2[t2]_1)
Packit 6c4009
	       + 2^n_0 e^(arg1[t1]_0 + arg1[t1]_1) e^(arg2[t2]_0 + arg2[t2]_1)
Packit 6c4009
		 * p (x + xl + n * ln(2)_1))
Packit 6c4009
   where:
Packit 6c4009
   - p(x) is a polynomial approximating e(x)-1
Packit 6c4009
   - e^(arg1[t1]_0 + arg1[t1]_1) is obtained from a table
Packit 6c4009
   - e^(arg2[t2]_0 + arg2[t2]_1) likewise
Packit 6c4009
   - n_1 + n_0 = n, so that |n_0| < -LDBL_MIN_EXP-1.
Packit 6c4009
Packit 6c4009
   If it happens that n_1 == 0 (this is the usual case), that multiplication
Packit 6c4009
   is omitted.
Packit 6c4009
   */
Packit 6c4009
Packit 6c4009
#ifndef _GNU_SOURCE
Packit 6c4009
#define _GNU_SOURCE
Packit 6c4009
#endif
Packit 6c4009
#include <float.h>
Packit 6c4009
#include <ieee754.h>
Packit 6c4009
#include <math.h>
Packit 6c4009
#include <fenv.h>
Packit 6c4009
#include <inttypes.h>
Packit 6c4009
#include <math_private.h>
Packit 6c4009
Packit 6c4009
Packit 6c4009
#include "t_expl.h"
Packit 6c4009
Packit 6c4009
static const long double C[] = {
Packit 6c4009
/* Smallest integer x for which e^x overflows.  */
Packit 6c4009
#define himark C[0]
Packit 6c4009
 709.78271289338399678773454114191496482L,
Packit 6c4009
Packit 6c4009
/* Largest integer x for which e^x underflows.  */
Packit 6c4009
#define lomark C[1]
Packit 6c4009
-744.44007192138126231410729844608163411L,
Packit 6c4009
Packit 6c4009
/* 3x2^96 */
Packit 6c4009
#define THREEp96 C[2]
Packit 6c4009
 59421121885698253195157962752.0L,
Packit 6c4009
Packit 6c4009
/* 3x2^103 */
Packit 6c4009
#define THREEp103 C[3]
Packit 6c4009
 30423614405477505635920876929024.0L,
Packit 6c4009
Packit 6c4009
/* 3x2^111 */
Packit 6c4009
#define THREEp111 C[4]
Packit 6c4009
 7788445287802241442795744493830144.0L,
Packit 6c4009
Packit 6c4009
/* 1/ln(2) */
Packit 6c4009
#define M_1_LN2 C[5]
Packit 6c4009
 1.44269504088896340735992468100189204L,
Packit 6c4009
Packit 6c4009
/* first 93 bits of ln(2) */
Packit 6c4009
#define M_LN2_0 C[6]
Packit 6c4009
 0.693147180559945309417232121457981864L,
Packit 6c4009
Packit 6c4009
/* ln2_0 - ln(2) */
Packit 6c4009
#define M_LN2_1 C[7]
Packit 6c4009
-1.94704509238074995158795957333327386E-31L,
Packit 6c4009
Packit 6c4009
/* very small number */
Packit 6c4009
#define TINY C[8]
Packit 6c4009
 1.0e-308L,
Packit 6c4009
Packit 6c4009
/* 2^16383 */
Packit 6c4009
#define TWO1023 C[9]
Packit 6c4009
 8.988465674311579538646525953945123668E+307L,
Packit 6c4009
Packit 6c4009
/* 256 */
Packit 6c4009
#define TWO8 C[10]
Packit 6c4009
 256.0L,
Packit 6c4009
Packit 6c4009
/* 32768 */
Packit 6c4009
#define TWO15 C[11]
Packit 6c4009
 32768.0L,
Packit 6c4009
Packit 6c4009
/* Chebyshev polynom coefficients for (exp(x)-1)/x */
Packit 6c4009
#define P1 C[12]
Packit 6c4009
#define P2 C[13]
Packit 6c4009
#define P3 C[14]
Packit 6c4009
#define P4 C[15]
Packit 6c4009
#define P5 C[16]
Packit 6c4009
#define P6 C[17]
Packit 6c4009
 0.5L,
Packit 6c4009
 1.66666666666666666666666666666666683E-01L,
Packit 6c4009
 4.16666666666666666666654902320001674E-02L,
Packit 6c4009
 8.33333333333333333333314659767198461E-03L,
Packit 6c4009
 1.38888888889899438565058018857254025E-03L,
Packit 6c4009
 1.98412698413981650382436541785404286E-04L,
Packit 6c4009
};
Packit 6c4009
Packit 6c4009
long double
Packit 6c4009
__ieee754_expl (long double x)
Packit 6c4009
{
Packit 6c4009
  long double result, x22;
Packit 6c4009
  union ibm_extended_long_double ex2_u, scale_u;
Packit 6c4009
  int unsafe;
Packit 6c4009
Packit 6c4009
  /* Check for usual case.  */
Packit 6c4009
  if (isless (x, himark) && isgreater (x, lomark))
Packit 6c4009
    {
Packit 6c4009
      int tval1, tval2, n_i, exponent2;
Packit 6c4009
      long double n, xl;
Packit 6c4009
Packit 6c4009
      SET_RESTORE_ROUND (FE_TONEAREST);
Packit 6c4009
Packit 6c4009
      n = __roundl (x*M_1_LN2);
Packit 6c4009
      x = x-n*M_LN2_0;
Packit 6c4009
      xl = n*M_LN2_1;
Packit 6c4009
Packit 6c4009
      tval1 = __roundl (x*TWO8);
Packit 6c4009
      x -= __expl_table[T_EXPL_ARG1+2*tval1];
Packit 6c4009
      xl -= __expl_table[T_EXPL_ARG1+2*tval1+1];
Packit 6c4009
Packit 6c4009
      tval2 = __roundl (x*TWO15);
Packit 6c4009
      x -= __expl_table[T_EXPL_ARG2+2*tval2];
Packit 6c4009
      xl -= __expl_table[T_EXPL_ARG2+2*tval2+1];
Packit 6c4009
Packit 6c4009
      x = x + xl;
Packit 6c4009
Packit 6c4009
      /* Compute ex2 = 2^n_0 e^(argtable[tval1]) e^(argtable[tval2]).  */
Packit 6c4009
      ex2_u.ld = (__expl_table[T_EXPL_RES1 + tval1]
Packit 6c4009
		  * __expl_table[T_EXPL_RES2 + tval2]);
Packit 6c4009
      n_i = (int)n;
Packit 6c4009
      /* 'unsafe' is 1 iff n_1 != 0.  */
Packit 6c4009
      unsafe = fabsl(n_i) >= -LDBL_MIN_EXP - 1;
Packit 6c4009
      ex2_u.d[0].ieee.exponent += n_i >> unsafe;
Packit 6c4009
      /* Fortunately, there are no subnormal lowpart doubles in
Packit 6c4009
	 __expl_table, only normal values and zeros.
Packit 6c4009
	 But after scaling it can be subnormal.  */
Packit 6c4009
      exponent2 = ex2_u.d[1].ieee.exponent + (n_i >> unsafe);
Packit 6c4009
      if (ex2_u.d[1].ieee.exponent == 0)
Packit 6c4009
	/* assert ((ex2_u.d[1].ieee.mantissa0|ex2_u.d[1].ieee.mantissa1) == 0) */;
Packit 6c4009
      else if (exponent2 > 0)
Packit 6c4009
	ex2_u.d[1].ieee.exponent = exponent2;
Packit 6c4009
      else if (exponent2 <= -54)
Packit 6c4009
	{
Packit 6c4009
	  ex2_u.d[1].ieee.exponent = 0;
Packit 6c4009
	  ex2_u.d[1].ieee.mantissa0 = 0;
Packit 6c4009
	  ex2_u.d[1].ieee.mantissa1 = 0;
Packit 6c4009
	}
Packit 6c4009
      else
Packit 6c4009
	{
Packit 6c4009
	  static const double
Packit 6c4009
	    two54 = 1.80143985094819840000e+16, /* 4350000000000000 */
Packit 6c4009
	    twom54 = 5.55111512312578270212e-17; /* 3C90000000000000 */
Packit 6c4009
	  ex2_u.d[1].d *= two54;
Packit 6c4009
	  ex2_u.d[1].ieee.exponent += n_i >> unsafe;
Packit 6c4009
	  ex2_u.d[1].d *= twom54;
Packit 6c4009
	}
Packit 6c4009
Packit 6c4009
      /* Compute scale = 2^n_1.  */
Packit 6c4009
      scale_u.ld = 1.0L;
Packit 6c4009
      scale_u.d[0].ieee.exponent += n_i - (n_i >> unsafe);
Packit 6c4009
Packit 6c4009
      /* Approximate e^x2 - 1, using a seventh-degree polynomial,
Packit 6c4009
	 with maximum error in [-2^-16-2^-53,2^-16+2^-53]
Packit 6c4009
	 less than 4.8e-39.  */
Packit 6c4009
      x22 = x + x*x*(P1+x*(P2+x*(P3+x*(P4+x*(P5+x*P6)))));
Packit 6c4009
Packit 6c4009
      /* Now we can test whether the result is ultimate or if we are unsure.
Packit 6c4009
	 In the later case we should probably call a mpn based routine to give
Packit 6c4009
	 the ultimate result.
Packit 6c4009
	 Empirically, this routine is already ultimate in about 99.9986% of
Packit 6c4009
	 cases, the test below for the round to nearest case will be false
Packit 6c4009
	 in ~ 99.9963% of cases.
Packit 6c4009
	 Without proc2 routine maximum error which has been seen is
Packit 6c4009
	 0.5000262 ulp.
Packit 6c4009
Packit 6c4009
	  union ieee854_long_double ex3_u;
Packit 6c4009
Packit 6c4009
	  #ifdef FE_TONEAREST
Packit 6c4009
	    fesetround (FE_TONEAREST);
Packit 6c4009
	  #endif
Packit 6c4009
	  ex3_u.d = (result - ex2_u.d) - x22 * ex2_u.d;
Packit 6c4009
	  ex2_u.d = result;
Packit 6c4009
	  ex3_u.ieee.exponent += LDBL_MANT_DIG + 15 + IEEE854_LONG_DOUBLE_BIAS
Packit 6c4009
				 - ex2_u.ieee.exponent;
Packit 6c4009
	  n_i = abs (ex3_u.d);
Packit 6c4009
	  n_i = (n_i + 1) / 2;
Packit 6c4009
	  fesetenv (&oldenv);
Packit 6c4009
	  #ifdef FE_TONEAREST
Packit 6c4009
	  if (fegetround () == FE_TONEAREST)
Packit 6c4009
	    n_i -= 0x4000;
Packit 6c4009
	  #endif
Packit 6c4009
	  if (!n_i) {
Packit 6c4009
	    return __ieee754_expl_proc2 (origx);
Packit 6c4009
	  }
Packit 6c4009
       */
Packit 6c4009
    }
Packit 6c4009
  /* Exceptional cases:  */
Packit 6c4009
  else if (isless (x, himark))
Packit 6c4009
    {
Packit 6c4009
      if (isinf (x))
Packit 6c4009
	/* e^-inf == 0, with no error.  */
Packit 6c4009
	return 0;
Packit 6c4009
      else
Packit 6c4009
	/* Underflow */
Packit 6c4009
	return TINY * TINY;
Packit 6c4009
    }
Packit 6c4009
  else
Packit 6c4009
    /* Return x, if x is a NaN or Inf; or overflow, otherwise.  */
Packit 6c4009
    return TWO1023*x;
Packit 6c4009
Packit 6c4009
  result = x22 * ex2_u.ld + ex2_u.ld;
Packit 6c4009
  if (!unsafe)
Packit 6c4009
    return result;
Packit 6c4009
  return result * scale_u.ld;
Packit 6c4009
}
Packit 6c4009
strong_alias (__ieee754_expl, __expl_finite)