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