s_tanhl.c 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  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. /* tanhl(x)
  13. * Return the Hyperbolic Tangent of x
  14. *
  15. * Method :
  16. * x -x
  17. * e - e
  18. * 0. tanhl(x) is defined to be -----------
  19. * x -x
  20. * e + e
  21. * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x).
  22. * 2. 0 <= x <= 2**-55 : tanhl(x) := x*(one+x)
  23. * -t
  24. * 2**-55 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x)
  25. * t + 2
  26. * 2
  27. * 1 <= x <= 23.0 : tanhl(x) := 1- ----- ; t=expm1l(2x)
  28. * t + 2
  29. * 23.0 < x <= INF : tanhl(x) := 1.
  30. *
  31. * Special cases:
  32. * tanhl(NaN) is NaN;
  33. * only tanhl(0)=0 is exact for finite argument.
  34. */
  35. #include <openlibm_math.h>
  36. #include "math_private.h"
  37. #include "math_private_openbsd.h"
  38. static const long double one=1.0, two=2.0, tiny = 1.0e-4900L;
  39. long double
  40. tanhl(long double x)
  41. {
  42. long double t,z;
  43. int32_t se;
  44. u_int32_t jj0,jj1,ix;
  45. /* High word of |x|. */
  46. GET_LDOUBLE_WORDS(se,jj0,jj1,x);
  47. ix = se&0x7fff;
  48. /* x is INF or NaN */
  49. if(ix==0x7fff) {
  50. /* for NaN it's not important which branch: tanhl(NaN) = NaN */
  51. if (se&0x8000) return one/x-one; /* tanhl(-inf)= -1; */
  52. else return one/x+one; /* tanhl(+inf)=+1 */
  53. }
  54. /* |x| < 23 */
  55. if (ix < 0x4003 || (ix == 0x4003 && jj0 < 0xb8000000u)) {/* |x|<23 */
  56. if ((ix|jj0|jj1) == 0)
  57. return x; /* x == +- 0 */
  58. if (ix<0x3fc8) /* |x|<2**-55 */
  59. return x*(one+tiny); /* tanh(small) = small */
  60. if (ix>=0x3fff) { /* |x|>=1 */
  61. t = expm1l(two*fabsl(x));
  62. z = one - two/(t+two);
  63. } else {
  64. t = expm1l(-two*fabsl(x));
  65. z= -t/(t+two);
  66. }
  67. /* |x| > 23, return +-1 */
  68. } else {
  69. z = one - tiny; /* raised inexact flag */
  70. }
  71. return (se&0x8000)? -z: z;
  72. }