1  /* @(#)s_tanh.c 5.1 93/09/24 */
       2  /*
       3   * ====================================================
       4   * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
       5   *
       6   * Developed at SunPro, a Sun Microsystems, Inc. business.
       7   * Permission to use, copy, modify, and distribute this
       8   * software is freely granted, provided that this notice
       9   * is preserved.
      10   * ====================================================
      11   */
      12  
      13  #if defined(LIBM_SCCS) && !defined(lint)
      14  static char rcsid[] = "$NetBSD: s_tanh.c,v 1.7 1995/05/10 20:48:22 jtc Exp $";
      15  #endif
      16  
      17  /* Tanh(x)
      18   * Return the Hyperbolic Tangent of x
      19   *
      20   * Method :
      21   *				       x    -x
      22   *				      e  - e
      23   *	0. tanh(x) is defined to be -----------
      24   *				       x    -x
      25   *				      e  + e
      26   *	1. reduce x to non-negative by tanh(-x) = -tanh(x).
      27   *	2.  0      <= x <= 2**-57 : tanh(x) := x*(one+x)
      28   *					        -t
      29   *	    2**-57 <  x <=  1     : tanh(x) := -----; t = expm1(-2x)
      30   *					       t + 2
      31   *						     2
      32   *	    1      <= x <=  40.0  : tanh(x) := 1-  ----- ; t=expm1(2x)
      33   *						   t + 2
      34   *	    40.0   <  x <= INF    : tanh(x) := 1.
      35   *
      36   * Special cases:
      37   *	tanh(NaN) is NaN;
      38   *	only tanh(0)=0 is exact for finite argument.
      39   */
      40  
      41  #include <float.h>
      42  #include <math.h>
      43  #include <math_private.h>
      44  #include <math-underflow.h>
      45  #include <math_ldbl_opt.h>
      46  
      47  static const long double one=1.0L, two=2.0L, tiny = 1.0e-300L;
      48  
      49  long double __tanhl(long double x)
      50  {
      51  	long double t,z;
      52  	int64_t jx,ix;
      53  	double xhi;
      54  
      55      /* High word of |x|. */
      56  	xhi = ldbl_high (x);
      57  	EXTRACT_WORDS64 (jx, xhi);
      58  	ix = jx&0x7fffffffffffffffLL;
      59  
      60      /* x is INF or NaN */
      61  	if(ix>=0x7ff0000000000000LL) {
      62  	    if (jx>=0) return one/x+one;    /* tanh(+-inf)=+-1 */
      63  	    else       return one/x-one;    /* tanh(NaN) = NaN */
      64  	}
      65  
      66      /* |x| < 40 */
      67  	if (ix < 0x4044000000000000LL) {		/* |x|<40 */
      68  	    if (ix == 0)
      69  		return x;		/* x == +-0 */
      70  	    if (ix<0x3c60000000000000LL) 	/* |x|<2**-57 */
      71  	      {
      72  		math_check_force_underflow (x);
      73  		return x;		/* tanh(small) = small */
      74  	      }
      75  	    if (ix>=0x3ff0000000000000LL) {	/* |x|>=1  */
      76  		t = __expm1l(two*fabsl(x));
      77  		z = one - two/(t+two);
      78  	    } else {
      79  	        t = __expm1l(-two*fabsl(x));
      80  	        z= -t/(t+two);
      81  	    }
      82      /* |x| > 40, return +-1 */
      83  	} else {
      84  	    z = one - tiny;		/* raised inexact flag */
      85  	}
      86  	return (jx>=0)? z: -z;
      87  }
      88  long_double_symbol (libm, __tanhl, tanhl);