****************************************************************/
-/* Please send bug reports to
- David M. Gay
- dmg@acm.org
- */
+/* Please send bug reports to David M. Gay (dmg at acm dot org,
+ * with " at " changed at "@" and " dot " changed to "."). */
#include "gdtoaimp.h"
+#ifndef NO_FENV_H
+#include <fenv.h>
+#endif
#ifdef USE_LOCALE
#include "locale.h"
#ifndef NO_IEEE_Scale
#define Avoid_Underflow
#undef tinytens
-/* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
+/* The factor of 2^106 in tinytens[4] helps us avoid setting the underflow */
/* flag unnecessarily. It leads to a song and dance at the end of strtod. */
static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128,
- 9007199254740992.e-256
+ 9007199254740992.*9007199254740992.e-256
};
#endif
#endif
#ifdef Honor_FLT_ROUNDS
-#define Rounding rounding
#undef Check_FLT_ROUNDS
#define Check_FLT_ROUNDS
#else
#ifdef Avoid_Underflow
int scale;
#endif
- int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
+ int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, dsign,
e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
CONST char *s, *s0, *s1;
double aadj, aadj1, adj, rv, rv0;
#ifdef SET_INEXACT
int inexact, oldinexact;
#endif
-#ifdef Honor_FLT_ROUNDS
- int rounding;
-#endif
+#ifdef USE_LOCALE
+#ifdef NO_LOCALE_CACHE
+ char *decimalpoint = localeconv()->decimal_point;
+#else
+ char *decimalpoint;
+ static char *decimalpoint_cache;
+ if (!(s0 = decimalpoint_cache)) {
+ s0 = localeconv()->decimal_point;
+ if ((decimalpoint_cache = (char*)malloc(strlen(s0) + 1))) {
+ strcpy(decimalpoint_cache, s0);
+ s0 = decimalpoint_cache;
+ }
+ }
+ decimalpoint = (char*)s0;
+#endif
+#endif
+#ifdef Honor_FLT_ROUNDS /*{*/
+ int Rounding;
+#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */
+ Rounding = Flt_Rounds;
+#else /*}{*/
+ Rounding = 1;
+ switch(fegetround()) {
+ case FE_TOWARDZERO: Rounding = 0; break;
+ case FE_UPWARD: Rounding = 2; break;
+ case FE_DOWNWARD: Rounding = 3;
+ }
+#endif /*}}*/
+#endif /*}*/
- sign = nz0 = nz = 0;
+ sign = nz0 = nz = decpt = 0;
dval(rv) = 0.;
for(s = s00;;s++) switch(*s) {
case '-':
}
break2:
if (*s == '0') {
-#ifndef NO_HEX_FP
+#ifndef NO_HEX_FP /*{*/
{
static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
Long exp;
switch(s[1]) {
case 'x':
case 'X':
- switch((i = gethex(&s, &fpi, &exp, &bb, sign)) & STRTOG_Retmask) {
+ {
+#if defined(FE_DOWNWARD) && defined(FE_TONEAREST) && defined(FE_TOWARDZERO) && defined(FE_UPWARD) /*{{*/
+ FPI fpi1 = fpi;
+#ifdef Honor_FLT_ROUNDS /*{{*/
+ fpi1.rounding = Rounding;
+#else /*}{*/
+ switch(fegetround()) {
+ case FE_TOWARDZERO: fpi1.rounding = 0; break;
+ case FE_UPWARD: fpi1.rounding = 2; break;
+ case FE_DOWNWARD: fpi1.rounding = 3;
+ }
+#endif /*}}*/
+#else /*}{*/
+#define fpi1 fpi
+#endif /*}}*/
+ switch((i = gethex(&s, &fpi1, &exp, &bb, sign)) & STRTOG_Retmask) {
case STRTOG_NoNumber:
s = s00;
sign = 0;
Bfree(bb);
}
ULtod(((U*)&rv)->L, bits, exp, i);
- }
+ }}
goto ret;
}
}
-#endif
+#endif /*}*/
nz0 = 1;
while(*++s == '0') ;
if (!*s)
z = 10*z + c - '0';
nd0 = nd;
#ifdef USE_LOCALE
- if (c == *localeconv()->decimal_point)
+ if (c == *decimalpoint) {
+ for(i = 1; decimalpoint[i]; ++i)
+ if (s[i] != decimalpoint[i])
+ goto dig_done;
+ s += i;
+ c = *s;
#else
- if (c == '.')
-#endif
- {
+ if (c == '.') {
c = *++s;
+#endif
+ decpt = 1;
if (!nd) {
for(; c == '0'; c = *++s)
nz++;
nz = 0;
}
}
- }
+ }/*}*/
dig_done:
e = 0;
if (c == 'e' || c == 'E') {
ULong bits[2];
static FPI fpinan = /* only 52 explicit bits */
{ 52, 1-1023-53+1, 2046-1023-53+1, 1, SI };
- switch(c) {
+ if (!decpt)
+ switch(c) {
case 'i':
case 'I':
if (match(&s,"nf")) {
word1(rv) = bits[0];
}
else {
+#endif
word0(rv) = NAN_WORD0;
word1(rv) = NAN_WORD1;
+#ifndef No_Hex_NaN
}
#endif
goto ret;
scale = 0;
#endif
#ifdef Honor_FLT_ROUNDS
- if ((rounding = Flt_Rounds) >= 2) {
+ if (Rounding >= 2) {
if (sign)
- rounding = rounding == 2 ? 0 : 2;
+ Rounding = Rounding == 2 ? 0 : 2;
else
- if (rounding != 2)
- rounding = 0;
+ if (Rounding != 2)
+ Rounding = 0;
}
#endif
#endif /*IEEE_Arith*/
/* Can't trust HUGE_VAL */
#ifdef IEEE_Arith
#ifdef Honor_FLT_ROUNDS
- switch(rounding) {
+ switch(Rounding) {
case 0: /* toward 0 */
case 3: /* toward -infinity */
word0(rv) = Big0;
bd2 -= bbe;
bs2 = bb2;
#ifdef Honor_FLT_ROUNDS
- if (rounding != 1)
+ if (Rounding != 1)
bs2++;
#endif
#ifdef Avoid_Underflow
delta->sign = 0;
i = cmp(delta, bs);
#ifdef Honor_FLT_ROUNDS
- if (rounding != 1) {
+ if (Rounding != 1) {
if (i < 0) {
/* Error is less than an ulp */
if (!delta->x[0] && delta->wds <= 1) {
#endif
break;
}
- if (rounding) {
+ if (Rounding) {
if (dsign) {
adj = 1.;
goto apply_adj;
if (adj < 1.)
adj = 1.;
if (adj <= 0x7ffffffe) {
- /* adj = rounding ? ceil(adj) : floor(adj); */
+ /* adj = Rounding ? ceil(adj) : floor(adj); */
y = adj;
if (y != adj) {
- if (!((rounding>>1) ^ dsign))
+ if (!((Rounding>>1) ^ dsign))
y++;
adj = y;
}
#endif /*Sudden_Underflow*/
#endif /*Avoid_Underflow*/
adj *= ulp(dval(rv));
- if (dsign)
+ if (dsign) {
+ if (word0(rv) == Big0 && word1(rv) == Big1)
+ goto ovfl;
dval(rv) += adj;
+ }
else
dval(rv) -= adj;
goto cont;
}
#endif /*Avoid_Underflow*/
L = (word0(rv) & Exp_mask) - Exp_msk1;
-#endif /*Sudden_Underflow}*/
+#endif /*Sudden_Underflow}}*/
word0(rv) = L | Bndry_mask1;
word1(rv) = 0xffffffff;
#ifdef IBM
dval(rv) *= dval(rv0);
#ifndef NO_ERRNO
/* try to avoid the bug of testing an 8087 register value */
+#ifdef IEEE_Arith
+ if (!(word0(rv) & Exp_mask))
+#else
if (word0(rv) == 0 && word1(rv) == 0)
+#endif
errno = ERANGE;
#endif
}