Subversion Repositories Kolibri OS

Rev

Rev 4874 | Go to most recent revision | 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 + (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. #ifdef INFNAN_CHECK
  216. static int
  217. _DEFUN (match, (sp, t),
  218.         _CONST char **sp _AND
  219.         char *t)
  220. {
  221.         int c, d;
  222.         _CONST char *s = *sp;
  223.  
  224.         while( (d = *t++) !=0) {
  225.                 if ((c = *++s) >= 'A' && c <= 'Z')
  226.                         c += 'a' - 'A';
  227.                 if (c != d)
  228.                         return 0;
  229.                 }
  230.         *sp = s + 1;
  231.         return 1;
  232. }
  233. #endif /* INFNAN_CHECK */
  234.  
  235.  
  236. double
  237. _DEFUN (_strtod_r, (ptr, s00, se),
  238.         struct _reent *ptr _AND
  239.         _CONST char *__restrict s00 _AND
  240.         char **__restrict se)
  241. {
  242. #ifdef Avoid_Underflow
  243.         int scale;
  244. #endif
  245.         int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, dsign,
  246.                  e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
  247.         _CONST char *s, *s0, *s1;
  248.         double aadj, adj;
  249.         U aadj1, rv, rv0;
  250.         Long L;
  251.         __ULong y, z;
  252.         _Bigint *bb = NULL, *bb1, *bd = NULL, *bd0, *bs = NULL, *delta = NULL;
  253. #ifdef Avoid_Underflow
  254.         __ULong Lsb, Lsb1;
  255. #endif
  256. #ifdef SET_INEXACT
  257.         int inexact, oldinexact;
  258. #endif
  259. #ifdef Honor_FLT_ROUNDS
  260.         int rounding;
  261. #endif
  262.  
  263.         delta = bs = bd = NULL;
  264.         sign = nz0 = nz = decpt = 0;
  265.         dval(rv) = 0.;
  266.         for(s = s00;;s++) switch(*s) {
  267.                 case '-':
  268.                         sign = 1;
  269.                         /* no break */
  270.                 case '+':
  271.                         if (*++s)
  272.                                 goto break2;
  273.                         /* no break */
  274.                 case 0:
  275.                         goto ret0;
  276.                 case '\t':
  277.                 case '\n':
  278.                 case '\v':
  279.                 case '\f':
  280.                 case '\r':
  281.                 case ' ':
  282.                         continue;
  283.                 default:
  284.                         goto break2;
  285.                 }
  286.  break2:
  287.         if (*s == '0') {
  288. #ifndef NO_HEX_FP
  289.                 {
  290.                 static _CONST FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
  291.                 Long exp;
  292.                 __ULong bits[2];
  293.                 switch(s[1]) {
  294.                   case 'x':
  295.                   case 'X':
  296.                         /* If the number is not hex, then the parse of
  297.                            0 is still valid.  */
  298.                         s00 = s + 1;
  299.                         {
  300. #if defined(FE_DOWNWARD) && defined(FE_TONEAREST) && defined(FE_TOWARDZERO) && defined(FE_UPWARD)
  301.                         FPI fpi1 = fpi;
  302.                         switch(fegetround()) {
  303.                           case FE_TOWARDZERO:   fpi1.rounding = 0; break;
  304.                           case FE_UPWARD:       fpi1.rounding = 2; break;
  305.                           case FE_DOWNWARD:     fpi1.rounding = 3;
  306.                           }
  307. #else
  308. #define fpi1 fpi
  309. #endif
  310.                         switch((i = gethex(ptr, &s, &fpi1, &exp, &bb, sign)) & STRTOG_Retmask) {
  311.                           case STRTOG_NoNumber:
  312.                                 s = s00;
  313.                                 sign = 0;
  314.                                 /* FALLTHROUGH */
  315.                           case STRTOG_Zero:
  316.                                 break;
  317.                           default:
  318.                                 if (bb) {
  319.                                         copybits(bits, fpi.nbits, bb);
  320.                                         Bfree(ptr,bb);
  321.                                         }
  322.                                 ULtod(rv.i, bits, exp, i);
  323.                           }}
  324.                         goto ret;
  325.                   }
  326.                 }
  327. #endif
  328.                 nz0 = 1;
  329.                 while(*++s == '0') ;
  330.                 if (!*s)
  331.                         goto ret;
  332.                 }
  333.         s0 = s;
  334.         y = z = 0;
  335.         for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
  336.                         if (nd < 9)
  337.                                 y = 10*y + c - '0';
  338.                         else
  339.                                 z = 10*z + c - '0';
  340.         nd0 = nd;
  341.         if (strncmp (s, _localeconv_r (ptr)->decimal_point,
  342.                      strlen (_localeconv_r (ptr)->decimal_point)) == 0)
  343.                 {
  344.                 decpt = 1;
  345.                 c = *(s += strlen (_localeconv_r (ptr)->decimal_point));
  346.                 if (!nd) {
  347.                         for(; c == '0'; c = *++s)
  348.                                 nz++;
  349.                         if (c > '0' && c <= '9') {
  350.                                 s0 = s;
  351.                                 nf += nz;
  352.                                 nz = 0;
  353.                                 goto have_dig;
  354.                                 }
  355.                         goto dig_done;
  356.                         }
  357.                 for(; c >= '0' && c <= '9'; c = *++s) {
  358.  have_dig:
  359.                         nz++;
  360.                         if (c -= '0') {
  361.                                 nf += nz;
  362.                                 for(i = 1; i < nz; i++)
  363.                                         if (nd++ < 9)
  364.                                                         y *= 10;
  365.                                         else if (nd <= DBL_DIG + 1)
  366.                                                         z *= 10;
  367.                                 if (nd++ < 9)
  368.                                                 y = 10*y + c;
  369.                                 else if (nd <= DBL_DIG + 1)
  370.                                                 z = 10*z + c;
  371.                                 nz = 0;
  372.                                 }
  373.                         }
  374.                 }
  375.  dig_done:
  376.         e = 0;
  377.         if (c == 'e' || c == 'E') {
  378.                 if (!nd && !nz && !nz0) {
  379.                         goto ret0;
  380.                         }
  381.                 s00 = s;
  382.                 esign = 0;
  383.                 switch(c = *++s) {
  384.                         case '-':
  385.                                 esign = 1;
  386.                         case '+':
  387.                                 c = *++s;
  388.                         }
  389.                 if (c >= '0' && c <= '9') {
  390.                         while(c == '0')
  391.                                 c = *++s;
  392.                         if (c > '0' && c <= '9') {
  393.                                 L = c - '0';
  394.                                 s1 = s;
  395.                                 while((c = *++s) >= '0' && c <= '9')
  396.                                         L = 10*L + c - '0';
  397.                                 if (s - s1 > 8 || L > 19999)
  398.                                         /* Avoid confusion from exponents
  399.                                          * so large that e might overflow.
  400.                                          */
  401.                                         e = 19999; /* safe for 16 bit ints */
  402.                                 else
  403.                                         e = (int)L;
  404.                                 if (esign)
  405.                                         e = -e;
  406.                                 }
  407.                         else
  408.                                 e = 0;
  409.                         }
  410.                 else
  411.                         s = s00;
  412.                 }
  413.         if (!nd) {
  414.                 if (!nz && !nz0) {
  415. #ifdef INFNAN_CHECK
  416.                         /* Check for Nan and Infinity */
  417.                         __ULong bits[2];
  418.                         static _CONST FPI fpinan =      /* only 52 explicit bits */
  419.                                 { 52, 1-1023-53+1, 2046-1023-53+1, 1, SI };
  420.                         if (!decpt)
  421.                          switch(c) {
  422.                           case 'i':
  423.                           case 'I':
  424.                                 if (match(&s,"nf")) {
  425.                                         --s;
  426.                                         if (!match(&s,"inity"))
  427.                                                 ++s;
  428.                                         dword0(rv) = 0x7ff00000;
  429. #ifndef _DOUBLE_IS_32BITS
  430.                                         dword1(rv) = 0;
  431. #endif /*!_DOUBLE_IS_32BITS*/
  432.                                         goto ret;
  433.                                         }
  434.                                 break;
  435.                           case 'n':
  436.                           case 'N':
  437.                                 if (match(&s, "an")) {
  438. #ifndef No_Hex_NaN
  439.                                         if (*s == '(' /*)*/
  440.                                          && hexnan(&s, &fpinan, bits)
  441.                                                         == STRTOG_NaNbits) {
  442.                                                 dword0(rv) = 0x7ff00000 | bits[1];
  443. #ifndef _DOUBLE_IS_32BITS
  444.                                                 dword1(rv) = bits[0];
  445. #endif /*!_DOUBLE_IS_32BITS*/
  446.                                                 }
  447.                                         else {
  448. #endif
  449.                                                 dword0(rv) = NAN_WORD0;
  450. #ifndef _DOUBLE_IS_32BITS
  451.                                                 dword1(rv) = NAN_WORD1;
  452. #endif /*!_DOUBLE_IS_32BITS*/
  453. #ifndef No_Hex_NaN
  454.                                                 }
  455. #endif
  456.                                         goto ret;
  457.                                         }
  458.                           }
  459. #endif /* INFNAN_CHECK */
  460.  ret0:
  461.                         s = s00;
  462.                         sign = 0;
  463.                         }
  464.                 goto ret;
  465.                 }
  466.         e1 = e -= nf;
  467.  
  468.         /* Now we have nd0 digits, starting at s0, followed by a
  469.          * decimal point, followed by nd-nd0 digits.  The number we're
  470.          * after is the integer represented by those digits times
  471.          * 10**e */
  472.  
  473.         if (!nd0)
  474.                 nd0 = nd;
  475.         k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
  476.         dval(rv) = y;
  477.         if (k > 9) {
  478. #ifdef SET_INEXACT
  479.                 if (k > DBL_DIG)
  480.                         oldinexact = get_inexact();
  481. #endif
  482.                 dval(rv) = tens[k - 9] * dval(rv) + z;
  483.                 }
  484.         bd0 = 0;
  485.         if (nd <= DBL_DIG
  486. #ifndef RND_PRODQUOT
  487. #ifndef Honor_FLT_ROUNDS
  488.                 && Flt_Rounds == 1
  489. #endif
  490. #endif
  491.                         ) {
  492.                 if (!e)
  493.                         goto ret;
  494.                 if (e > 0) {
  495.                         if (e <= Ten_pmax) {
  496. #ifdef VAX
  497.                                 goto vax_ovfl_check;
  498. #else
  499. #ifdef Honor_FLT_ROUNDS
  500.                                 /* round correctly FLT_ROUNDS = 2 or 3 */
  501.                                 if (sign) {
  502.                                         dval(rv) = -dval(rv);
  503.                                         sign = 0;
  504.                                         }
  505. #endif
  506.                                 /* rv = */ rounded_product(dval(rv), tens[e]);
  507.                                 goto ret;
  508. #endif
  509.                                 }
  510.                         i = DBL_DIG - nd;
  511.                         if (e <= Ten_pmax + i) {
  512.                                 /* A fancier test would sometimes let us do
  513.                                  * this for larger i values.
  514.                                  */
  515. #ifdef Honor_FLT_ROUNDS
  516.                                 /* round correctly FLT_ROUNDS = 2 or 3 */
  517.                                 if (sign) {
  518.                                         dval(rv) = -dval(rv);
  519.                                         sign = 0;
  520.                                         }
  521. #endif
  522.                                 e -= i;
  523.                                 dval(rv) *= tens[i];
  524. #ifdef VAX
  525.                                 /* VAX exponent range is so narrow we must
  526.                                  * worry about overflow here...
  527.                                  */
  528.  vax_ovfl_check:
  529.                                 dword0(rv) -= P*Exp_msk1;
  530.                                 /* rv = */ rounded_product(dval(rv), tens[e]);
  531.                                 if ((dword0(rv) & Exp_mask)
  532.                                  > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
  533.                                         goto ovfl;
  534.                                 dword0(rv) += P*Exp_msk1;
  535. #else
  536.                                 /* rv = */ rounded_product(dval(rv), tens[e]);
  537. #endif
  538.                                 goto ret;
  539.                                 }
  540.                         }
  541. #ifndef Inaccurate_Divide
  542.                 else if (e >= -Ten_pmax) {
  543. #ifdef Honor_FLT_ROUNDS
  544.                         /* round correctly FLT_ROUNDS = 2 or 3 */
  545.                         if (sign) {
  546.                                 dval(rv) = -dval(rv);
  547.                                 sign = 0;
  548.                                 }
  549. #endif
  550.                         /* rv = */ rounded_quotient(dval(rv), tens[-e]);
  551.                         goto ret;
  552.                         }
  553. #endif
  554.                 }
  555.         e1 += nd - k;
  556.  
  557. #ifdef IEEE_Arith
  558. #ifdef SET_INEXACT
  559.         inexact = 1;
  560.         if (k <= DBL_DIG)
  561.                 oldinexact = get_inexact();
  562. #endif
  563. #ifdef Avoid_Underflow
  564.         scale = 0;
  565. #endif
  566. #ifdef Honor_FLT_ROUNDS
  567.         if ((rounding = Flt_Rounds) >= 2) {
  568.                 if (sign)
  569.                         rounding = rounding == 2 ? 0 : 2;
  570.                 else
  571.                         if (rounding != 2)
  572.                                 rounding = 0;
  573.                 }
  574. #endif
  575. #endif /*IEEE_Arith*/
  576.  
  577.         /* Get starting approximation = rv * 10**e1 */
  578.  
  579.         if (e1 > 0) {
  580.                 if ( (i = e1 & 15) !=0)
  581.                         dval(rv) *= tens[i];
  582.                 if (e1 &= ~15) {
  583.                         if (e1 > DBL_MAX_10_EXP) {
  584.  ovfl:
  585. #ifndef NO_ERRNO
  586.                                 ptr->_errno = ERANGE;
  587. #endif
  588.                                 /* Can't trust HUGE_VAL */
  589. #ifdef IEEE_Arith
  590. #ifdef Honor_FLT_ROUNDS
  591.                                 switch(rounding) {
  592.                                   case 0: /* toward 0 */
  593.                                   case 3: /* toward -infinity */
  594.                                         dword0(rv) = Big0;
  595. #ifndef _DOUBLE_IS_32BITS
  596.                                         dword1(rv) = Big1;
  597. #endif /*!_DOUBLE_IS_32BITS*/
  598.                                         break;
  599.                                   default:
  600.                                         dword0(rv) = Exp_mask;
  601. #ifndef _DOUBLE_IS_32BITS
  602.                                         dword1(rv) = 0;
  603. #endif /*!_DOUBLE_IS_32BITS*/
  604.                                   }
  605. #else /*Honor_FLT_ROUNDS*/
  606.                                 dword0(rv) = Exp_mask;
  607. #ifndef _DOUBLE_IS_32BITS
  608.                                 dword1(rv) = 0;
  609. #endif /*!_DOUBLE_IS_32BITS*/
  610. #endif /*Honor_FLT_ROUNDS*/
  611. #ifdef SET_INEXACT
  612.                                 /* set overflow bit */
  613.                                 dval(rv0) = 1e300;
  614.                                 dval(rv0) *= dval(rv0);
  615. #endif
  616. #else /*IEEE_Arith*/
  617.                                 dword0(rv) = Big0;
  618. #ifndef _DOUBLE_IS_32BITS
  619.                                 dword1(rv) = Big1;
  620. #endif /*!_DOUBLE_IS_32BITS*/
  621. #endif /*IEEE_Arith*/
  622.                                 if (bd0)
  623.                                         goto retfree;
  624.                                 goto ret;
  625.                                 }
  626.                         e1 >>= 4;
  627.                         for(j = 0; e1 > 1; j++, e1 >>= 1)
  628.                                 if (e1 & 1)
  629.                                         dval(rv) *= bigtens[j];
  630.                 /* The last multiplication could overflow. */
  631.                         dword0(rv) -= P*Exp_msk1;
  632.                         dval(rv) *= bigtens[j];
  633.                         if ((z = dword0(rv) & Exp_mask)
  634.                          > Exp_msk1*(DBL_MAX_EXP+Bias-P))
  635.                                 goto ovfl;
  636.                         if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
  637.                                 /* set to largest number */
  638.                                 /* (Can't trust DBL_MAX) */
  639.                                 dword0(rv) = Big0;
  640. #ifndef _DOUBLE_IS_32BITS
  641.                                 dword1(rv) = Big1;
  642. #endif /*!_DOUBLE_IS_32BITS*/
  643.                                 }
  644.                         else
  645.                                 dword0(rv) += P*Exp_msk1;
  646.                         }
  647.                 }
  648.         else if (e1 < 0) {
  649.                 e1 = -e1;
  650.                 if ( (i = e1 & 15) !=0)
  651.                         dval(rv) /= tens[i];
  652.                 if (e1 >>= 4) {
  653.                         if (e1 >= 1 << n_bigtens)
  654.                                 goto undfl;
  655. #ifdef Avoid_Underflow
  656.                         if (e1 & Scale_Bit)
  657.                                 scale = 2*P;
  658.                         for(j = 0; e1 > 0; j++, e1 >>= 1)
  659.                                 if (e1 & 1)
  660.                                         dval(rv) *= tinytens[j];
  661.                         if (scale && (j = 2*P + 1 - ((dword0(rv) & Exp_mask)
  662.                                                 >> Exp_shift)) > 0) {
  663.                                 /* scaled rv is denormal; zap j low bits */
  664.                                 if (j >= 32) {
  665. #ifndef _DOUBLE_IS_32BITS
  666.                                         dword1(rv) = 0;
  667. #endif /*!_DOUBLE_IS_32BITS*/
  668.                                         if (j >= 53)
  669.                                          dword0(rv) = (P+2)*Exp_msk1;
  670.                                         else
  671.                                          dword0(rv) &= 0xffffffff << (j-32);
  672.                                         }
  673. #ifndef _DOUBLE_IS_32BITS
  674.                                 else
  675.                                         dword1(rv) &= 0xffffffff << j;
  676. #endif /*!_DOUBLE_IS_32BITS*/
  677.                                 }
  678. #else
  679.                         for(j = 0; e1 > 1; j++, e1 >>= 1)
  680.                                 if (e1 & 1)
  681.                                         dval(rv) *= tinytens[j];
  682.                         /* The last multiplication could underflow. */
  683.                         dval(rv0) = dval(rv);
  684.                         dval(rv) *= tinytens[j];
  685.                         if (!dval(rv)) {
  686.                                 dval(rv) = 2.*dval(rv0);
  687.                                 dval(rv) *= tinytens[j];
  688. #endif
  689.                                 if (!dval(rv)) {
  690.  undfl:
  691.                                         dval(rv) = 0.;
  692. #ifndef NO_ERRNO
  693.                                         ptr->_errno = ERANGE;
  694. #endif
  695.                                         if (bd0)
  696.                                                 goto retfree;
  697.                                         goto ret;
  698.                                         }
  699. #ifndef Avoid_Underflow
  700. #ifndef _DOUBLE_IS_32BITS
  701.                                 dword0(rv) = Tiny0;
  702.                                 dword1(rv) = Tiny1;
  703. #else
  704.                                 dword0(rv) = Tiny1;
  705. #endif /*_DOUBLE_IS_32BITS*/
  706.                                 /* The refinement below will clean
  707.                                  * this approximation up.
  708.                                  */
  709.                                 }
  710. #endif
  711.                         }
  712.                 }
  713.  
  714.         /* Now the hard part -- adjusting rv to the correct value.*/
  715.  
  716.         /* Put digits into bd: true value = bd * 10^e */
  717.  
  718.         bd0 = s2b(ptr, s0, nd0, nd, y);
  719.         if (bd0 == NULL)
  720.                 goto ovfl;
  721.  
  722.         for(;;) {
  723.                 bd = Balloc(ptr,bd0->_k);
  724.                 if (bd == NULL)
  725.                         goto ovfl;
  726.                 Bcopy(bd, bd0);
  727.                 bb = d2b(ptr,dval(rv), &bbe, &bbbits);  /* rv = bb * 2^bbe */
  728.                 if (bb == NULL)
  729.                         goto ovfl;
  730.                 bs = i2b(ptr,1);
  731.                 if (bs == NULL)
  732.                         goto ovfl;
  733.  
  734.                 if (e >= 0) {
  735.                         bb2 = bb5 = 0;
  736.                         bd2 = bd5 = e;
  737.                         }
  738.                 else {
  739.                         bb2 = bb5 = -e;
  740.                         bd2 = bd5 = 0;
  741.                         }
  742.                 if (bbe >= 0)
  743.                         bb2 += bbe;
  744.                 else
  745.                         bd2 -= bbe;
  746.                 bs2 = bb2;
  747. #ifdef Honor_FLT_ROUNDS
  748.                 if (rounding != 1)
  749.                         bs2++;
  750. #endif
  751. #ifdef Avoid_Underflow
  752.                 Lsb = LSB;
  753.                 Lsb1 = 0;
  754.                 j = bbe - scale;
  755.                 i = j + bbbits - 1;     /* logb(rv) */
  756.                 j = P + 1 - bbbits;
  757.                 if (i < Emin) { /* denormal */
  758.                         i = Emin - i;
  759.                         j -= i;
  760.                         if (i < 32)
  761.                                 Lsb <<= i;
  762.                 else
  763.                                 Lsb1 = Lsb << (i-32);
  764.                         }
  765. #else /*Avoid_Underflow*/
  766. #ifdef Sudden_Underflow
  767. #ifdef IBM
  768.                 j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
  769. #else
  770.                 j = P + 1 - bbbits;
  771. #endif
  772. #else /*Sudden_Underflow*/
  773.                 j = bbe;
  774.                 i = j + bbbits - 1;     /* logb(rv) */
  775.                 if (i < Emin)   /* denormal */
  776.                         j += P - Emin;
  777.                 else
  778.                         j = P + 1 - bbbits;
  779. #endif /*Sudden_Underflow*/
  780. #endif /*Avoid_Underflow*/
  781.                 bb2 += j;
  782.                 bd2 += j;
  783. #ifdef Avoid_Underflow
  784.                 bd2 += scale;
  785. #endif
  786.                 i = bb2 < bd2 ? bb2 : bd2;
  787.                 if (i > bs2)
  788.                         i = bs2;
  789.                 if (i > 0) {
  790.                         bb2 -= i;
  791.                         bd2 -= i;
  792.                         bs2 -= i;
  793.                         }
  794.                 if (bb5 > 0) {
  795.                         bs = pow5mult(ptr, bs, bb5);
  796.                         if (bs == NULL)
  797.                                 goto ovfl;
  798.                         bb1 = mult(ptr, bs, bb);
  799.                         if (bb1 == NULL)
  800.                                 goto ovfl;
  801.                         Bfree(ptr, bb);
  802.                         bb = bb1;
  803.                         }
  804.                 if (bb2 > 0) {
  805.                         bb = lshift(ptr, bb, bb2);
  806.                         if (bb == NULL)
  807.                                 goto ovfl;
  808.                         }
  809.                 if (bd5 > 0) {
  810.                         bd = pow5mult(ptr, bd, bd5);
  811.                         if (bd == NULL)
  812.                                 goto ovfl;
  813.                         }
  814.                 if (bd2 > 0) {
  815.                         bd = lshift(ptr, bd, bd2);
  816.                         if (bd == NULL)
  817.                                 goto ovfl;
  818.                         }
  819.                 if (bs2 > 0) {
  820.                         bs = lshift(ptr, bs, bs2);
  821.                         if (bs == NULL)
  822.                                 goto ovfl;
  823.                         }
  824.                 delta = diff(ptr, bb, bd);
  825.                 if (delta == NULL)
  826.                         goto ovfl;
  827.                 dsign = delta->_sign;
  828.                 delta->_sign = 0;
  829.                 i = cmp(delta, bs);
  830. #ifdef Honor_FLT_ROUNDS
  831.                 if (rounding != 1) {
  832.                         if (i < 0) {
  833.                                 /* Error is less than an ulp */
  834.                                 if (!delta->_x[0] && delta->_wds <= 1) {
  835.                                         /* exact */
  836. #ifdef SET_INEXACT
  837.                                         inexact = 0;
  838. #endif
  839.                                         break;
  840.                                         }
  841.                                 if (rounding) {
  842.                                         if (dsign) {
  843.                                                 adj = 1.;
  844.                                                 goto apply_adj;
  845.                                                 }
  846.                                         }
  847.                                 else if (!dsign) {
  848.                                         adj = -1.;
  849.                                         if (!dword1(rv)
  850.                                          && !(dword0(rv) & Frac_mask)) {
  851.                                                 y = dword0(rv) & Exp_mask;
  852. #ifdef Avoid_Underflow
  853.                                                 if (!scale || y > 2*P*Exp_msk1)
  854. #else
  855.                                                 if (y)
  856. #endif
  857.                                                   {
  858.                                                   delta = lshift(ptr, delta,Log2P);
  859.                                                   if (cmp(delta, bs) <= 0)
  860.                                                         adj = -0.5;
  861.                                                   }
  862.                                                 }
  863.  apply_adj:
  864. #ifdef Avoid_Underflow
  865.                                         if (scale && (y = dword0(rv) & Exp_mask)
  866.                                                 <= 2*P*Exp_msk1)
  867.                                           dword0(adj) += (2*P+1)*Exp_msk1 - y;
  868. #else
  869. #ifdef Sudden_Underflow
  870.                                         if ((dword0(rv) & Exp_mask) <=
  871.                                                         P*Exp_msk1) {
  872.                                                 dword0(rv) += P*Exp_msk1;
  873.                                                 dval(rv) += adj*ulp(dval(rv));
  874.                                                 dword0(rv) -= P*Exp_msk1;
  875.                                                 }
  876.                                         else
  877. #endif /*Sudden_Underflow*/
  878. #endif /*Avoid_Underflow*/
  879.                                         dval(rv) += adj*ulp(dval(rv));
  880.                                         }
  881.                                 break;
  882.                                 }
  883.                         adj = ratio(delta, bs);
  884.                         if (adj < 1.)
  885.                                 adj = 1.;
  886.                         if (adj <= 0x7ffffffe) {
  887.                                 /* adj = rounding ? ceil(adj) : floor(adj); */
  888.                                 y = adj;
  889.                                 if (y != adj) {
  890.                                         if (!((rounding>>1) ^ dsign))
  891.                                                 y++;
  892.                                         adj = y;
  893.                                         }
  894.                                 }
  895. #ifdef Avoid_Underflow
  896.                         if (scale && (y = dword0(rv) & Exp_mask) <= 2*P*Exp_msk1)
  897.                                 dword0(adj) += (2*P+1)*Exp_msk1 - y;
  898. #else
  899. #ifdef Sudden_Underflow
  900.                         if ((dword0(rv) & Exp_mask) <= P*Exp_msk1) {
  901.                                 dword0(rv) += P*Exp_msk1;
  902.                                 adj *= ulp(dval(rv));
  903.                                 if (dsign)
  904.                                         dval(rv) += adj;
  905.                                 else
  906.                                         dval(rv) -= adj;
  907.                                 dword0(rv) -= P*Exp_msk1;
  908.                                 goto cont;
  909.                                 }
  910. #endif /*Sudden_Underflow*/
  911. #endif /*Avoid_Underflow*/
  912.                         adj *= ulp(dval(rv));
  913.                         if (dsign) {
  914.                                 if (dword0(rv) == Big0 && dword1(rv) == Big1)
  915.                                         goto ovfl;
  916.                                 dval(rv) += adj;
  917.                         else
  918.                                 dval(rv) -= adj;
  919.                         goto cont;
  920.                         }
  921. #endif /*Honor_FLT_ROUNDS*/
  922.  
  923.                 if (i < 0) {
  924.                         /* Error is less than half an ulp -- check for
  925.                          * special case of mantissa a power of two.
  926.                          */
  927.                         if (dsign || dword1(rv) || dword0(rv) & Bndry_mask
  928. #ifdef IEEE_Arith
  929. #ifdef Avoid_Underflow
  930.                          || (dword0(rv) & Exp_mask) <= (2*P+1)*Exp_msk1
  931. #else
  932.                          || (dword0(rv) & Exp_mask) <= Exp_msk1
  933. #endif
  934. #endif
  935.                                 ) {
  936. #ifdef SET_INEXACT
  937.                                 if (!delta->x[0] && delta->wds <= 1)
  938.                                         inexact = 0;
  939. #endif
  940.                                 break;
  941.                                 }
  942.                         if (!delta->_x[0] && delta->_wds <= 1) {
  943.                                 /* exact result */
  944. #ifdef SET_INEXACT
  945.                                 inexact = 0;
  946. #endif
  947.                                 break;
  948.                                 }
  949.                         delta = lshift(ptr,delta,Log2P);
  950.                         if (cmp(delta, bs) > 0)
  951.                                 goto drop_down;
  952.                         break;
  953.                         }
  954.                 if (i == 0) {
  955.                         /* exactly half-way between */
  956.                         if (dsign) {
  957.                                 if ((dword0(rv) & Bndry_mask1) == Bndry_mask1
  958.                                  &&  dword1(rv) == (
  959. #ifdef Avoid_Underflow
  960.                         (scale && (y = dword0(rv) & Exp_mask) <= 2*P*Exp_msk1)
  961.                 ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) :
  962. #endif
  963.                                                    0xffffffff)) {
  964.                                         /*boundary case -- increment exponent*/
  965.                                         if (dword0(rv) == Big0 && dword1(rv) == Big1)
  966.                                                 goto ovfl;
  967.                                         dword0(rv) = (dword0(rv) & Exp_mask)
  968.                                                 + Exp_msk1
  969. #ifdef IBM
  970.                                                 | Exp_msk1 >> 4
  971. #endif
  972.                                                 ;
  973. #ifndef _DOUBLE_IS_32BITS
  974.                                         dword1(rv) = 0;
  975. #endif /*!_DOUBLE_IS_32BITS*/
  976. #ifdef Avoid_Underflow
  977.                                         dsign = 0;
  978. #endif
  979.                                         break;
  980.                                         }
  981.                                 }
  982.                         else if (!(dword0(rv) & Bndry_mask) && !dword1(rv)) {
  983.  drop_down:
  984.                                 /* boundary case -- decrement exponent */
  985. #ifdef Sudden_Underflow /*{{*/
  986.                                 L = dword0(rv) & Exp_mask;
  987. #ifdef IBM
  988.                                 if (L <  Exp_msk1)
  989. #else
  990. #ifdef Avoid_Underflow
  991.                                 if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1))
  992. #else
  993.                                 if (L <= Exp_msk1)
  994. #endif /*Avoid_Underflow*/
  995. #endif /*IBM*/
  996.                                         goto undfl;
  997.                                 L -= Exp_msk1;
  998. #else /*Sudden_Underflow}{*/
  999. #ifdef Avoid_Underflow
  1000.                                 if (scale) {
  1001.                                         L = dword0(rv) & Exp_mask;
  1002.                                         if (L <= (2*P+1)*Exp_msk1) {
  1003.                                                 if (L > (P+2)*Exp_msk1)
  1004.                                                         /* round even ==> */
  1005.                                                         /* accept rv */
  1006.                                                         break;
  1007.                                                 /* rv = smallest denormal */
  1008.                                                 goto undfl;
  1009.                                                 }
  1010.                                         }
  1011. #endif /*Avoid_Underflow*/
  1012.                                 L = (dword0(rv) & Exp_mask) - Exp_msk1;
  1013. #endif /*Sudden_Underflow}*/
  1014.                                 dword0(rv) = L | Bndry_mask1;
  1015. #ifndef _DOUBLE_IS_32BITS
  1016.                                 dword1(rv) = 0xffffffff;
  1017. #endif /*!_DOUBLE_IS_32BITS*/
  1018. #ifdef IBM
  1019.                                 goto cont;
  1020. #else
  1021.                                 break;
  1022. #endif
  1023.                                 }
  1024. #ifndef ROUND_BIASED
  1025. #ifdef Avoid_Underflow
  1026.                         if (Lsb1) {
  1027.                                 if (!(dword0(rv) & Lsb1))
  1028.                                         break;
  1029.                                 }
  1030.                         else if (!(dword1(rv) & Lsb))
  1031.                                 break;
  1032. #else
  1033.                         if (!(dword1(rv) & LSB))
  1034.                                 break;
  1035. #endif
  1036. #endif
  1037.                         if (dsign)
  1038. #ifdef Avoid_Underflow
  1039.                                 dval(rv) += sulp(rv, scale);
  1040. #else
  1041.                                 dval(rv) += ulp(dval(rv));
  1042. #endif
  1043. #ifndef ROUND_BIASED
  1044.                         else {
  1045. #ifdef Avoid_Underflow
  1046.                                 dval(rv) -= sulp(rv, scale);
  1047. #else
  1048.                                 dval(rv) -= ulp(dval(rv));
  1049. #endif
  1050. #ifndef Sudden_Underflow
  1051.                                 if (!dval(rv))
  1052.                                         goto undfl;
  1053. #endif
  1054.                                 }
  1055. #ifdef Avoid_Underflow
  1056.                         dsign = 1 - dsign;
  1057. #endif
  1058. #endif
  1059.                         break;
  1060.                         }
  1061.                 if ((aadj = ratio(delta, bs)) <= 2.) {
  1062.                         if (dsign)
  1063.                                 aadj = dval(aadj1) = 1.;
  1064.                         else if (dword1(rv) || dword0(rv) & Bndry_mask) {
  1065. #ifndef Sudden_Underflow
  1066.                                 if (dword1(rv) == Tiny1 && !dword0(rv))
  1067.                                         goto undfl;
  1068. #endif
  1069.                                 aadj = 1.;
  1070.                                 dval(aadj1) = -1.;
  1071.                                 }
  1072.                         else {
  1073.                                 /* special case -- power of FLT_RADIX to be */
  1074.                                 /* rounded down... */
  1075.  
  1076.                                 if (aadj < 2./FLT_RADIX)
  1077.                                         aadj = 1./FLT_RADIX;
  1078.                                 else
  1079.                                         aadj *= 0.5;
  1080.                                 dval(aadj1) = -aadj;
  1081.                                 }
  1082.                         }
  1083.                 else {
  1084.                         aadj *= 0.5;
  1085.                         dval(aadj1) = dsign ? aadj : -aadj;
  1086. #ifdef Check_FLT_ROUNDS
  1087.                         switch(Rounding) {
  1088.                                 case 2: /* towards +infinity */
  1089.                                         dval(aadj1) -= 0.5;
  1090.                                         break;
  1091.                                 case 0: /* towards 0 */
  1092.                                 case 3: /* towards -infinity */
  1093.                                         dval(aadj1) += 0.5;
  1094.                                 }
  1095. #else
  1096.                         if (Flt_Rounds == 0)
  1097.                                 dval(aadj1) += 0.5;
  1098. #endif /*Check_FLT_ROUNDS*/
  1099.                         }
  1100.                 y = dword0(rv) & Exp_mask;
  1101.  
  1102.                 /* Check for overflow */
  1103.  
  1104.                 if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
  1105.                         dval(rv0) = dval(rv);
  1106.                         dword0(rv) -= P*Exp_msk1;
  1107.                         adj = dval(aadj1) * ulp(dval(rv));
  1108.                         dval(rv) += adj;
  1109.                         if ((dword0(rv) & Exp_mask) >=
  1110.                                         Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
  1111.                                 if (dword0(rv0) == Big0 && dword1(rv0) == Big1)
  1112.                                         goto ovfl;
  1113.                                 dword0(rv) = Big0;
  1114. #ifndef _DOUBLE_IS_32BITS
  1115.                                 dword1(rv) = Big1;
  1116. #endif /*!_DOUBLE_IS_32BITS*/
  1117.                                 goto cont;
  1118.                                 }
  1119.                         else
  1120.                                 dword0(rv) += P*Exp_msk1;
  1121.                         }
  1122.                 else {
  1123. #ifdef Avoid_Underflow
  1124.                         if (scale && y <= 2*P*Exp_msk1) {
  1125.                                 if (aadj <= 0x7fffffff) {
  1126.                                         if ((z = aadj) == 0)
  1127.                                                 z = 1;
  1128.                                         aadj = z;
  1129.                                         dval(aadj1) = dsign ? aadj : -aadj;
  1130.                                         }
  1131.                                 dword0(aadj1) += (2*P+1)*Exp_msk1 - y;
  1132.                                 }
  1133.                         adj = dval(aadj1) * ulp(dval(rv));
  1134.                         dval(rv) += adj;
  1135. #else
  1136. #ifdef Sudden_Underflow
  1137.                         if ((dword0(rv) & Exp_mask) <= P*Exp_msk1) {
  1138.                                 dval(rv0) = dval(rv);
  1139.                                 dword0(rv) += P*Exp_msk1;
  1140.                                 adj = dval(aadj1) * ulp(dval(rv));
  1141.                                 dval(rv) += adj;
  1142. #ifdef IBM
  1143.                                 if ((dword0(rv) & Exp_mask) <  P*Exp_msk1)
  1144. #else
  1145.                                 if ((dword0(rv) & Exp_mask) <= P*Exp_msk1)
  1146. #endif
  1147.                                         {
  1148.                                         if (dword0(rv0) == Tiny0
  1149.                                          && dword1(rv0) == Tiny1)
  1150.                                                 goto undfl;
  1151. #ifndef _DOUBLE_IS_32BITS
  1152.                                         dword0(rv) = Tiny0;
  1153.                                         dword1(rv) = Tiny1;
  1154. #else
  1155.                                         dword0(rv) = Tiny1;
  1156. #endif /*_DOUBLE_IS_32BITS*/
  1157.                                         goto cont;
  1158.                                         }
  1159.                                 else
  1160.                                         dword0(rv) -= P*Exp_msk1;
  1161.                                 }
  1162.                         else {
  1163.                                 adj = dval(aadj1) * ulp(dval(rv));
  1164.                                 dval(rv) += adj;
  1165.                                 }
  1166. #else /*Sudden_Underflow*/
  1167.                         /* Compute adj so that the IEEE rounding rules will
  1168.                          * correctly round rv + adj in some half-way cases.
  1169.                          * If rv * ulp(rv) is denormalized (i.e.,
  1170.                          * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
  1171.                          * trouble from bits lost to denormalization;
  1172.                          * example: 1.2e-307 .
  1173.                          */
  1174.                         if (y <= (P-1)*Exp_msk1 && aadj > 1.) {
  1175.                                 dval(aadj1) = (double)(int)(aadj + 0.5);
  1176.                                 if (!dsign)
  1177.                                         dval(aadj1) = -dval(aadj1);
  1178.                                 }
  1179.                         adj = dval(aadj1) * ulp(dval(rv));
  1180.                         dval(rv) += adj;
  1181. #endif /*Sudden_Underflow*/
  1182. #endif /*Avoid_Underflow*/
  1183.                         }
  1184.                 z = dword0(rv) & Exp_mask;
  1185. #ifndef SET_INEXACT
  1186. #ifdef Avoid_Underflow
  1187.                 if (!scale)
  1188. #endif
  1189.                 if (y == z) {
  1190.                         /* Can we stop now? */
  1191.                         L = (Long)aadj;
  1192.                         aadj -= L;
  1193.                         /* The tolerances below are conservative. */
  1194.                         if (dsign || dword1(rv) || dword0(rv) & Bndry_mask) {
  1195.                                 if (aadj < .4999999 || aadj > .5000001)
  1196.                                         break;
  1197.                                 }
  1198.                         else if (aadj < .4999999/FLT_RADIX)
  1199.                                 break;
  1200.                         }
  1201. #endif
  1202.  cont:
  1203.                 Bfree(ptr,bb);
  1204.                 Bfree(ptr,bd);
  1205.                 Bfree(ptr,bs);
  1206.                 Bfree(ptr,delta);
  1207.                 }
  1208. #ifdef SET_INEXACT
  1209.         if (inexact) {
  1210.                 if (!oldinexact) {
  1211.                         dword0(rv0) = Exp_1 + (70 << Exp_shift);
  1212. #ifndef _DOUBLE_IS_32BITS
  1213.                         dword1(rv0) = 0;
  1214. #endif /*!_DOUBLE_IS_32BITS*/
  1215.                         dval(rv0) += 1.;
  1216.                         }
  1217.                 }
  1218.         else if (!oldinexact)
  1219.                 clear_inexact();
  1220. #endif
  1221. #ifdef Avoid_Underflow
  1222.         if (scale) {
  1223.                 dword0(rv0) = Exp_1 - 2*P*Exp_msk1;
  1224. #ifndef _DOUBLE_IS_32BITS
  1225.                 dword1(rv0) = 0;
  1226. #endif /*!_DOUBLE_IS_32BITS*/
  1227.                 dval(rv) *= dval(rv0);
  1228. #ifndef NO_ERRNO
  1229.                 /* try to avoid the bug of testing an 8087 register value */
  1230.                 if (dword0(rv) == 0 && dword1(rv) == 0)
  1231.                         ptr->_errno = ERANGE;
  1232. #endif
  1233.                 }
  1234. #endif /* Avoid_Underflow */
  1235. #ifdef SET_INEXACT
  1236.         if (inexact && !(dword0(rv) & Exp_mask)) {
  1237.                 /* set underflow bit */
  1238.                 dval(rv0) = 1e-300;
  1239.                 dval(rv0) *= dval(rv0);
  1240.                 }
  1241. #endif
  1242.  retfree:
  1243.         Bfree(ptr,bb);
  1244.         Bfree(ptr,bd);
  1245.         Bfree(ptr,bs);
  1246.         Bfree(ptr,bd0);
  1247.         Bfree(ptr,delta);
  1248.  ret:
  1249.         if (se)
  1250.                 *se = (char *)s;
  1251.         return sign ? -dval(rv) : dval(rv);
  1252. }
  1253.  
  1254. #ifndef _REENT_ONLY
  1255.  
  1256. double
  1257. _DEFUN (strtod, (s00, se),
  1258.         _CONST char *__restrict s00 _AND char **__restrict se)
  1259. {
  1260.   return _strtod_r (_REENT, s00, se);
  1261. }
  1262.  
  1263. float
  1264. _DEFUN (strtof, (s00, se),
  1265.         _CONST char *__restrict s00 _AND
  1266.         char **__restrict se)
  1267. {
  1268.   double retval = _strtod_r (_REENT, s00, se);
  1269.   if (isnan (retval))
  1270.     return nanf (NULL);
  1271.   return (float)retval;
  1272. }
  1273.  
  1274. #endif
  1275.