home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c082_144 / 1.ddi / MATHSRC.ZIP / TANHL.CAS < prev    next >
Encoding:
Text File  |  1992-06-10  |  3.1 KB  |  135 lines
  1. /*------------------------------------------------------------------------
  2.  * filename - tanhl.cas
  3.  *
  4.  * function(s)
  5.  *        tanhl - long double hyperbolic tangent function
  6.  *-----------------------------------------------------------------------*/
  7.  
  8. /*
  9.  *      C/C++ Run Time Library - Version 5.0
  10.  *
  11.  *      Copyright (c) 1987, 1992 by Borland International
  12.  *      All Rights Reserved.
  13.  *
  14.  */
  15.  
  16.  
  17. #pragma inline
  18. #include <asmrules.h>
  19.  
  20. #include <_math.h>
  21. #include <math.h>
  22.  
  23.  
  24. /*--------------------------------------------------------------------------*
  25.  
  26. Name            tanhl - long double hyperbolic tangent function
  27.  
  28. Usage           long double tanhl(long double x);
  29.  
  30. Prototype in    math.h
  31.  
  32. Description     tanhl calculates the hyperbolic tangent of the input.
  33.  
  34. Return value    tanhl returns the hyperbolic tangent of the input value.
  35.                 For large arguments (magnitude greater than 32) the result
  36.                 will be +1.0 or -1.0.
  37.  
  38. *---------------------------------------------------------------------------*/
  39.  
  40. /*
  41. Algorithm.
  42.  
  43. The usual formula is:
  44.         tanhl(x) = (exp(x) - exp(-x))/(exp(x) + exp(-x))/
  45. but there is a loss of precision in using this formula directly near 0.
  46.  
  47. Since tanhl(-x) = -tanhl(x), compute tanhl(|x|) and adjust the sign later.
  48.  
  49. If 0 <= x < 2^-33, return x.
  50.  
  51. If x >= 32 return 1.
  52.  
  53. If x >= .17325, use
  54.         y = exp(x)
  55.         tanhl(x) = (y - 1/y)/(y + 1/y)
  56.  
  57. If 2^-33 <= x < .17325, use
  58.         y = exp(2x) - 1
  59.         sinh(x) = y/(2 + y)
  60. where special chip functions are used to get exp(2x)-1 accurately.
  61.  
  62. */
  63.  
  64. #pragma warn -rvl
  65. long double _FARFUNC tanhl (long double  x)
  66. {
  67. asm     FLD     LONGDOUBLE (x)
  68. asm     sub     dh, dh
  69. asm     mov     cx, x [8]
  70. asm     shl     cx, 1
  71. asm     rcr     dh, 1                   /* DH = sign    */
  72. asm     cmp     cx, 8008h
  73. asm     FABS
  74. asm     ja      tanhl_extreme
  75.  
  76. asm     cmp     cx, 7FF8h
  77. asm     jb      tanhl_small
  78.  
  79. #ifdef _Windows
  80.         _f87_Exp();
  81. #else
  82. asm     _FAST_  (_FEXP_)                /* Exp (x)      */
  83. #endif
  84.  
  85. asm     FLD1
  86. asm     FDIV    st, st(1)               /* Exp (-x)     */
  87.  
  88. /*
  89.   tanhl = sinh / cosh = (exp(x) - exp(-x)) / (exp(x) + exp(-x))
  90. */
  91. asm     FLD     st(1)
  92. asm     FSUB    st, st(1)
  93. asm     FXCH
  94. asm     FADD    st, st(2)
  95. asm     FDIVP   st(1), st
  96. asm     FSTP    st(1)
  97.  
  98. tanhl_end:
  99. /* change sign if original argument was negative */
  100. asm     or      dh, dh
  101. asm     jns     tanhl_end2
  102. asm     FCHS
  103. tanhl_end2:
  104.         return;
  105.  
  106. /*
  107.   tanhl is asymptotic to -1 for negative arguments and +1 for positives.
  108.   It approaches very fast, with exponentially increasing accuracy,
  109.   so it is 1.0 for IEEE accuracy when |x| > 23.
  110. */
  111. tanhl_extreme:
  112. asm     FSTP    st(0)           /* pop stack    */
  113. asm     FLD1
  114.         goto tanhl_end;
  115.  
  116. tanhl_small:
  117. asm     cmp     cx, 7FBCh
  118. asm     jb      tanhl_end
  119. asm     FLD1
  120. asm     FXCH
  121. asm     FSCALE
  122. asm     FLDL2E
  123. asm     FMUL
  124. asm     F2XM1
  125. /* TOS = y = exp(2x) - 1 */
  126. asm     FXCH
  127. asm     FLD1
  128. asm     FADD
  129. asm     FADD    st(0),st(1)
  130. /* stack = 2+y,y */
  131. asm     FDIV
  132.         goto tanhl_end;
  133. }
  134. #pragma warn .rvl
  135.