1  /* s_tanhl.c -- long double version of s_tanh.c.
       2   * Conversion to long double by Ulrich Drepper,
       3   * Cygnus Support, drepper@cygnus.com.
       4   */
       5  
       6  /*
       7   * ====================================================
       8   * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
       9   *
      10   * Developed at SunPro, a Sun Microsystems, Inc. business.
      11   * Permission to use, copy, modify, and distribute this
      12   * software is freely granted, provided that this notice
      13   * is preserved.
      14   * ====================================================
      15   */
      16  
      17  /* Changes for 128-bit long double contributed by
      18     Stephen L. Moshier <moshier@na-net.ornl.gov> */
      19  
      20  /* tanhq(x)
      21   * Return the Hyperbolic Tangent of x
      22   *
      23   * Method :
      24   *                                      x    -x
      25   *                                     e  - e
      26   *      0. tanhq(x) is defined to be -----------
      27   *                                      x    -x
      28   *                                     e  + e
      29   *      1. reduce x to non-negative by tanhq(-x) = -tanhq(x).
      30   *      2.  0      <= x <= 2**-57 : tanhq(x) := x*(one+x)
      31   *                                               -t
      32   *          2**-57 <  x <=  1     : tanhq(x) := -----; t = expm1q(-2x)
      33   *                                              t + 2
      34   *                                                    2
      35   *          1      <= x <=  40.0  : tanhq(x) := 1-  ----- ; t=expm1q(2x)
      36   *                                                  t + 2
      37   *          40.0   <  x <= INF    : tanhq(x) := 1.
      38   *
      39   * Special cases:
      40   *      tanhq(NaN) is NaN;
      41   *      only tanhq(0)=0 is exact for finite argument.
      42   */
      43  
      44  #include "quadmath-imp.h"
      45  
      46  static const __float128 one = 1.0, two = 2.0, tiny = 1.0e-4900Q;
      47  
      48  __float128
      49  tanhq (__float128 x)
      50  {
      51    __float128 t, z;
      52    uint32_t jx, ix;
      53    ieee854_float128 u;
      54  
      55    /* Words of |x|. */
      56    u.value = x;
      57    jx = u.words32.w0;
      58    ix = jx & 0x7fffffff;
      59    /* x is INF or NaN */
      60    if (ix >= 0x7fff0000)
      61      {
      62        /* for NaN it's not important which branch: tanhq(NaN) = NaN */
      63        if (jx & 0x80000000)
      64  	return one / x - one;	/* tanhq(-inf)= -1; */
      65        else
      66  	return one / x + one;	/* tanhq(+inf)=+1 */
      67      }
      68  
      69    /* |x| < 40 */
      70    if (ix < 0x40044000)
      71      {
      72        if (u.value == 0)
      73  	return x;		/* x == +- 0 */
      74        if (ix < 0x3fc60000)	/* |x| < 2^-57 */
      75  	{
      76  	  math_check_force_underflow (x);
      77  	  return x * (one + tiny); /* tanh(small) = small */
      78  	}
      79        u.words32.w0 = ix;	/* Absolute value of x.  */
      80        if (ix >= 0x3fff0000)
      81  	{			/* |x| >= 1  */
      82  	  t = expm1q (two * u.value);
      83  	  z = one - two / (t + two);
      84  	}
      85        else
      86  	{
      87  	  t = expm1q (-two * u.value);
      88  	  z = -t / (t + two);
      89  	}
      90        /* |x| > 40, return +-1 */
      91      }
      92    else
      93      {
      94        z = one - tiny;		/* raised inexact flag */
      95      }
      96    return (jx & 0x80000000) ? -z : z;
      97  }