+++ /dev/null
-/** @file\r
-\r
- Copyright (c) 2012 - 2014, Intel Corporation. All rights reserved.<BR>\r
- This program and the accompanying materials are licensed and made available under\r
- the terms and conditions of the BSD License that accompanies this distribution.\r
- The full text of the license may be found at\r
- http://opensource.org/licenses/bsd-license.\r
-\r
- THE PROGRAM IS DISTRIBUTED UNDER THE BSD LICENSE ON AN "AS IS" BASIS,\r
- WITHOUT WARRANTIES OR REPRESENTATIONS OF ANY KIND, EITHER EXPRESS OR IMPLIED.\r
-\r
- *****************************************************************\r
-\r
- The author of this software is David M. Gay.\r
-\r
- Copyright (C) 1998-2001 by Lucent Technologies\r
- All Rights Reserved\r
-\r
- Permission to use, copy, modify, and distribute this software and\r
- its documentation for any purpose and without fee is hereby\r
- granted, provided that the above copyright notice appear in all\r
- copies and that both that the copyright notice and this\r
- permission notice and warranty disclaimer appear in supporting\r
- documentation, and that the name of Lucent or any of its entities\r
- not be used in advertising or publicity pertaining to\r
- distribution of the software without specific, written prior\r
- permission.\r
-\r
- LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,\r
- INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.\r
- IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY\r
- SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES\r
- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER\r
- IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,\r
- ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF\r
- THIS SOFTWARE.\r
-\r
- Please send bug reports to David M. Gay (dmg at acm dot org,\r
- with " at " changed at "@" and " dot " changed to ".").\r
-\r
- *****************************************************************\r
-\r
- NetBSD: strtodg.c,v 1.5.14.1 2008/04/08 21:10:55 jdc Exp\r
-**/\r
-#include <LibConfig.h>\r
-\r
-#include "gdtoaimp.h"\r
-\r
-#ifdef USE_LOCALE\r
-#include "locale.h"\r
-#endif\r
-\r
-#if defined(_MSC_VER)\r
- // Disable warnings about assignment within conditional expressions.\r
- #pragma warning ( disable : 4706 )\r
-#endif\r
-\r
- static CONST int\r
-fivesbits[] = { 0, 3, 5, 7, 10, 12, 14, 17, 19, 21,\r
- 24, 26, 28, 31, 33, 35, 38, 40, 42, 45,\r
- 47, 49, 52\r
-#ifdef VAX\r
- , 54, 56\r
-#endif\r
- };\r
-\r
- Bigint *\r
-increment(Bigint *b)\r
-{\r
- ULong *x, *xe;\r
- Bigint *b1;\r
-#ifdef Pack_16\r
- ULong carry = 1, y;\r
-#endif\r
-\r
- x = b->x;\r
- xe = x + b->wds;\r
-#ifdef Pack_32\r
- do {\r
- if (*x < (ULong)0xffffffffL) {\r
- ++*x;\r
- return b;\r
- }\r
- *x++ = 0;\r
- } while(x < xe);\r
-#else\r
- do {\r
- y = *x + carry;\r
- carry = y >> 16;\r
- *x++ = y & 0xffff;\r
- if (!carry)\r
- return b;\r
- } while(x < xe);\r
- if (carry)\r
-#endif\r
- {\r
- if (b->wds >= b->maxwds) {\r
- b1 = Balloc(b->k+1);\r
- if (b1 == NULL)\r
- return NULL;\r
- Bcopy(b1,b);\r
- Bfree(b);\r
- b = b1;\r
- }\r
- b->x[b->wds++] = 1;\r
- }\r
- return b;\r
- }\r
-\r
- int\r
-decrement(Bigint *b)\r
-{\r
- ULong *x, *xe;\r
-#ifdef Pack_16\r
- ULong borrow = 1, y;\r
-#endif\r
-\r
- x = b->x;\r
- xe = x + b->wds;\r
-#ifdef Pack_32\r
- do {\r
- if (*x) {\r
- --*x;\r
- break;\r
- }\r
- *x++ = 0xffffffffUL;\r
- }\r
- while(x < xe);\r
-#else\r
- do {\r
- y = *x - borrow;\r
- borrow = (y & 0x10000) >> 16;\r
- *x++ = y & 0xffff;\r
- } while(borrow && x < xe);\r
-#endif\r
- return STRTOG_Inexlo;\r
- }\r
-\r
- static int\r
-all_on(CONST Bigint *b, int n)\r
-{\r
- CONST ULong *x, *xe;\r
-\r
- x = b->x;\r
- xe = x + ((unsigned int)n >> kshift);\r
- while(x < xe)\r
- if ((*x++ & ALL_ON) != ALL_ON)\r
- return 0;\r
- if (n &= kmask)\r
- return ((*x | (ALL_ON << n)) & ALL_ON) == ALL_ON;\r
- return 1;\r
- }\r
-\r
- Bigint *\r
-set_ones(Bigint *b, int n)\r
-{\r
- int k;\r
- ULong *x, *xe;\r
-\r
- k = (unsigned int)(n + ((1 << kshift) - 1)) >> kshift;\r
- if (b->k < k) {\r
- Bfree(b);\r
- b = Balloc(k);\r
- if (b == NULL)\r
- return NULL;\r
- }\r
- k = (unsigned int)n >> kshift;\r
- if (n &= kmask)\r
- k++;\r
- b->wds = k;\r
- x = b->x;\r
- xe = x + k;\r
- while(x < xe)\r
- *x++ = ALL_ON;\r
- if (n)\r
- x[-1] >>= ULbits - n;\r
- return b;\r
- }\r
-\r
- static int\r
-rvOK (\r
- double d, CONST FPI *fpi, Long *expt, ULong *bits, int exact, int rd, int *irv\r
-)\r
-{\r
- Bigint *b;\r
- ULong carry, inex, lostbits;\r
- int bdif, e, j, k, k1, nb, rv;\r
-\r
- carry = rv = 0;\r
- b = d2b(d, &e, &bdif);\r
- bdif -= nb = fpi->nbits;\r
- e += bdif;\r
- if (bdif <= 0) {\r
- if (exact)\r
- goto trunc;\r
- goto ret;\r
- }\r
- if (P == nb) {\r
- if (\r
-#ifndef IMPRECISE_INEXACT\r
- exact &&\r
-#endif\r
- fpi->rounding ==\r
-#ifdef RND_PRODQUOT\r
- FPI_Round_near\r
-#else\r
- Flt_Rounds\r
-#endif\r
- ) goto trunc;\r
- goto ret;\r
- }\r
- switch(rd) {\r
- case 1:\r
- goto trunc;\r
- case 2:\r
- break;\r
- default: /* round near */\r
- k = bdif - 1;\r
- if (!k) {\r
- if (!exact)\r
- goto ret;\r
- if (b->x[0] & 2)\r
- break;\r
- goto trunc;\r
- }\r
- if (b->x[(unsigned int)k>>kshift] & ((ULong)1 << (k & kmask)))\r
- break;\r
- goto trunc;\r
- }\r
- /* "break" cases: round up 1 bit, then truncate; bdif > 0 */\r
- carry = 1;\r
- trunc:\r
- inex = lostbits = 0;\r
- if (bdif > 0) {\r
- if ( (lostbits = any_on(b, bdif)) !=0)\r
- inex = STRTOG_Inexlo;\r
- rshift(b, bdif);\r
- if (carry) {\r
- inex = STRTOG_Inexhi;\r
- b = increment(b);\r
- if ( (j = nb & kmask) !=0)\r
- j = ULbits - j;\r
- if (hi0bits(b->x[b->wds - 1]) != j) {\r
- if (!lostbits)\r
- lostbits = b->x[0] & 1;\r
- rshift(b, 1);\r
- e++;\r
- }\r
- }\r
- }\r
- else if (bdif < 0)\r
- b = lshift(b, -bdif);\r
- if (e < fpi->emin) {\r
- k = fpi->emin - e;\r
- e = fpi->emin;\r
- if (k > nb || fpi->sudden_underflow) {\r
- inex = b->wds = 0;\r
- *irv = STRTOG_Underflow | STRTOG_Inexlo;\r
- }\r
- else {\r
- k1 = k - 1;\r
- if (k1 > 0 && !lostbits)\r
- lostbits = any_on(b, k1);\r
- if (!lostbits && !exact)\r
- goto ret;\r
- lostbits |=\r
- carry = b->x[(unsigned int)k1>>kshift] &\r
- (ULong)(1 << ((unsigned int)k1 & kmask));\r
- rshift(b, k);\r
- *irv = STRTOG_Denormal;\r
- if (carry) {\r
- b = increment(b);\r
- inex = STRTOG_Inexhi | STRTOG_Underflow;\r
- }\r
- else if (lostbits)\r
- inex = STRTOG_Inexlo | STRTOG_Underflow;\r
- }\r
- }\r
- else if (e > fpi->emax) {\r
- e = fpi->emax + 1;\r
- *irv = STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;\r
-#ifndef NO_ERRNO\r
- errno = ERANGE;\r
-#endif\r
- inex = b->wds = 0;\r
- }\r
- *expt = e;\r
- copybits(bits, nb, b);\r
- *irv |= inex;\r
- rv = 1;\r
- ret:\r
- Bfree(b);\r
- return rv;\r
- }\r
-\r
- static int\r
-mantbits(double d)\r
-{\r
- ULong L;\r
- if ( (L = word1(d)) !=0)\r
- return P - lo0bits(&L);\r
- L = word0(d) | Exp_msk1;\r
- return P - 32 - lo0bits(&L);\r
- }\r
-\r
- int\r
-strtodg (\r
- CONST char *s00, char **se, CONST FPI *fpi, Long *expt, ULong *bits\r
-)\r
-{\r
- int abe = 0, abits = 0, asub;\r
- int bb0, bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, denorm;\r
- int dsign, e, e1, e2, emin, esign, finished, i, inex, irv;\r
- int j, k, nbits, nd, nd0, nf, nz, nz0, rd, rvbits, rve, rve1, sign;\r
- int sudden_underflow = 0; /* pacify gcc */\r
- CONST char *s, *s0, *s1;\r
- double adj, adj0, rv, tol;\r
- Long L;\r
- ULong y, z;\r
- Bigint *ab, *bb, *bb1, *bd, *bd0, *bs, *delta, *rvb, *rvb0;\r
-\r
- e2 = 0; /* XXX gcc */\r
-\r
- irv = STRTOG_Zero;\r
- denorm = sign = nz0 = nz = 0;\r
- dval(rv) = 0.;\r
- rvb = 0;\r
- nbits = fpi->nbits;\r
- for(s = s00;;s++) switch(*s) {\r
- case '-':\r
- sign = 1;\r
- /* FALLTHROUGH */\r
- case '+':\r
- if (*++s)\r
- goto break2;\r
- /* FALLTHROUGH */\r
- case 0:\r
- sign = 0;\r
- irv = STRTOG_NoNumber;\r
- s = s00;\r
- goto ret;\r
- case '\t':\r
- case '\n':\r
- case '\v':\r
- case '\f':\r
- case '\r':\r
- case ' ':\r
- continue;\r
- default:\r
- goto break2;\r
- }\r
- break2:\r
- if (*s == '0') {\r
-#ifndef NO_HEX_FP\r
- switch(s[1]) {\r
- case 'x':\r
- case 'X':\r
- irv = gethex(&s, fpi, expt, &rvb, sign);\r
- if (irv == STRTOG_NoNumber) {\r
- s = s00;\r
- sign = 0;\r
- }\r
- goto ret;\r
- }\r
-#endif\r
- nz0 = 1;\r
- while(*++s == '0') ;\r
- if (!*s)\r
- goto ret;\r
- }\r
- sudden_underflow = fpi->sudden_underflow;\r
- s0 = s;\r
- y = z = 0;\r
- for(decpt = nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)\r
- if (nd < 9)\r
- y = 10*y + c - '0';\r
- else if (nd < 16)\r
- z = 10*z + c - '0';\r
- nd0 = nd;\r
-#ifdef USE_LOCALE\r
- if (c == *localeconv()->decimal_point)\r
-#else\r
- if (c == '.')\r
-#endif\r
- {\r
- decpt = 1;\r
- c = *++s;\r
- if (!nd) {\r
- for(; c == '0'; c = *++s)\r
- nz++;\r
- if (c > '0' && c <= '9') {\r
- s0 = s;\r
- nf += nz;\r
- nz = 0;\r
- goto have_dig;\r
- }\r
- goto dig_done;\r
- }\r
- for(; c >= '0' && c <= '9'; c = *++s) {\r
- have_dig:\r
- nz++;\r
- if (c -= '0') {\r
- nf += nz;\r
- for(i = 1; i < nz; i++)\r
- if (nd++ < 9)\r
- y *= 10;\r
- else if (nd <= DBL_DIG + 1)\r
- z *= 10;\r
- if (nd++ < 9)\r
- y = 10*y + c;\r
- else if (nd <= DBL_DIG + 1)\r
- z = 10*z + c;\r
- nz = 0;\r
- }\r
- }\r
- }\r
- dig_done:\r
- e = 0;\r
- if (c == 'e' || c == 'E') {\r
- if (!nd && !nz && !nz0) {\r
- irv = STRTOG_NoNumber;\r
- s = s00;\r
- goto ret;\r
- }\r
- s00 = s;\r
- esign = 0;\r
- switch(c = *++s) {\r
- case '-':\r
- esign = 1;\r
- /* FALLTHROUGH */\r
- case '+':\r
- c = *++s;\r
- }\r
- if (c >= '0' && c <= '9') {\r
- while(c == '0')\r
- c = *++s;\r
- if (c > '0' && c <= '9') {\r
- L = c - '0';\r
- s1 = s;\r
- while((c = *++s) >= '0' && c <= '9')\r
- L = 10*L + c - '0';\r
- if (s - s1 > 8 || L > 19999)\r
- /* Avoid confusion from exponents\r
- * so large that e might overflow.\r
- */\r
- e = 19999; /* safe for 16 bit ints */\r
- else\r
- e = (int)L;\r
- if (esign)\r
- e = -e;\r
- }\r
- else\r
- e = 0;\r
- }\r
- else\r
- s = s00;\r
- }\r
- if (!nd) {\r
- if (!nz && !nz0) {\r
-#ifdef INFNAN_CHECK\r
- /* Check for Nan and Infinity */\r
- if (!decpt)\r
- switch(c) {\r
- case 'i':\r
- case 'I':\r
- if (match(&s,"nf")) {\r
- --s;\r
- if (!match(&s,"inity"))\r
- ++s;\r
- irv = STRTOG_Infinite;\r
- goto infnanexp;\r
- }\r
- break;\r
- case 'n':\r
- case 'N':\r
- if (match(&s, "an")) {\r
- irv = STRTOG_NaN;\r
- *expt = fpi->emax + 1;\r
-#ifndef No_Hex_NaN\r
- if (*s == '(') /*)*/\r
- irv = hexnan(&s, fpi, bits);\r
-#endif\r
- goto infnanexp;\r
- }\r
- }\r
-#endif /* INFNAN_CHECK */\r
- irv = STRTOG_NoNumber;\r
- s = s00;\r
- }\r
- goto ret;\r
- }\r
-\r
- irv = STRTOG_Normal;\r
- e1 = e -= nf;\r
- rd = 0;\r
- switch(fpi->rounding & 3) {\r
- case FPI_Round_up:\r
- rd = 2 - sign;\r
- break;\r
- case FPI_Round_zero:\r
- rd = 1;\r
- break;\r
- case FPI_Round_down:\r
- rd = 1 + sign;\r
- }\r
-\r
- /* Now we have nd0 digits, starting at s0, followed by a\r
- * decimal point, followed by nd-nd0 digits. The number we're\r
- * after is the integer represented by those digits times\r
- * 10**e */\r
-\r
- if (!nd0)\r
- nd0 = nd;\r
- k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;\r
- dval(rv) = (double)y;\r
- if (k > 9)\r
- dval(rv) = tens[k - 9] * dval(rv) + z;\r
- bd0 = 0;\r
- if (nbits <= P && nd <= DBL_DIG) {\r
- if (!e) {\r
- if (rvOK(dval(rv), fpi, expt, bits, 1, rd, &irv))\r
- goto ret;\r
- }\r
- else if (e > 0) {\r
- if (e <= Ten_pmax) {\r
- i = fivesbits[e] + mantbits(dval(rv)) <= P;\r
- /* rv = */ rounded_product(dval(rv), tens[e]);\r
- if (rvOK(dval(rv), fpi, expt, bits, i, rd, &irv))\r
- goto ret;\r
- e1 -= e;\r
- goto rv_notOK;\r
- }\r
- i = DBL_DIG - nd;\r
- if (e <= Ten_pmax + i) {\r
- /* A fancier test would sometimes let us do\r
- * this for larger i values.\r
- */\r
- e2 = e - i;\r
- e1 -= i;\r
- dval(rv) *= tens[i];\r
- /* rv = */ rounded_product(dval(rv), tens[e2]);\r
- if (rvOK(dval(rv), fpi, expt, bits, 0, rd, &irv))\r
- goto ret;\r
- e1 -= e2;\r
- }\r
- }\r
-#ifndef Inaccurate_Divide\r
- else if (e >= -Ten_pmax) {\r
- /* rv = */ rounded_quotient(dval(rv), tens[-e]);\r
- if (rvOK(dval(rv), fpi, expt, bits, 0, rd, &irv))\r
- goto ret;\r
- e1 -= e;\r
- }\r
-#endif\r
- }\r
- rv_notOK:\r
- e1 += nd - k;\r
-\r
- /* Get starting approximation = rv * 10**e1 */\r
-\r
- e2 = 0;\r
- if (e1 > 0) {\r
- if ( (i = e1 & 15) !=0)\r
- dval(rv) *= tens[i];\r
- if (e1 &= ~15) {\r
- e1 = (unsigned int)e1 >> 4;\r
- while(e1 >= (1 << (n_bigtens-1))) {\r
- e2 += (unsigned int)((word0(rv) & Exp_mask)\r
- >> Exp_shift1) - Bias;\r
- word0(rv) &= ~Exp_mask;\r
- word0(rv) |= Bias << Exp_shift1;\r
- dval(rv) *= bigtens[n_bigtens-1];\r
- e1 -= 1 << (n_bigtens-1);\r
- }\r
- e2 += (unsigned int)((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;\r
- word0(rv) &= ~Exp_mask;\r
- word0(rv) |= Bias << Exp_shift1;\r
- for(j = 0; e1 > 0; j++, e1 = (unsigned int)e1 >> 1)\r
- if (e1 & 1)\r
- dval(rv) *= bigtens[j];\r
- }\r
- }\r
- else if (e1 < 0) {\r
- e1 = -e1;\r
- if ( (i = e1 & 15) !=0)\r
- dval(rv) /= tens[i];\r
- if (e1 &= ~15) {\r
- e1 = (unsigned int)e1 >> 4;\r
- while(e1 >= (1 << (n_bigtens-1))) {\r
- e2 += (unsigned int)((word0(rv) & Exp_mask)\r
- >> Exp_shift1) - Bias;\r
- word0(rv) &= ~Exp_mask;\r
- word0(rv) |= Bias << Exp_shift1;\r
- dval(rv) *= tinytens[n_bigtens-1];\r
- e1 -= 1 << (n_bigtens-1);\r
- }\r
- e2 += (unsigned int)((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;\r
- word0(rv) &= ~Exp_mask;\r
- word0(rv) |= Bias << Exp_shift1;\r
- for(j = 0; e1 > 0; j++, e1 = (unsigned int)e1 >> 1)\r
- if (e1 & 1)\r
- dval(rv) *= tinytens[j];\r
- }\r
- }\r
- rvb = d2b(dval(rv), &rve, &rvbits); /* rv = rvb * 2^rve */\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- rve += e2;\r
- if ((j = rvbits - nbits) > 0) {\r
- rshift(rvb, j);\r
- rvbits = nbits;\r
- rve += j;\r
- }\r
- bb0 = 0; /* trailing zero bits in rvb */\r
- e2 = rve + rvbits - nbits;\r
- if (e2 > fpi->emax + 1)\r
- goto huge;\r
- rve1 = rve + rvbits - nbits;\r
- if (e2 < (emin = fpi->emin)) {\r
- denorm = 1;\r
- j = rve - emin;\r
- if (j > 0) {\r
- rvb = lshift(rvb, j);\r
- rvbits += j;\r
- }\r
- else if (j < 0) {\r
- rvbits += j;\r
- if (rvbits <= 0) {\r
- if (rvbits < -1) {\r
- ufl:\r
- rvb->wds = 0;\r
- rvb->x[0] = 0;\r
- *expt = emin;\r
- irv = STRTOG_Underflow | STRTOG_Inexlo;\r
- goto ret;\r
- }\r
- rvb->x[0] = rvb->wds = rvbits = 1;\r
- }\r
- else\r
- rshift(rvb, -j);\r
- }\r
- rve = rve1 = emin;\r
- if (sudden_underflow && e2 + 1 < emin)\r
- goto ufl;\r
- }\r
-\r
- /* Now the hard part -- adjusting rv to the correct value.*/\r
-\r
- /* Put digits into bd: true value = bd * 10^e */\r
-\r
- bd0 = s2b(s0, nd0, nd, y);\r
-\r
- for(;;) {\r
- bd = Balloc(bd0->k);\r
- if (bd == NULL)\r
- return STRTOG_NoMemory;\r
- Bcopy(bd, bd0);\r
- bb = Balloc(rvb->k);\r
- if (bb == NULL)\r
- return STRTOG_NoMemory;\r
- Bcopy(bb, rvb);\r
- bbbits = rvbits - bb0;\r
- bbe = rve + bb0;\r
- bs = i2b(1);\r
- if (bs == NULL)\r
- return STRTOG_NoMemory;\r
-\r
- if (e >= 0) {\r
- bb2 = bb5 = 0;\r
- bd2 = bd5 = e;\r
- }\r
- else {\r
- bb2 = bb5 = -e;\r
- bd2 = bd5 = 0;\r
- }\r
- if (bbe >= 0)\r
- bb2 += bbe;\r
- else\r
- bd2 -= bbe;\r
- bs2 = bb2;\r
- j = nbits + 1 - bbbits;\r
- i = bbe + bbbits - nbits;\r
- if (i < emin) /* denormal */\r
- j += i - emin;\r
- bb2 += j;\r
- bd2 += j;\r
- i = bb2 < bd2 ? bb2 : bd2;\r
- if (i > bs2)\r
- i = bs2;\r
- if (i > 0) {\r
- bb2 -= i;\r
- bd2 -= i;\r
- bs2 -= i;\r
- }\r
- if (bb5 > 0) {\r
- bs = pow5mult(bs, bb5);\r
- if (bs == NULL)\r
- return STRTOG_NoMemory;\r
- bb1 = mult(bs, bb);\r
- if (bb1 == NULL)\r
- return STRTOG_NoMemory;\r
- Bfree(bb);\r
- bb = bb1;\r
- }\r
- bb2 -= bb0;\r
- if (bb2 > 0) {\r
- bb = lshift(bb, bb2);\r
- if (bb == NULL)\r
- return STRTOG_NoMemory;\r
- }\r
- else if (bb2 < 0)\r
- rshift(bb, -bb2);\r
- if (bd5 > 0) {\r
- bd = pow5mult(bd, bd5);\r
- if (bd == NULL)\r
- return STRTOG_NoMemory;\r
- }\r
- if (bd2 > 0) {\r
- bd = lshift(bd, bd2);\r
- if (bd == NULL)\r
- return STRTOG_NoMemory;\r
- }\r
- if (bs2 > 0) {\r
- bs = lshift(bs, bs2);\r
- if (bs == NULL)\r
- return STRTOG_NoMemory;\r
- }\r
- asub = 1;\r
- inex = STRTOG_Inexhi;\r
- delta = diff(bb, bd);\r
- if (delta == NULL)\r
- return STRTOG_NoMemory;\r
- if (delta->wds <= 1 && !delta->x[0])\r
- break;\r
- dsign = delta->sign;\r
- delta->sign = finished = 0;\r
- L = 0;\r
- i = cmp(delta, bs);\r
- if (rd && i <= 0) {\r
- irv = STRTOG_Normal;\r
- if ( (finished = dsign ^ (rd&1)) !=0) {\r
- if (dsign != 0) {\r
- irv |= STRTOG_Inexhi;\r
- goto adj1;\r
- }\r
- irv |= STRTOG_Inexlo;\r
- if (rve1 == emin)\r
- goto adj1;\r
- for(i = 0, j = nbits; j >= ULbits;\r
- i++, j -= ULbits) {\r
- if (rvb->x[i] & ALL_ON)\r
- goto adj1;\r
- }\r
- if (j > 1 && lo0bits(rvb->x + i) < j - 1)\r
- goto adj1;\r
- rve = rve1 - 1;\r
- rvb = set_ones(rvb, rvbits = nbits);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- break;\r
- }\r
- irv |= dsign ? STRTOG_Inexlo : STRTOG_Inexhi;\r
- break;\r
- }\r
- if (i < 0) {\r
- /* Error is less than half an ulp -- check for\r
- * special case of mantissa a power of two.\r
- */\r
- irv = dsign\r
- ? STRTOG_Normal | STRTOG_Inexlo\r
- : STRTOG_Normal | STRTOG_Inexhi;\r
- if (dsign || bbbits > 1 || denorm || rve1 == emin)\r
- break;\r
- delta = lshift(delta,1);\r
- if (delta == NULL)\r
- return STRTOG_NoMemory;\r
- if (cmp(delta, bs) > 0) {\r
- irv = STRTOG_Normal | STRTOG_Inexlo;\r
- goto drop_down;\r
- }\r
- break;\r
- }\r
- if (i == 0) {\r
- /* exactly half-way between */\r
- if (dsign) {\r
- if (denorm && all_on(rvb, rvbits)) {\r
- /*boundary case -- increment exponent*/\r
- rvb->wds = 1;\r
- rvb->x[0] = 1;\r
- rve = emin + nbits - (rvbits = 1);\r
- irv = STRTOG_Normal | STRTOG_Inexhi;\r
- denorm = 0;\r
- break;\r
- }\r
- irv = STRTOG_Normal | STRTOG_Inexlo;\r
- }\r
- else if (bbbits == 1) {\r
- irv = STRTOG_Normal;\r
- drop_down:\r
- /* boundary case -- decrement exponent */\r
- if (rve1 == emin) {\r
- irv = STRTOG_Normal | STRTOG_Inexhi;\r
- if (rvb->wds == 1 && rvb->x[0] == 1)\r
- sudden_underflow = 1;\r
- break;\r
- }\r
- rve -= nbits;\r
- rvb = set_ones(rvb, rvbits = nbits);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- break;\r
- }\r
- else\r
- irv = STRTOG_Normal | STRTOG_Inexhi;\r
- if ((bbbits < nbits && !denorm) || !(rvb->x[0] & 1))\r
- break;\r
- if (dsign) {\r
- rvb = increment(rvb);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- if ( (j = rvbits & kmask) !=0)\r
- j = ULbits - j;\r
- if (hi0bits(rvb->x[(unsigned int)(rvb->wds - 1)\r
- >> kshift])\r
- != j)\r
- rvbits++;\r
- irv = STRTOG_Normal | STRTOG_Inexhi;\r
- }\r
- else {\r
- if (bbbits == 1)\r
- goto undfl;\r
- decrement(rvb);\r
- irv = STRTOG_Normal | STRTOG_Inexlo;\r
- }\r
- break;\r
- }\r
- if ((dval(adj) = ratio(delta, bs)) <= 2.) {\r
- adj1:\r
- inex = STRTOG_Inexlo;\r
- if (dsign) {\r
- asub = 0;\r
- inex = STRTOG_Inexhi;\r
- }\r
- else if (denorm && bbbits <= 1) {\r
- undfl:\r
- rvb->wds = 0;\r
- rve = emin;\r
- irv = STRTOG_Underflow | STRTOG_Inexlo;\r
- break;\r
- }\r
- adj0 = dval(adj) = 1.;\r
- }\r
- else {\r
- adj0 = dval(adj) *= 0.5;\r
- if (dsign) {\r
- asub = 0;\r
- inex = STRTOG_Inexlo;\r
- }\r
- if (dval(adj) < 2147483647.) {\r
- L = (Long)adj0;\r
- adj0 -= L;\r
- switch(rd) {\r
- case 0:\r
- if (adj0 >= .5)\r
- goto inc_L;\r
- break;\r
- case 1:\r
- if (asub && adj0 > 0.)\r
- goto inc_L;\r
- break;\r
- case 2:\r
- if (!asub && adj0 > 0.) {\r
-inc_L:\r
- L++;\r
- inex = STRTOG_Inexact - inex;\r
- }\r
- }\r
- dval(adj) = (double)L;\r
- }\r
- }\r
- y = rve + rvbits;\r
-\r
- /* adj *= ulp(dval(rv)); */\r
- /* if (asub) rv -= adj; else rv += adj; */\r
-\r
- if (!denorm && rvbits < nbits) {\r
- rvb = lshift(rvb, j = nbits - rvbits);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- rve -= j;\r
- rvbits = nbits;\r
- }\r
- ab = d2b(dval(adj), &abe, &abits);\r
- if (ab == NULL)\r
- return STRTOG_NoMemory;\r
- if (abe < 0)\r
- rshift(ab, -abe);\r
- else if (abe > 0)\r
- ab = lshift(ab, abe);\r
- rvb0 = rvb;\r
- if (asub) {\r
- /* rv -= adj; */\r
- j = hi0bits(rvb->x[rvb->wds-1]);\r
- rvb = diff(rvb, ab);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- k = rvb0->wds - 1;\r
- if (denorm)\r
- /* do nothing */;\r
- else if (rvb->wds <= k\r
- || hi0bits( rvb->x[k]) >\r
- hi0bits(rvb0->x[k])) {\r
- /* unlikely; can only have lost 1 high bit */\r
- if (rve1 == emin) {\r
- --rvbits;\r
- denorm = 1;\r
- }\r
- else {\r
- rvb = lshift(rvb, 1);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- --rve;\r
- --rve1;\r
- L = finished = 0;\r
- }\r
- }\r
- }\r
- else {\r
- rvb = sum(rvb, ab);\r
- if (rvb == NULL)\r
- return STRTOG_NoMemory;\r
- k = rvb->wds - 1;\r
- if (k >= rvb0->wds\r
- || hi0bits(rvb->x[k]) < hi0bits(rvb0->x[k])) {\r
- if (denorm) {\r
- if (++rvbits == nbits)\r
- denorm = 0;\r
- }\r
- else {\r
- rshift(rvb, 1);\r
- rve++;\r
- rve1++;\r
- L = 0;\r
- }\r
- }\r
- }\r
- Bfree(ab);\r
- Bfree(rvb0);\r
- if (finished)\r
- break;\r
-\r
- z = rve + rvbits;\r
- if (y == z && L) {\r
- /* Can we stop now? */\r
- tol = dval(adj) * 5e-16; /* > max rel error */\r
- dval(adj) = adj0 - .5;\r
- if (dval(adj) < -tol) {\r
- if (adj0 > tol) {\r
- irv |= inex;\r
- break;\r
- }\r
- }\r
- else if (dval(adj) > tol && adj0 < 1. - tol) {\r
- irv |= inex;\r
- break;\r
- }\r
- }\r
- bb0 = denorm ? 0 : trailz(rvb);\r
- Bfree(bb);\r
- Bfree(bd);\r
- Bfree(bs);\r
- Bfree(delta);\r
- }\r
- if (!denorm && (j = nbits - rvbits)) {\r
- if (j > 0)\r
- rvb = lshift(rvb, j);\r
- else\r
- rshift(rvb, -j);\r
- rve -= j;\r
- }\r
- *expt = rve;\r
- Bfree(bb);\r
- Bfree(bd);\r
- Bfree(bs);\r
- Bfree(bd0);\r
- Bfree(delta);\r
- if (rve > fpi->emax) {\r
- huge:\r
- rvb->wds = 0;\r
- irv = STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;\r
-#ifndef NO_ERRNO\r
- errno = ERANGE;\r
-#endif\r
-#ifdef INFNAN_CHECK\r
- infnanexp:\r
-#endif\r
- *expt = fpi->emax + 1;\r
- }\r
- ret:\r
- if (denorm) {\r
- if (sudden_underflow) {\r
- rvb->wds = 0;\r
- irv = STRTOG_Underflow | STRTOG_Inexlo;\r
- }\r
- else {\r
- irv = (irv & ~STRTOG_Retmask) |\r
- (rvb->wds > 0 ? STRTOG_Denormal : STRTOG_Zero);\r
- if (irv & STRTOG_Inexact)\r
- irv |= STRTOG_Underflow;\r
- }\r
- }\r
- if (se)\r
- *se = __UNCONST(s);\r
- if (sign)\r
- irv |= STRTOG_Neg;\r
- if (rvb) {\r
- copybits(bits, nbits, rvb);\r
- Bfree(rvb);\r
- }\r
- return irv;\r
- }\r