home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c065 / 2.ddi / MATH.ZIP / LDTRUNC.CAS < prev    next >
Encoding:
Text File  |  1990-06-07  |  3.9 KB  |  147 lines
  1. /*------------------------------------------------------------------------
  2.  * filename - ldtrunc.cas
  3.  *
  4.  * function(s)
  5.  *        __ldtrunc - internal function
  6.  *-----------------------------------------------------------------------*/
  7.  
  8. /*[]------------------------------------------------------------[]*/
  9. /*|                                                              |*/
  10. /*|     Turbo C Run Time Library - Version 3.0                   |*/
  11. /*|                                                              |*/
  12. /*|                                                              |*/
  13. /*|     Copyright (c) 1987, 1990 by Borland International        |*/
  14. /*|     All Rights Reserved.                                     |*/
  15. /*|                                                              |*/
  16. /*[]------------------------------------------------------------[]*/
  17.  
  18. #pragma inline
  19. #pragma warn -rvl
  20. #pragma warn -ret
  21. #include <errno.h>
  22. #include <_scanf.h>
  23.  
  24.  
  25. /*----------------------------------------------------------*
  26. double near pascal __ldtrunc(int flag, long double x, double xhuge);
  27.  
  28. __ldtrunc() is an internal TC library function which truncates a
  29. long double to a float (flag=0) or a double (flag=1), within the
  30. constraints of what can be done in a library function.  The
  31. argument is checked for underflow, which is flushed to 0, and
  32. overflowed, which is changed to xhuge.  In either case, the sign
  33. of x is attached to the result.  Otherwise, x is returned
  34. unchanged.  The global errno is set to ERANGE, if an overflow or
  35. underflow would have occurred.  No overflow or underflow
  36. exceptions are generated.
  37.  
  38. If flag = 0, it is suggested that xhuge = 1./0.
  39. If flag = 1, it is suggested that yhuge = HUGE_VAL.
  40.  
  41. *-----------------------------------------------------------*/
  42.  
  43. /*
  44.  
  45. Method:
  46.  
  47. The exponent (biased) in long double format is used to determine
  48. whether an overflow or underflow will occur.  This is quick and
  49. reliable, except for a few subtleties involving roundoff at the
  50. extreme exponents.
  51.  
  52. cutoff values:
  53.  
  54. largest normal double has biased exponent 43FEh in 10-byte format.
  55. smallest normal double has biased exponent 3C01h in 10-byte format.
  56. smallest denormal double has biased exponent 3BCDh in 10-byte format.
  57.  
  58. largest normal float has biased exponent 407Eh in 10-byte format.
  59. smallest normal float has biased exponent 3F81h in 10-byte format.
  60. smallest denormal float has biased exponent 3F6Ah in 10-byte format.
  61.  
  62. */
  63.  
  64.  
  65.  
  66. double near pascal __ldtrunc(int flag, long double x, double xhuge)
  67. {
  68.     volatile unsigned cword, cword2;
  69.     _CX = 0;
  70.  
  71. /* AX = overflow threshold, BX = underflow threshold */
  72. asm    mov    ax, 43FEh
  73. asm    mov    bx, 3BCDh
  74. asm    cmp    word ptr flag, 0
  75. asm    jne    start
  76. asm    mov    ax, 407Eh
  77. asm    mov    bx, 3F6Ah
  78. start:
  79.  
  80. asm    mov    dx, x[8]
  81. asm    shl    dx, 1
  82. asm    rcl    cx, 1
  83. asm    shr    dx, 1
  84. /* CX = sign bit, DX = biased exponent */
  85. /* let INF, NAN pass */
  86. asm    cmp    dx, 7FFFh
  87. asm    je    ret
  88. /* test for overflow */
  89. asm    cmp    dx, ax
  90. asm    je    hugex
  91. asm    jle    notinf
  92. /* overflow to HUGE_VAL with appropriate sign */
  93. asm    fld    qword ptr xhuge
  94.     goto ret1;
  95.  
  96. hugex:
  97. /* chop in borderline infinite case, to avoid overflow */
  98. asm    fstcw    cword
  99. asm    mov    ax, 0C00h
  100. asm    fwait
  101. asm    or    ax, cword
  102. asm    mov    cword2, ax
  103. asm    fldcw    cword2
  104. asm    fld    tbyte ptr x
  105. asm    cmp    word ptr flag, 0
  106. asm    jne    s1
  107. asm    fstp    dword ptr xhuge
  108. asm    fld    dword ptr xhuge
  109. asm    jmp    short s2
  110. s1:
  111. asm    fstp    qword ptr xhuge
  112. asm    fld    qword ptr xhuge
  113. s2:
  114. /* restore previous control word */
  115. asm    fldcw    cword
  116.     return;
  117.  
  118. notinf:
  119. /* test for +0 or -0 */
  120. asm    mov    ax, dx
  121. asm    or    ax, x[6]
  122. asm    or    ax, x[4]
  123. asm    or    ax, x[2]
  124. asm    or    ax, x[0]
  125. asm    jz    ret
  126.  
  127. /* test for underflow */
  128. asm    cmp    dx, bx
  129. asm    jge    ret
  130.  
  131. /* underflow to 0 with appropriate sign */
  132. asm    fldz
  133. ret1:
  134. asm    or    cx, cx
  135. asm    jz    ret0
  136. asm    fchs
  137. ret0:
  138.     errno = ERANGE;
  139.     return;
  140. ret:
  141.     return x;
  142. }
  143.  
  144. /* to guarantee scantod.cas code gets linked */
  145. /* need this for atof(), strtod() */
  146. asm    extrn __turboFloat : ABS
  147.