Subversion Repositories Kolibri OS

Rev

Rev 4921 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. /*
  2. FUNCTION
  3.         <<strtod>>, <<strtof>>---string to double or float
  4.  
  5. INDEX
  6.         strtod
  7. INDEX
  8.         _strtod_r
  9. INDEX
  10.         strtof
  11.  
  12. ANSI_SYNOPSIS
  13.         #include <stdlib.h>
  14.         double strtod(const char *restrict <[str]>, char **restrict <[tail]>);
  15.         float strtof(const char *restrict <[str]>, char **restrict <[tail]>);
  16.  
  17.         double _strtod_r(void *<[reent]>,
  18.                          const char *restrict <[str]>, char **restrict <[tail]>);
  19.  
  20. TRAD_SYNOPSIS
  21.         #include <stdlib.h>
  22.         double strtod(<[str]>,<[tail]>)
  23.         char *<[str]>;
  24.         char **<[tail]>;
  25.  
  26.         float strtof(<[str]>,<[tail]>)
  27.         char *<[str]>;
  28.         char **<[tail]>;
  29.  
  30.         double _strtod_r(<[reent]>,<[str]>,<[tail]>)
  31.         char *<[reent]>;
  32.         char *<[str]>;
  33.         char **<[tail]>;
  34.  
  35. DESCRIPTION
  36.         The function <<strtod>> parses the character string <[str]>,
  37.         producing a substring which can be converted to a double
  38.         value.  The substring converted is the longest initial
  39.         subsequence of <[str]>, beginning with the first
  40.         non-whitespace character, that has one of these formats:
  41.         .[+|-]<[digits]>[.[<[digits]>]][(e|E)[+|-]<[digits]>]
  42.         .[+|-].<[digits]>[(e|E)[+|-]<[digits]>]
  43.         .[+|-](i|I)(n|N)(f|F)[(i|I)(n|N)(i|I)(t|T)(y|Y)]
  44.         .[+|-](n|N)(a|A)(n|N)[<(>[<[hexdigits]>]<)>]
  45.         .[+|-]0(x|X)<[hexdigits]>[.[<[hexdigits]>]][(p|P)[+|-]<[digits]>]
  46.         .[+|-]0(x|X).<[hexdigits]>[(p|P)[+|-]<[digits]>]
  47.         The substring contains no characters if <[str]> is empty, consists
  48.         entirely of whitespace, or if the first non-whitespace
  49.         character is something other than <<+>>, <<->>, <<.>>, or a
  50.         digit, and cannot be parsed as infinity or NaN. If the platform
  51.         does not support NaN, then NaN is treated as an empty substring.
  52.         If the substring is empty, no conversion is done, and
  53.         the value of <[str]> is stored in <<*<[tail]>>>.  Otherwise,
  54.         the substring is converted, and a pointer to the final string
  55.         (which will contain at least the terminating null character of
  56.         <[str]>) is stored in <<*<[tail]>>>.  If you want no
  57.         assignment to <<*<[tail]>>>, pass a null pointer as <[tail]>.
  58.         <<strtof>> is identical to <<strtod>> except for its return type.
  59.  
  60.         This implementation returns the nearest machine number to the
  61.         input decimal string.  Ties are broken by using the IEEE
  62.         round-even rule.  However, <<strtof>> is currently subject to
  63.         double rounding errors.
  64.  
  65.         The alternate function <<_strtod_r>> is a reentrant version.
  66.         The extra argument <[reent]> is a pointer to a reentrancy structure.
  67.  
  68. RETURNS
  69.         <<strtod>> returns the converted substring value, if any.  If
  70.         no conversion could be performed, 0 is returned.  If the
  71.         correct value is out of the range of representable values,
  72.         plus or minus <<HUGE_VAL>> is returned, and <<ERANGE>> is
  73.         stored in errno. If the correct value would cause underflow, 0
  74.         is returned and <<ERANGE>> is stored in errno.
  75.  
  76. Supporting OS subroutines required: <<close>>, <<fstat>>, <<isatty>>,
  77. <<lseek>>, <<read>>, <<sbrk>>, <<write>>.
  78. */
  79.  
  80. /****************************************************************
  81.  
  82. The author of this software is David M. Gay.
  83.  
  84. Copyright (C) 1998-2001 by Lucent Technologies
  85. All Rights Reserved
  86.  
  87. Permission to use, copy, modify, and distribute this software and
  88. its documentation for any purpose and without fee is hereby
  89. granted, provided that the above copyright notice appear in all
  90. copies and that both that the copyright notice and this
  91. permission notice and warranty disclaimer appear in supporting
  92. documentation, and that the name of Lucent or any of its entities
  93. not be used in advertising or publicity pertaining to
  94. distribution of the software without specific, written prior
  95. permission.
  96.  
  97. LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
  98. INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
  99. IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
  100. SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  101. WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
  102. IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
  103. ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
  104. THIS SOFTWARE.
  105.  
  106. ****************************************************************/
  107.  
  108. /* Please send bug reports to David M. Gay (dmg at acm dot org,
  109.  * with " at " changed at "@" and " dot " changed to ".").      */
  110.  
  111. /* Original file gdtoa-strtod.c Modified 06-21-2006 by Jeff Johnston to work within newlib.  */
  112.  
  113. #include <_ansi.h>
  114. #include <errno.h>
  115. #include <stdlib.h>
  116. #include <string.h>
  117. #include "mprec.h"
  118. #include "gdtoa.h"
  119. #include "gd_qnan.h"
  120.  
  121. /* #ifndef NO_FENV_H */
  122. /* #include <fenv.h> */
  123. /* #endif */
  124.  
  125. #include "locale.h"
  126.  
  127. #ifdef IEEE_Arith
  128. #ifndef NO_IEEE_Scale
  129. #define Avoid_Underflow
  130. #undef tinytens
  131. /* The factor of 2^106 in tinytens[4] helps us avoid setting the underflow */
  132. /* flag unnecessarily.  It leads to a song and dance at the end of strtod. */
  133. static _CONST double tinytens[] = { 1e-16, 1e-32,
  134. #ifdef _DOUBLE_IS_32BITS
  135.                                     0.0, 0.0, 0.0
  136. #else
  137.                                     1e-64, 1e-128,
  138.                                     9007199254740992. * 9007199254740992.e-256
  139. #endif
  140.                                   };
  141.  
  142. #endif
  143. #endif
  144.  
  145. #ifdef Honor_FLT_ROUNDS
  146. #define Rounding rounding
  147. #undef Check_FLT_ROUNDS
  148. #define Check_FLT_ROUNDS
  149. #else
  150. #define Rounding Flt_Rounds
  151. #endif
  152.  
  153. #ifdef Avoid_Underflow /*{*/
  154.  static double
  155. _DEFUN (sulp, (x, scale),
  156.         U x _AND
  157.         int scale)
  158. {
  159.         U u;
  160.         double rv;
  161.         int i;
  162.  
  163.         rv = ulp(dval(x));
  164.         if (!scale || (i = 2*P + 1 - ((dword0(x) & Exp_mask) >> Exp_shift)) <= 0)
  165.                 return rv; /* Is there an example where i <= 0 ? */
  166.         dword0(u) = Exp_1 + ((__int32_t)i << Exp_shift);
  167. #ifndef _DOUBLE_IS_32BITS
  168.         dword1(u) = 0;
  169. #endif
  170.         return rv * u.d;
  171.         }
  172. #endif /*}*/
  173.  
  174.  
  175. #ifndef NO_HEX_FP
  176.  
  177. static void
  178. _DEFUN (ULtod, (L, bits, exp, k),
  179.         __ULong *L _AND
  180.         __ULong *bits _AND
  181.         Long exp _AND
  182.         int k)
  183. {
  184.         switch(k & STRTOG_Retmask) {
  185.           case STRTOG_NoNumber:
  186.           case STRTOG_Zero:
  187.                 L[0] = L[1] = 0;
  188.                 break;
  189.  
  190.           case STRTOG_Denormal:
  191.                 L[_1] = bits[0];
  192.                 L[_0] = bits[1];
  193.                 break;
  194.  
  195.           case STRTOG_Normal:
  196.           case STRTOG_NaNbits:
  197.                 L[_1] = bits[0];
  198.                 L[_0] = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
  199.                 break;
  200.  
  201.           case STRTOG_Infinite:
  202.                 L[_0] = 0x7ff00000;
  203.                 L[_1] = 0;
  204.                 break;
  205.  
  206.           case STRTOG_NaN:
  207.                 L[_0] = 0x7fffffff;
  208.                 L[_1] = (__ULong)-1;
  209.           }
  210.         if (k & STRTOG_Neg)
  211.                 L[_0] |= 0x80000000L;
  212. }
  213. #endif /* !NO_HEX_FP */
  214.  
  215. double
  216. _DEFUN (_strtod_r, (ptr, s00, se),
  217.         struct _reent *ptr _AND
  218.         _CONST char *__restrict s00 _AND
  219.         char **__restrict se)
  220. {
  221. #ifdef Avoid_Underflow
  222.         int scale;
  223. #endif
  224.         int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, dsign,
  225.                  e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
  226.         _CONST char *s, *s0, *s1;
  227.         double aadj, adj;
  228.         U aadj1, rv, rv0;
  229.         Long L;
  230.         __ULong y, z;
  231.         _Bigint *bb = NULL, *bb1, *bd = NULL, *bd0, *bs = NULL, *delta = NULL;
  232. #ifdef Avoid_Underflow
  233.         __ULong Lsb, Lsb1;
  234. #endif
  235. #ifdef SET_INEXACT
  236.         int inexact, oldinexact;
  237. #endif
  238. #ifdef Honor_FLT_ROUNDS
  239.         int rounding;
  240. #endif
  241.  
  242.         delta = bs = bd = NULL;
  243.         sign = nz0 = nz = decpt = 0;
  244.         dval(rv) = 0.;
  245.         for(s = s00;;s++) switch(*s) {
  246.                 case '-':
  247.                         sign = 1;
  248.                         /* no break */
  249.                 case '+':
  250.                         if (*++s)
  251.                                 goto break2;
  252.                         /* no break */
  253.                 case 0:
  254.                         goto ret0;
  255.                 case '\t':
  256.                 case '\n':
  257.                 case '\v':
  258.                 case '\f':
  259.                 case '\r':
  260.                 case ' ':
  261.                         continue;
  262.                 default:
  263.                         goto break2;
  264.                 }
  265.  break2:
  266.         if (*s == '0') {
  267. #ifndef NO_HEX_FP
  268.                 {
  269.                 static _CONST FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
  270.                 Long exp;
  271.                 __ULong bits[2];
  272.                 switch(s[1]) {
  273.                   case 'x':
  274.                   case 'X':
  275.                         /* If the number is not hex, then the parse of
  276.                            0 is still valid.  */
  277.                         s00 = s + 1;
  278.                         {
  279. #if defined(FE_DOWNWARD) && defined(FE_TONEAREST) && defined(FE_TOWARDZERO) && defined(FE_UPWARD)
  280.                         FPI fpi1 = fpi;
  281.                         switch(fegetround()) {
  282.                           case FE_TOWARDZERO:   fpi1.rounding = 0; break;
  283.                           case FE_UPWARD:       fpi1.rounding = 2; break;
  284.                           case FE_DOWNWARD:     fpi1.rounding = 3;
  285.                           }
  286. #else
  287. #define fpi1 fpi
  288. #endif
  289.                         switch((i = gethex(ptr, &s, &fpi1, &exp, &bb, sign)) & STRTOG_Retmask) {
  290.                           case STRTOG_NoNumber:
  291.                                 s = s00;
  292.                                 sign = 0;
  293.                                 /* FALLTHROUGH */
  294.                           case STRTOG_Zero:
  295.                                 break;
  296.                           default:
  297.                                 if (bb) {
  298.                                         copybits(bits, fpi.nbits, bb);
  299.                                         Bfree(ptr,bb);
  300.                                         }
  301.                                 ULtod(rv.i, bits, exp, i);
  302.                           }}
  303.                         goto ret;
  304.                   }
  305.                 }
  306. #endif
  307.                 nz0 = 1;
  308.                 while(*++s == '0') ;
  309.                 if (!*s)
  310.                         goto ret;
  311.                 }
  312.         s0 = s;
  313.         y = z = 0;
  314.         for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
  315.                 if (nd < 9)
  316.                         y = 10*y + c - '0';
  317.                 else
  318.                         z = 10*z + c - '0';
  319.         nd0 = nd;
  320.         if (strncmp (s, _localeconv_r (ptr)->decimal_point,
  321.                      strlen (_localeconv_r (ptr)->decimal_point)) == 0)
  322.                 {
  323.                 decpt = 1;
  324.                 c = *(s += strlen (_localeconv_r (ptr)->decimal_point));
  325.                 if (!nd) {
  326.                         for(; c == '0'; c = *++s)
  327.                                 nz++;
  328.                         if (c > '0' && c <= '9') {
  329.                                 s0 = s;
  330.                                 nf += nz;
  331.                                 nz = 0;
  332.                                 goto have_dig;
  333.                                 }
  334.                         goto dig_done;
  335.                         }
  336.                 for(; c >= '0' && c <= '9'; c = *++s) {
  337.  have_dig:
  338.                         nz++;
  339.                         if (c -= '0') {
  340.                                 nf += nz;
  341.                                 for(i = 1; i < nz; i++)
  342.                                         if (nd++ < 9)
  343.                                                 y *= 10;
  344.                                         else if (nd <= DBL_DIG + 1)
  345.                                                 z *= 10;
  346.                                 if (nd++ < 9)
  347.                                         y = 10*y + c;
  348.                                 else if (nd <= DBL_DIG + 1)
  349.                                         z = 10*z + c;
  350.                                 nz = 0;
  351.                                 }
  352.                         }
  353.                 }
  354.  dig_done:
  355.         e = 0;
  356.         if (c == 'e' || c == 'E') {
  357.                 if (!nd && !nz && !nz0) {
  358.                         goto ret0;
  359.                         }
  360.                 s00 = s;
  361.                 esign = 0;
  362.                 switch(c = *++s) {
  363.                         case '-':
  364.                                 esign = 1;
  365.                         case '+':
  366.                                 c = *++s;
  367.                         }
  368.                 if (c >= '0' && c <= '9') {
  369.                         while(c == '0')
  370.                                 c = *++s;
  371.                         if (c > '0' && c <= '9') {
  372.                                 L = c - '0';
  373.                                 s1 = s;
  374.                                 while((c = *++s) >= '0' && c <= '9')
  375.                                         L = 10*L + c - '0';
  376.                                 if (s - s1 > 8 || L > 19999)
  377.                                         /* Avoid confusion from exponents
  378.                                          * so large that e might overflow.
  379.                                          */
  380.                                         e = 19999; /* safe for 16 bit ints */
  381.                                 else
  382.                                         e = (int)L;
  383.                                 if (esign)
  384.                                         e = -e;
  385.                                 }
  386.                         else
  387.                                 e = 0;
  388.                         }
  389.                 else
  390.                         s = s00;
  391.                 }
  392.         if (!nd) {
  393.                 if (!nz && !nz0) {
  394. #ifdef INFNAN_CHECK
  395.                         /* Check for Nan and Infinity */
  396.                         __ULong bits[2];
  397.                         static _CONST FPI fpinan =      /* only 52 explicit bits */
  398.                                 { 52, 1-1023-53+1, 2046-1023-53+1, 1, SI };
  399.                         if (!decpt)
  400.                          switch(c) {
  401.                           case 'i':
  402.                           case 'I':
  403.                                 if (match(&s,"nf")) {
  404.                                         --s;
  405.                                         if (!match(&s,"inity"))
  406.                                                 ++s;
  407.                                         dword0(rv) = 0x7ff00000;
  408. #ifndef _DOUBLE_IS_32BITS
  409.                                         dword1(rv) = 0;
  410. #endif /*!_DOUBLE_IS_32BITS*/
  411.                                         goto ret;
  412.                                         }
  413.                                 break;
  414.                           case 'n':
  415.                           case 'N':
  416.                                 if (match(&s, "an")) {
  417. #ifndef No_Hex_NaN
  418.                                         if (*s == '(' /*)*/
  419.                                          && hexnan(&s, &fpinan, bits)
  420.                                                         == STRTOG_NaNbits) {
  421.                                                 dword0(rv) = 0x7ff00000 | bits[1];
  422. #ifndef _DOUBLE_IS_32BITS
  423.                                                 dword1(rv) = bits[0];
  424. #endif /*!_DOUBLE_IS_32BITS*/
  425.                                                 }
  426.                                         else {
  427. #endif
  428.                                                 dword0(rv) = NAN_WORD0;
  429. #ifndef _DOUBLE_IS_32BITS
  430.                                                 dword1(rv) = NAN_WORD1;
  431. #endif /*!_DOUBLE_IS_32BITS*/
  432. #ifndef No_Hex_NaN
  433.                                                 }
  434. #endif
  435.                                         goto ret;
  436.                                         }
  437.                           }
  438. #endif /* INFNAN_CHECK */
  439.  ret0:
  440.                         s = s00;
  441.                         sign = 0;
  442.                         }
  443.                 goto ret;
  444.                 }
  445.         e1 = e -= nf;
  446.  
  447.         /* Now we have nd0 digits, starting at s0, followed by a
  448.          * decimal point, followed by nd-nd0 digits.  The number we're
  449.          * after is the integer represented by those digits times
  450.          * 10**e */
  451.  
  452.         if (!nd0)
  453.                 nd0 = nd;
  454.         k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
  455.         dval(rv) = y;
  456.         if (k > 9) {
  457. #ifdef SET_INEXACT
  458.                 if (k > DBL_DIG)
  459.                         oldinexact = get_inexact();
  460. #endif
  461.                 dval(rv) = tens[k - 9] * dval(rv) + z;
  462.                 }
  463.         bd0 = 0;
  464.         if (nd <= DBL_DIG
  465. #ifndef RND_PRODQUOT
  466. #ifndef Honor_FLT_ROUNDS
  467.                 && Flt_Rounds == 1
  468. #endif
  469. #endif
  470.                         ) {
  471.                 if (!e)
  472.                         goto ret;
  473.                 if (e > 0) {
  474.                         if (e <= Ten_pmax) {
  475. #ifdef VAX
  476.                                 goto vax_ovfl_check;
  477. #else
  478. #ifdef Honor_FLT_ROUNDS
  479.                                 /* round correctly FLT_ROUNDS = 2 or 3 */
  480.                                 if (sign) {
  481.                                         dval(rv) = -dval(rv);
  482.                                         sign = 0;
  483.                                         }
  484. #endif
  485.                                 /* rv = */ rounded_product(dval(rv), tens[e]);
  486.                                 goto ret;
  487. #endif
  488.                                 }
  489.                         i = DBL_DIG - nd;
  490.                         if (e <= Ten_pmax + i) {
  491.                                 /* A fancier test would sometimes let us do
  492.                                  * this for larger i values.
  493.                                  */
  494. #ifdef Honor_FLT_ROUNDS
  495.                                 /* round correctly FLT_ROUNDS = 2 or 3 */
  496.                                 if (sign) {
  497.                                         dval(rv) = -dval(rv);
  498.                                         sign = 0;
  499.                                         }
  500. #endif
  501.                                 e -= i;
  502.                                 dval(rv) *= tens[i];
  503. #ifdef VAX
  504.                                 /* VAX exponent range is so narrow we must
  505.                                  * worry about overflow here...
  506.                                  */
  507.  vax_ovfl_check:
  508.                                 dword0(rv) -= P*Exp_msk1;
  509.                                 /* rv = */ rounded_product(dval(rv), tens[e]);
  510.                                 if ((dword0(rv) & Exp_mask)
  511.                                  > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
  512.                                         goto ovfl;
  513.                                 dword0(rv) += P*Exp_msk1;
  514. #else
  515.                                 /* rv = */ rounded_product(dval(rv), tens[e]);
  516. #endif
  517.                                 goto ret;
  518.                                 }
  519.                         }
  520. #ifndef Inaccurate_Divide
  521.                 else if (e >= -Ten_pmax) {
  522. #ifdef Honor_FLT_ROUNDS
  523.                         /* round correctly FLT_ROUNDS = 2 or 3 */
  524.                         if (sign) {
  525.                                 dval(rv) = -dval(rv);
  526.                                 sign = 0;
  527.                                 }
  528. #endif
  529.                         /* rv = */ rounded_quotient(dval(rv), tens[-e]);
  530.                         goto ret;
  531.                         }
  532. #endif
  533.                 }
  534.         e1 += nd - k;
  535.  
  536. #ifdef IEEE_Arith
  537. #ifdef SET_INEXACT
  538.         inexact = 1;
  539.         if (k <= DBL_DIG)
  540.                 oldinexact = get_inexact();
  541. #endif
  542. #ifdef Avoid_Underflow
  543.         scale = 0;
  544. #endif
  545. #ifdef Honor_FLT_ROUNDS
  546.         if ((rounding = Flt_Rounds) >= 2) {
  547.                 if (sign)
  548.                         rounding = rounding == 2 ? 0 : 2;
  549.                 else
  550.                         if (rounding != 2)
  551.                                 rounding = 0;
  552.                 }
  553. #endif
  554. #endif /*IEEE_Arith*/
  555.  
  556.         /* Get starting approximation = rv * 10**e1 */
  557.  
  558.         if (e1 > 0) {
  559.                 if ( (i = e1 & 15) !=0)
  560.                         dval(rv) *= tens[i];
  561.                 if (e1 &= ~15) {
  562.                         if (e1 > DBL_MAX_10_EXP) {
  563.  ovfl:
  564. #ifndef NO_ERRNO
  565.                                 ptr->_errno = ERANGE;
  566. #endif
  567.                                 /* Can't trust HUGE_VAL */
  568. #ifdef IEEE_Arith
  569. #ifdef Honor_FLT_ROUNDS
  570.                                 switch(rounding) {
  571.                                   case 0: /* toward 0 */
  572.                                   case 3: /* toward -infinity */
  573.                                         dword0(rv) = Big0;
  574. #ifndef _DOUBLE_IS_32BITS
  575.                                         dword1(rv) = Big1;
  576. #endif /*!_DOUBLE_IS_32BITS*/
  577.                                         break;
  578.                                   default:
  579.                                         dword0(rv) = Exp_mask;
  580. #ifndef _DOUBLE_IS_32BITS
  581.                                         dword1(rv) = 0;
  582. #endif /*!_DOUBLE_IS_32BITS*/
  583.                                   }
  584. #else /*Honor_FLT_ROUNDS*/
  585.                                 dword0(rv) = Exp_mask;
  586. #ifndef _DOUBLE_IS_32BITS
  587.                                 dword1(rv) = 0;
  588. #endif /*!_DOUBLE_IS_32BITS*/
  589. #endif /*Honor_FLT_ROUNDS*/
  590. #ifdef SET_INEXACT
  591.                                 /* set overflow bit */
  592.                                 dval(rv0) = 1e300;
  593.                                 dval(rv0) *= dval(rv0);
  594. #endif
  595. #else /*IEEE_Arith*/
  596.                                 dword0(rv) = Big0;
  597. #ifndef _DOUBLE_IS_32BITS
  598.                                 dword1(rv) = Big1;
  599. #endif /*!_DOUBLE_IS_32BITS*/
  600. #endif /*IEEE_Arith*/
  601.                                 if (bd0)
  602.                                         goto retfree;
  603.                                 goto ret;
  604.                                 }
  605.                         e1 >>= 4;
  606.                         for(j = 0; e1 > 1; j++, e1 >>= 1)
  607.                                 if (e1 & 1)
  608.                                         dval(rv) *= bigtens[j];
  609.                 /* The last multiplication could overflow. */
  610.                         dword0(rv) -= P*Exp_msk1;
  611.                         dval(rv) *= bigtens[j];
  612.                         if ((z = dword0(rv) & Exp_mask)
  613.                          > Exp_msk1*(DBL_MAX_EXP+Bias-P))
  614.                                 goto ovfl;
  615.                         if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
  616.                                 /* set to largest number */
  617.                                 /* (Can't trust DBL_MAX) */
  618.                                 dword0(rv) = Big0;
  619. #ifndef _DOUBLE_IS_32BITS
  620.                                 dword1(rv) = Big1;
  621. #endif /*!_DOUBLE_IS_32BITS*/
  622.                                 }
  623.                         else
  624.                                 dword0(rv) += P*Exp_msk1;
  625.                         }
  626.                 }
  627.         else if (e1 < 0) {
  628.                 e1 = -e1;
  629.                 if ( (i = e1 & 15) !=0)
  630.                         dval(rv) /= tens[i];
  631.                 if (e1 >>= 4) {
  632.                         if (e1 >= 1 << n_bigtens)
  633.                                 goto undfl;
  634. #ifdef Avoid_Underflow
  635.                         if (e1 & Scale_Bit)
  636.                                 scale = 2*P;
  637.                         for(j = 0; e1 > 0; j++, e1 >>= 1)
  638.                                 if (e1 & 1)
  639.                                         dval(rv) *= tinytens[j];
  640.                         if (scale && (j = 2*P + 1 - ((dword0(rv) & Exp_mask)
  641.                                                 >> Exp_shift)) > 0) {
  642.                                 /* scaled rv is denormal; zap j low bits */
  643.                                 if (j >= 32) {
  644. #ifndef _DOUBLE_IS_32BITS
  645.                                         dword1(rv) = 0;
  646. #endif /*!_DOUBLE_IS_32BITS*/
  647.                                         if (j >= 53)
  648.                                          dword0(rv) = (P+2)*Exp_msk1;
  649.                                         else
  650.                                          dword0(rv) &= 0xffffffff << (j-32);
  651.                                         }
  652. #ifndef _DOUBLE_IS_32BITS
  653.                                 else
  654.                                         dword1(rv) &= 0xffffffff << j;
  655. #endif /*!_DOUBLE_IS_32BITS*/
  656.                                 }
  657. #else
  658.                         for(j = 0; e1 > 1; j++, e1 >>= 1)
  659.                                 if (e1 & 1)
  660.                                         dval(rv) *= tinytens[j];
  661.                         /* The last multiplication could underflow. */
  662.                         dval(rv0) = dval(rv);
  663.                         dval(rv) *= tinytens[j];
  664.                         if (!dval(rv)) {
  665.                                 dval(rv) = 2.*dval(rv0);
  666.                                 dval(rv) *= tinytens[j];
  667. #endif
  668.                                 if (!dval(rv)) {
  669.  undfl:
  670.                                         dval(rv) = 0.;
  671. #ifndef NO_ERRNO
  672.                                         ptr->_errno = ERANGE;
  673. #endif
  674.                                         if (bd0)
  675.                                                 goto retfree;
  676.                                         goto ret;
  677.                                         }
  678. #ifndef Avoid_Underflow
  679. #ifndef _DOUBLE_IS_32BITS
  680.                                 dword0(rv) = Tiny0;
  681.                                 dword1(rv) = Tiny1;
  682. #else
  683.                                 dword0(rv) = Tiny1;
  684. #endif /*_DOUBLE_IS_32BITS*/
  685.                                 /* The refinement below will clean
  686.                                  * this approximation up.
  687.                                  */
  688.                                 }
  689. #endif
  690.                         }
  691.                 }
  692.  
  693.         /* Now the hard part -- adjusting rv to the correct value.*/
  694.  
  695.         /* Put digits into bd: true value = bd * 10^e */
  696.  
  697.         bd0 = s2b(ptr, s0, nd0, nd, y);
  698.         if (bd0 == NULL)
  699.                 goto ovfl;
  700.  
  701.         for(;;) {
  702.                 bd = Balloc(ptr,bd0->_k);
  703.                 if (bd == NULL)
  704.                         goto ovfl;
  705.                 Bcopy(bd, bd0);
  706.                 bb = d2b(ptr,dval(rv), &bbe, &bbbits);  /* rv = bb * 2^bbe */
  707.                 if (bb == NULL)
  708.                         goto ovfl;
  709.                 bs = i2b(ptr,1);
  710.                 if (bs == NULL)
  711.                         goto ovfl;
  712.  
  713.                 if (e >= 0) {
  714.                         bb2 = bb5 = 0;
  715.                         bd2 = bd5 = e;
  716.                         }
  717.                 else {
  718.                         bb2 = bb5 = -e;
  719.                         bd2 = bd5 = 0;
  720.                         }
  721.                 if (bbe >= 0)
  722.                         bb2 += bbe;
  723.                 else
  724.                         bd2 -= bbe;
  725.                 bs2 = bb2;
  726. #ifdef Honor_FLT_ROUNDS
  727.                 if (rounding != 1)
  728.                         bs2++;
  729. #endif
  730. #ifdef Avoid_Underflow
  731.                 Lsb = LSB;
  732.                 Lsb1 = 0;
  733.                 j = bbe - scale;
  734.                 i = j + bbbits - 1;     /* logb(rv) */
  735.                 j = P + 1 - bbbits;
  736.                 if (i < Emin) { /* denormal */
  737.                         i = Emin - i;
  738.                         j -= i;
  739.                         if (i < 32)
  740.                                 Lsb <<= i;
  741.                         else
  742.                                 Lsb1 = Lsb << (i-32);
  743.                         }
  744. #else /*Avoid_Underflow*/
  745. #ifdef Sudden_Underflow
  746. #ifdef IBM
  747.                 j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
  748. #else
  749.                 j = P + 1 - bbbits;
  750. #endif
  751. #else /*Sudden_Underflow*/
  752.                 j = bbe;
  753.                 i = j + bbbits - 1;     /* logb(rv) */
  754.                 if (i < Emin)   /* denormal */
  755.                         j += P - Emin;
  756.                 else
  757.                         j = P + 1 - bbbits;
  758. #endif /*Sudden_Underflow*/
  759. #endif /*Avoid_Underflow*/
  760.                 bb2 += j;
  761.                 bd2 += j;
  762. #ifdef Avoid_Underflow
  763.                 bd2 += scale;
  764. #endif
  765.                 i = bb2 < bd2 ? bb2 : bd2;
  766.                 if (i > bs2)
  767.                         i = bs2;
  768.                 if (i > 0) {
  769.                         bb2 -= i;
  770.                         bd2 -= i;
  771.                         bs2 -= i;
  772.                         }
  773.                 if (bb5 > 0) {
  774.                         bs = pow5mult(ptr, bs, bb5);
  775.                         if (bs == NULL)
  776.                                 goto ovfl;
  777.                         bb1 = mult(ptr, bs, bb);
  778.                         if (bb1 == NULL)
  779.                                 goto ovfl;
  780.                         Bfree(ptr, bb);
  781.                         bb = bb1;
  782.                         }
  783.                 if (bb2 > 0) {
  784.                         bb = lshift(ptr, bb, bb2);
  785.                         if (bb == NULL)
  786.                                 goto ovfl;
  787.                         }
  788.                 if (bd5 > 0) {
  789.                         bd = pow5mult(ptr, bd, bd5);
  790.                         if (bd == NULL)
  791.                                 goto ovfl;
  792.                         }
  793.                 if (bd2 > 0) {
  794.                         bd = lshift(ptr, bd, bd2);
  795.                         if (bd == NULL)
  796.                                 goto ovfl;
  797.                         }
  798.                 if (bs2 > 0) {
  799.                         bs = lshift(ptr, bs, bs2);
  800.                         if (bs == NULL)
  801.                                 goto ovfl;
  802.                         }
  803.                 delta = diff(ptr, bb, bd);
  804.                 if (delta == NULL)
  805.                         goto ovfl;
  806.                 dsign = delta->_sign;
  807.                 delta->_sign = 0;
  808.                 i = cmp(delta, bs);
  809. #ifdef Honor_FLT_ROUNDS
  810.                 if (rounding != 1) {
  811.                         if (i < 0) {
  812.                                 /* Error is less than an ulp */
  813.                                 if (!delta->_x[0] && delta->_wds <= 1) {
  814.                                         /* exact */
  815. #ifdef SET_INEXACT
  816.                                         inexact = 0;
  817. #endif
  818.                                         break;
  819.                                         }
  820.                                 if (rounding) {
  821.                                         if (dsign) {
  822.                                                 adj = 1.;
  823.                                                 goto apply_adj;
  824.                                                 }
  825.                                         }
  826.                                 else if (!dsign) {
  827.                                         adj = -1.;
  828.                                         if (!dword1(rv)
  829.                                             && !(dword0(rv) & Frac_mask)) {
  830.                                                 y = dword0(rv) & Exp_mask;
  831. #ifdef Avoid_Underflow
  832.                                                 if (!scale || y > 2*P*Exp_msk1)
  833. #else
  834.                                                 if (y)
  835. #endif
  836.                                                   {
  837.                                                   delta = lshift(ptr, delta,Log2P);
  838.                                                   if (cmp(delta, bs) <= 0)
  839.                                                         adj = -0.5;
  840.                                                   }
  841.                                                 }
  842.  apply_adj:
  843. #ifdef Avoid_Underflow
  844.                                         if (scale && (y = dword0(rv) & Exp_mask)
  845.                                                 <= 2*P*Exp_msk1)
  846.                                           dword0(adj) += (2*P+1)*Exp_msk1 - y;
  847. #else
  848. #ifdef Sudden_Underflow
  849.                                         if ((dword0(rv) & Exp_mask) <=
  850.                                                         P*Exp_msk1) {
  851.                                                 dword0(rv) += P*Exp_msk1;
  852.                                                 dval(rv) += adj*ulp(dval(rv));
  853.                                                 dword0(rv) -= P*Exp_msk1;
  854.                                                 }
  855.                                         else
  856. #endif /*Sudden_Underflow*/
  857. #endif /*Avoid_Underflow*/
  858.                                         dval(rv) += adj*ulp(dval(rv));
  859.                                         }
  860.                                 break;
  861.                                 }
  862.                         adj = ratio(delta, bs);
  863.                         if (adj < 1.)
  864.                                 adj = 1.;
  865.                         if (adj <= 0x7ffffffe) {
  866.                                 /* adj = rounding ? ceil(adj) : floor(adj); */
  867.                                 y = adj;
  868.                                 if (y != adj) {
  869.                                         if (!((rounding>>1) ^ dsign))
  870.                                                 y++;
  871.                                         adj = y;
  872.                                         }
  873.                                 }
  874. #ifdef Avoid_Underflow
  875.                         if (scale && (y = dword0(rv) & Exp_mask) <= 2*P*Exp_msk1)
  876.                                 dword0(adj) += (2*P+1)*Exp_msk1 - y;
  877. #else
  878. #ifdef Sudden_Underflow
  879.                         if ((dword0(rv) & Exp_mask) <= P*Exp_msk1) {
  880.                                 dword0(rv) += P*Exp_msk1;
  881.                                 adj *= ulp(dval(rv));
  882.                                 if (dsign)
  883.                                         dval(rv) += adj;
  884.                                 else
  885.                                         dval(rv) -= adj;
  886.                                 dword0(rv) -= P*Exp_msk1;
  887.                                 goto cont;
  888.                                 }
  889. #endif /*Sudden_Underflow*/
  890. #endif /*Avoid_Underflow*/
  891.                         adj *= ulp(dval(rv));
  892.                         if (dsign) {
  893.                                 if (dword0(rv) == Big0 && dword1(rv) == Big1)
  894.                                         goto ovfl;
  895.                                 dval(rv) += adj;
  896.                         else
  897.                                 dval(rv) -= adj;
  898.                         goto cont;
  899.                         }
  900. #endif /*Honor_FLT_ROUNDS*/
  901.  
  902.                 if (i < 0) {
  903.                         /* Error is less than half an ulp -- check for
  904.                          * special case of mantissa a power of two.
  905.                          */
  906.                         if (dsign || dword1(rv) || dword0(rv) & Bndry_mask
  907. #ifdef IEEE_Arith
  908. #ifdef Avoid_Underflow
  909.                          || (dword0(rv) & Exp_mask) <= (2*P+1)*Exp_msk1
  910. #else
  911.                          || (dword0(rv) & Exp_mask) <= Exp_msk1
  912. #endif
  913. #endif
  914.                                 ) {
  915. #ifdef SET_INEXACT
  916.                                 if (!delta->x[0] && delta->wds <= 1)
  917.                                         inexact = 0;
  918. #endif
  919.                                 break;
  920.                                 }
  921.                         if (!delta->_x[0] && delta->_wds <= 1) {
  922.                                 /* exact result */
  923. #ifdef SET_INEXACT
  924.                                 inexact = 0;
  925. #endif
  926.                                 break;
  927.                                 }
  928.                         delta = lshift(ptr,delta,Log2P);
  929.                         if (cmp(delta, bs) > 0)
  930.                                 goto drop_down;
  931.                         break;
  932.                         }
  933.                 if (i == 0) {
  934.                         /* exactly half-way between */
  935.                         if (dsign) {
  936.                                 if ((dword0(rv) & Bndry_mask1) == Bndry_mask1
  937.                                  &&  dword1(rv) == (
  938. #ifdef Avoid_Underflow
  939.                         (scale && (y = dword0(rv) & Exp_mask) <= 2*P*Exp_msk1)
  940.                 ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
  941. #endif
  942.                                                    0xffffffff)) {
  943.                                         /*boundary case -- increment exponent*/
  944.                                         if (dword0(rv) == Big0 && dword1(rv) == Big1)
  945.                                                 goto ovfl;
  946.                                         dword0(rv) = (dword0(rv) & Exp_mask)
  947.                                                 + Exp_msk1
  948. #ifdef IBM
  949.                                                 | Exp_msk1 >> 4
  950. #endif
  951.                                                 ;
  952. #ifndef _DOUBLE_IS_32BITS
  953.                                         dword1(rv) = 0;
  954. #endif /*!_DOUBLE_IS_32BITS*/
  955. #ifdef Avoid_Underflow
  956.                                         dsign = 0;
  957. #endif
  958.                                         break;
  959.                                         }
  960.                                 }
  961.                         else if (!(dword0(rv) & Bndry_mask) && !dword1(rv)) {
  962.  drop_down:
  963.                                 /* boundary case -- decrement exponent */
  964. #ifdef Sudden_Underflow /*{{*/
  965.                                 L = dword0(rv) & Exp_mask;
  966. #ifdef IBM
  967.                                 if (L <  Exp_msk1)
  968. #else
  969. #ifdef Avoid_Underflow
  970.                                 if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
  971. #else
  972.                                 if (L <= Exp_msk1)
  973. #endif /*Avoid_Underflow*/
  974. #endif /*IBM*/
  975.                                         goto undfl;
  976.                                 L -= Exp_msk1;
  977. #else /*Sudden_Underflow}{*/
  978. #ifdef Avoid_Underflow
  979.                                 if (scale) {
  980.                                         L = dword0(rv) & Exp_mask;
  981.                                         if (L <= (2*P+1)*Exp_msk1) {
  982.                                                 if (L > (P+2)*Exp_msk1)
  983.                                                         /* round even ==> */
  984.                                                         /* accept rv */
  985.                                                         break;
  986.                                                 /* rv = smallest denormal */
  987.                                                 goto undfl;
  988.                                                 }
  989.                                         }
  990. #endif /*Avoid_Underflow*/
  991.                                 L = (dword0(rv) & Exp_mask) - Exp_msk1;
  992. #endif /*Sudden_Underflow}*/
  993.                                 dword0(rv) = L | Bndry_mask1;
  994. #ifndef _DOUBLE_IS_32BITS
  995.                                 dword1(rv) = 0xffffffff;
  996. #endif /*!_DOUBLE_IS_32BITS*/
  997. #ifdef IBM
  998.                                 goto cont;
  999. #else
  1000.                                 break;
  1001. #endif
  1002.                                 }
  1003. #ifndef ROUND_BIASED
  1004. #ifdef Avoid_Underflow
  1005.                         if (Lsb1) {
  1006.                                 if (!(dword0(rv) & Lsb1))
  1007.                                         break;
  1008.                                 }
  1009.                         else if (!(dword1(rv) & Lsb))
  1010.                                 break;
  1011. #else
  1012.                         if (!(dword1(rv) & LSB))
  1013.                                 break;
  1014. #endif
  1015. #endif
  1016.                         if (dsign)
  1017. #ifdef Avoid_Underflow
  1018.                                 dval(rv) += sulp(rv, scale);
  1019. #else
  1020.                                 dval(rv) += ulp(dval(rv));
  1021. #endif
  1022. #ifndef ROUND_BIASED
  1023.                         else {
  1024. #ifdef Avoid_Underflow
  1025.                                 dval(rv) -= sulp(rv, scale);
  1026. #else
  1027.                                 dval(rv) -= ulp(dval(rv));
  1028. #endif
  1029. #ifndef Sudden_Underflow
  1030.                                 if (!dval(rv))
  1031.                                         goto undfl;
  1032. #endif
  1033.                                 }
  1034. #ifdef Avoid_Underflow
  1035.                         dsign = 1 - dsign;
  1036. #endif
  1037. #endif
  1038.                         break;
  1039.                         }
  1040.                 if ((aadj = ratio(delta, bs)) <= 2.) {
  1041.                         if (dsign)
  1042.                                 aadj = dval(aadj1) = 1.;
  1043.                         else if (dword1(rv) || dword0(rv) & Bndry_mask) {
  1044. #ifndef Sudden_Underflow
  1045.                                 if (dword1(rv) == Tiny1 && !dword0(rv))
  1046.                                         goto undfl;
  1047. #endif
  1048.                                 aadj = 1.;
  1049.                                 dval(aadj1) = -1.;
  1050.                                 }
  1051.                         else {
  1052.                                 /* special case -- power of FLT_RADIX to be */
  1053.                                 /* rounded down... */
  1054.  
  1055.                                 if (aadj < 2./FLT_RADIX)
  1056.                                         aadj = 1./FLT_RADIX;
  1057.                                 else
  1058.                                         aadj *= 0.5;
  1059.                                 dval(aadj1) = -aadj;
  1060.                                 }
  1061.                         }
  1062.                 else {
  1063.                         aadj *= 0.5;
  1064.                         dval(aadj1) = dsign ? aadj : -aadj;
  1065. #ifdef Check_FLT_ROUNDS
  1066.                         switch(Rounding) {
  1067.                                 case 2: /* towards +infinity */
  1068.                                         dval(aadj1) -= 0.5;
  1069.                                         break;
  1070.                                 case 0: /* towards 0 */
  1071.                                 case 3: /* towards -infinity */
  1072.                                         dval(aadj1) += 0.5;
  1073.                                 }
  1074. #else
  1075.                         if (Flt_Rounds == 0)
  1076.                                 dval(aadj1) += 0.5;
  1077. #endif /*Check_FLT_ROUNDS*/
  1078.                         }
  1079.                 y = dword0(rv) & Exp_mask;
  1080.  
  1081.                 /* Check for overflow */
  1082.  
  1083.                 if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
  1084.                         dval(rv0) = dval(rv);
  1085.                         dword0(rv) -= P*Exp_msk1;
  1086.                         adj = dval(aadj1) * ulp(dval(rv));
  1087.                         dval(rv) += adj;
  1088.                         if ((dword0(rv) & Exp_mask) >=
  1089.                                         Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
  1090.                                 if (dword0(rv0) == Big0 && dword1(rv0) == Big1)
  1091.                                         goto ovfl;
  1092.                                 dword0(rv) = Big0;
  1093. #ifndef _DOUBLE_IS_32BITS
  1094.                                 dword1(rv) = Big1;
  1095. #endif /*!_DOUBLE_IS_32BITS*/
  1096.                                 goto cont;
  1097.                                 }
  1098.                         else
  1099.                                 dword0(rv) += P*Exp_msk1;
  1100.                         }
  1101.                 else {
  1102. #ifdef Avoid_Underflow
  1103.                         if (scale && y <= 2*P*Exp_msk1) {
  1104.                                 if (aadj <= 0x7fffffff) {
  1105.                                         if ((z = aadj) == 0)
  1106.                                                 z = 1;
  1107.                                         aadj = z;
  1108.                                         dval(aadj1) = dsign ? aadj : -aadj;
  1109.                                         }
  1110.                                 dword0(aadj1) += (2*P+1)*Exp_msk1 - y;
  1111.                                 }
  1112.                         adj = dval(aadj1) * ulp(dval(rv));
  1113.                         dval(rv) += adj;
  1114. #else
  1115. #ifdef Sudden_Underflow
  1116.                         if ((dword0(rv) & Exp_mask) <= P*Exp_msk1) {
  1117.                                 dval(rv0) = dval(rv);
  1118.                                 dword0(rv) += P*Exp_msk1;
  1119.                                 adj = dval(aadj1) * ulp(dval(rv));
  1120.                                 dval(rv) += adj;
  1121. #ifdef IBM
  1122.                                 if ((dword0(rv) & Exp_mask) <  P*Exp_msk1)
  1123. #else
  1124.                                 if ((dword0(rv) & Exp_mask) <= P*Exp_msk1)
  1125. #endif
  1126.                                         {
  1127.                                         if (dword0(rv0) == Tiny0
  1128.                                          && dword1(rv0) == Tiny1)
  1129.                                                 goto undfl;
  1130. #ifndef _DOUBLE_IS_32BITS
  1131.                                         dword0(rv) = Tiny0;
  1132.                                         dword1(rv) = Tiny1;
  1133. #else
  1134.                                         dword0(rv) = Tiny1;
  1135. #endif /*_DOUBLE_IS_32BITS*/
  1136.                                         goto cont;
  1137.                                         }
  1138.                                 else
  1139.                                         dword0(rv) -= P*Exp_msk1;
  1140.                                 }
  1141.                         else {
  1142.                                 adj = dval(aadj1) * ulp(dval(rv));
  1143.                                 dval(rv) += adj;
  1144.                                 }
  1145. #else /*Sudden_Underflow*/
  1146.                         /* Compute adj so that the IEEE rounding rules will
  1147.                          * correctly round rv + adj in some half-way cases.
  1148.                          * If rv * ulp(rv) is denormalized (i.e.,
  1149.                          * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
  1150.                          * trouble from bits lost to denormalization;
  1151.                          * example: 1.2e-307 .
  1152.                          */
  1153.                         if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
  1154.                                 dval(aadj1) = (double)(int)(aadj + 0.5);
  1155.                                 if (!dsign)
  1156.                                         dval(aadj1) = -dval(aadj1);
  1157.                                 }
  1158.                         adj = dval(aadj1) * ulp(dval(rv));
  1159.                         dval(rv) += adj;
  1160. #endif /*Sudden_Underflow*/
  1161. #endif /*Avoid_Underflow*/
  1162.                         }
  1163.                 z = dword0(rv) & Exp_mask;
  1164. #ifndef SET_INEXACT
  1165. #ifdef Avoid_Underflow
  1166.                 if (!scale)
  1167. #endif
  1168.                 if (y == z) {
  1169.                         /* Can we stop now? */
  1170.                         L = (Long)aadj;
  1171.                         aadj -= L;
  1172.                         /* The tolerances below are conservative. */
  1173.                         if (dsign || dword1(rv) || dword0(rv) & Bndry_mask) {
  1174.                                 if (aadj < .4999999 || aadj > .5000001)
  1175.                                         break;
  1176.                                 }
  1177.                         else if (aadj < .4999999/FLT_RADIX)
  1178.                                 break;
  1179.                         }
  1180. #endif
  1181.  cont:
  1182.                 Bfree(ptr,bb);
  1183.                 Bfree(ptr,bd);
  1184.                 Bfree(ptr,bs);
  1185.                 Bfree(ptr,delta);
  1186.                 }
  1187. #ifdef SET_INEXACT
  1188.         if (inexact) {
  1189.                 if (!oldinexact) {
  1190.                         dword0(rv0) = Exp_1 + (70 << Exp_shift);
  1191. #ifndef _DOUBLE_IS_32BITS
  1192.                         dword1(rv0) = 0;
  1193. #endif /*!_DOUBLE_IS_32BITS*/
  1194.                         dval(rv0) += 1.;
  1195.                         }
  1196.                 }
  1197.         else if (!oldinexact)
  1198.                 clear_inexact();
  1199. #endif
  1200. #ifdef Avoid_Underflow
  1201.         if (scale) {
  1202.                 dword0(rv0) = Exp_1 - 2*P*Exp_msk1;
  1203. #ifndef _DOUBLE_IS_32BITS
  1204.                 dword1(rv0) = 0;
  1205. #endif /*!_DOUBLE_IS_32BITS*/
  1206.                 dval(rv) *= dval(rv0);
  1207. #ifndef NO_ERRNO
  1208.                 /* try to avoid the bug of testing an 8087 register value */
  1209.                 if (dword0(rv) == 0 && dword1(rv) == 0)
  1210.                         ptr->_errno = ERANGE;
  1211. #endif
  1212.                 }
  1213. #endif /* Avoid_Underflow */
  1214. #ifdef SET_INEXACT
  1215.         if (inexact && !(dword0(rv) & Exp_mask)) {
  1216.                 /* set underflow bit */
  1217.                 dval(rv0) = 1e-300;
  1218.                 dval(rv0) *= dval(rv0);
  1219.                 }
  1220. #endif
  1221.  retfree:
  1222.         Bfree(ptr,bb);
  1223.         Bfree(ptr,bd);
  1224.         Bfree(ptr,bs);
  1225.         Bfree(ptr,bd0);
  1226.         Bfree(ptr,delta);
  1227.  ret:
  1228.         if (se)
  1229.                 *se = (char *)s;
  1230.         return sign ? -dval(rv) : dval(rv);
  1231. }
  1232.  
  1233. #ifndef _REENT_ONLY
  1234.  
  1235. double
  1236. _DEFUN (strtod, (s00, se),
  1237.         _CONST char *__restrict s00 _AND char **__restrict se)
  1238. {
  1239.   return _strtod_r (_REENT, s00, se);
  1240. }
  1241.  
  1242. float
  1243. _DEFUN (strtof, (s00, se),
  1244.         _CONST char *__restrict s00 _AND
  1245.         char **__restrict se)
  1246. {
  1247.   double retval = _strtod_r (_REENT, s00, se);
  1248.   if (isnan (retval))
  1249.     return nanf (NULL);
  1250.   return (float)retval;
  1251. }
  1252.  
  1253. #endif
  1254.