home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c082_122 / 2.ddi / MATHSRC.ZIP / SINHL.CAS < prev    next >
Encoding:
Text File  |  1992-06-10  |  3.6 KB  |  136 lines
  1. /*------------------------------------------------------------------------
  2.  * filename - sinhl.cas
  3.  *
  4.  * function(s)
  5.  *        sinhl - long double hyperbolic sine 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. #include <errno.h>
  23. #include <stddef.h>
  24.  
  25. /*--------------------------------------------------------------------------*
  26.  
  27. Name            sinhl - long double hyperbolic sine function
  28.  
  29. Usage           long double sinhl(long double x);
  30.  
  31. Prototype in    math.h
  32.  
  33. Description     sinhl computes the hyperbolic sine of the input value.
  34.  
  35. Return value    sinhl returns the hyperbolic sine of the input value.
  36.                 For  large arguments  (absolute value greater  than
  37.                 ~11356.5) the result  will be  _LHUGE_VAL of
  38.                 the appropriate sign and errno will be set to:
  39.                         ERANGE  Range error.
  40.  
  41. *---------------------------------------------------------------------------*/
  42.  
  43. /*
  44. Algorithm.
  45.  
  46. The usual formula is:
  47.         sinhl(x) = .5*(expl(x) - expl(-x))
  48. but there is a loss of precision in using this formula directly near 0.
  49.  
  50. Since sinhl(-x) = -sinhl(x), compute sinhl(|x|) and adjust the sign later.
  51.  
  52. If 0 <= x < 2^-33, return x.
  53.  
  54. If x >= 11356.5 call matherr.
  55.  
  56. If x >= .3465, use
  57.         y = expl(x)
  58.         sinhl(x) = (y - 1/y)/2
  59.  
  60. If 2^-33 <= x < .3465, use
  61.         y = expl(x) - 1
  62.         sinhl(x) = (y + y/(1 + y))/2
  63. where special chip functions are used to get expl(x)-1 accurately.
  64.  
  65. */
  66.  
  67. #pragma warn -rvl
  68. long double _FARFUNC sinhl (long double  x)
  69. {
  70. asm     FLD1
  71. asm     mov     ax, 7FFFh
  72. asm     FCHS                    /* TOS = -1.0, used in FSCALE later */
  73. asm     mov     dx, x [8]
  74. asm     and     ax, dx          /* select exponent */
  75.  
  76. asm     FLD     LONGDOUBLE (x)
  77. asm     cmp     ax, 3fffh+13    /* 2^13 is the near the limit */
  78. asm     jae     sinhl_tooBig
  79.  
  80. asm     FABS
  81. asm     cmp     ax, 3FFDh       /* compare with .3465 */
  82. asm     jb      jb_sinhl_small  /* avoid "jmp out of range" error */
  83. asm     ja      sinhl_justFits
  84. asm     cmp     W0 (x [6]), 0B168h
  85. jb_sinhl_small:
  86. asm     jb      sinhl_small
  87.  
  88. sinhl_justFits:
  89.         __expld();               /* TOS = expl(x) */
  90.  
  91. asm     FLD1
  92. asm     FDIV    st, st(1)       /* Exp (-x)     */
  93. asm     FSUBP   st(1), st
  94. asm     FSCALE                  /* sinhl (x) = (exp(x) - exp(-x)) / 2   */
  95.  
  96. sinhl_end:
  97. asm     FSTP    st(1)   /* discard the -1 */
  98. /* change sign if original argument was negative */
  99. asm     or      dh, dh
  100. asm     jns     sinhl_end2
  101. asm     FCHS
  102. sinhl_end2:
  103.         return;
  104.  
  105. sinhl_tooBig:
  106. asm     ja      sinhl_over
  107. asm     cmp     W0 (x [6]), 0B172h
  108. asm     jb      sinhl_justFits
  109.  
  110. sinhl_over:
  111. asm     FSTP    ST(0)                   /* pop two items off the stack */
  112. asm     FSTP    ST(0)
  113.  
  114. #pragma warn -ret
  115.         return  __matherrl (OVERFLOW, "sinhl", &x, NULL,
  116.                             (_DX & 0x8000) ? - _LHUGE_VAL : _LHUGE_VAL);
  117. #pragma warn .ret
  118.  
  119. sinhl_small:
  120. asm     cmp     ax, 3fffh-33            /* x < 2^-33 ? */
  121. asm     jb      sinhl_end               /* x tiny, return x */
  122.  
  123. asm     FLDL2E
  124. asm     FMUL
  125. asm     F2XM1
  126. /* TOS = y = exp(x) - 1 */
  127. asm     FLD1
  128. asm     FADD    st(0),st(1)
  129. /* stack = 1+y,y,-1 */
  130. asm     FDIVR   st(0),st(1)
  131. asm     FADD
  132. asm     FSCALE
  133.         goto sinhl_end;
  134. }
  135. #pragma warn .rvl
  136.