/* Please send bug reports to David M. Gay (dmg at acm dot org,
* with " at " changed at "@" and " dot " changed to "."). */
+#include "xlocale_private.h"
+
#include "gdtoaimp.h"
#ifdef USE_LOCALE
#include "locale.h"
#endif
- static CONST int
+#define fivesbits __fivesbits_D2A
+#define all_on __all_on_D2A
+#define set_ones __set_ones_D2A
+#define rvOK __rvOK_D2A
+#define mantbits __mantbits_D2A
+
+#ifdef BUILDING_VARIANT
+extern CONST int fivesbits[];
+int all_on(Bigint *b, int n);
+Bigint *set_ones(Bigint *b, int n);
+int rvOK(U *d, CONST FPI *fpi, Long *exp, ULong *bits, int exact, int rd, int *irv);
+int mantbits(U *d);
+#else /* !BUILDING_VARIANT */
+
+ __private_extern__ 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
#endif
}
- static int
+ __private_extern__ int
#ifdef KR_headers
all_on(b, n) Bigint *b; int n;
#else
return b;
}
- static int
+ __private_extern__ int
rvOK
#ifdef KR_headers
(d, fpi, exp, bits, exact, rd, irv)
- double d; FPI *fpi; Long *exp; ULong *bits; int exact, rd, *irv;
+ U *d; CONST FPI *fpi; Long *exp; ULong *bits; int exact, rd, *irv;
#else
- (double d, FPI *fpi, Long *exp, ULong *bits, int exact, int rd, int *irv)
+ (U *d, CONST FPI *fpi, Long *exp, ULong *bits, int exact, int rd, int *irv)
#endif
{
Bigint *b;
int bdif, e, j, k, k1, nb, rv;
carry = rv = 0;
- b = d2b(d, &e, &bdif);
+ b = d2b(dval(d), &e, &bdif);
bdif -= nb = fpi->nbits;
e += bdif;
if (bdif <= 0) {
return rv;
}
- static int
+ __private_extern__ int
#ifdef KR_headers
-mantbits(d) double d;
+mantbits(d) U *d;
#else
-mantbits(double d)
+mantbits(U *d)
#endif
{
ULong L;
return P - 32 - lo0bits(&L);
}
+#endif /* BUILDING_VARIANT */
+
int
strtodg
#ifdef KR_headers
- (s00, se, fpi, exp, bits)
- CONST char *s00; char **se; FPI *fpi; Long *exp; ULong *bits;
+ (s00, se, fpi, exp, bits, loc)
+ CONST char *s00; char **se; CONST FPI *fpi; Long *exp; ULong *bits; locale_t loc;
#else
- (CONST char *s00, char **se, FPI *fpi, Long *exp, ULong *bits)
+ (CONST char *s00, char **se, CONST FPI *fpi, Long *exp, ULong *bits, locale_t loc)
#endif
{
int abe, abits, asub;
int j, k, nbits, nd, nd0, nf, nz, nz0, rd, rvbits, rve, rve1, sign;
int sudden_underflow;
CONST char *s, *s0, *s1;
- double adj, adj0, rv, tol;
+ char *strunc = NULL;
+ double adj0, tol;
Long L;
+ U adj, rv;
ULong *b, *be, y, z;
Bigint *ab, *bb, *bb1, *bd, *bd0, *bs, *delta, *rvb, *rvb0;
-#ifdef USE_LOCALE
+#ifdef USE_LOCALE /*{{*/
+ NORMALIZE_LOCALE(loc);
#ifdef NO_LOCALE_CACHE
- char *decimalpoint = localeconv()->decimal_point;
+ char *decimalpoint = localeconv_l(loc)->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))) {
+ s0 = localeconv_l(loc)->decimal_point;
+ if ((decimalpoint_cache = (char*)MALLOC(strlen(s0) + 1))) {
strcpy(decimalpoint_cache, s0);
s0 = decimalpoint_cache;
}
+ dplen = strlen(s0);
}
decimalpoint = (char*)s0;
-#endif
-#endif
+#endif /*NO_LOCALE_CACHE*/
+#else /*USE_LOCALE}{*/
+#define dplen 1
+#endif /*USE_LOCALE}}*/
irv = STRTOG_Zero;
denorm = sign = nz0 = nz = 0;
- dval(rv) = 0.;
+ dval(&rv) = 0.;
rvb = 0;
nbits = fpi->nbits;
for(s = s00;;s++) switch(*s) {
switch(s[1]) {
case 'x':
case 'X':
- irv = gethex(&s, fpi, exp, &rvb, sign);
+ irv = gethex(&s, fpi, exp, &rvb, sign, loc);
if (irv == STRTOG_NoNumber) {
s = s00;
sign = 0;
}
goto ret;
}
+ TRUNCATE_DIGITS(s0, strunc, nd, nd0, nf, fpi->nbits, fpi->emin, dplen);
irv = STRTOG_Normal;
e1 = e -= nf;
if (!nd0)
nd0 = nd;
k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
- dval(rv) = y;
+ dval(&rv) = y;
if (k > 9)
- dval(rv) = tens[k - 9] * dval(rv) + z;
+ dval(&rv) = tens[k - 9] * dval(&rv) + z;
bd0 = 0;
if (nbits <= P && nd <= DBL_DIG) {
if (!e) {
- if (rvOK(dval(rv), fpi, exp, bits, 1, rd, &irv))
+ if (rvOK(&rv, fpi, exp, bits, 1, rd, &irv))
goto ret;
}
else if (e > 0) {
#ifdef VAX
goto vax_ovfl_check;
#else
- i = fivesbits[e] + mantbits(dval(rv)) <= P;
- /* rv = */ rounded_product(dval(rv), tens[e]);
- if (rvOK(dval(rv), fpi, exp, bits, i, rd, &irv))
+ i = fivesbits[e] + mantbits(&rv) <= P;
+ /* rv = */ rounded_product(dval(&rv), tens[e]);
+ if (rvOK(&rv, fpi, exp, bits, i, rd, &irv))
goto ret;
e1 -= e;
goto rv_notOK;
*/
e2 = e - i;
e1 -= i;
- dval(rv) *= tens[i];
+ dval(&rv) *= tens[i];
#ifdef VAX
/* VAX exponent range is so narrow we must
* worry about overflow here...
*/
vax_ovfl_check:
- dval(adj) = dval(rv);
- word0(adj) -= P*Exp_msk1;
- /* adj = */ rounded_product(dval(adj), tens[e2]);
- if ((word0(adj) & Exp_mask)
+ dval(&adj) = dval(&rv);
+ word0(&adj) -= P*Exp_msk1;
+ /* adj = */ rounded_product(dval(&adj), tens[e2]);
+ if ((word0(&adj) & Exp_mask)
> Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
goto rv_notOK;
- word0(adj) += P*Exp_msk1;
- dval(rv) = dval(adj);
+ word0(&adj) += P*Exp_msk1;
+ dval(&rv) = dval(&adj);
#else
- /* rv = */ rounded_product(dval(rv), tens[e2]);
+ /* rv = */ rounded_product(dval(&rv), tens[e2]);
#endif
- if (rvOK(dval(rv), fpi, exp, bits, 0, rd, &irv))
+ if (rvOK(&rv, fpi, exp, 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(dval(rv), fpi, exp, bits, 0, rd, &irv))
+ /* rv = */ rounded_quotient(dval(&rv), tens[-e]);
+ if (rvOK(&rv, fpi, exp, bits, 0, rd, &irv))
goto ret;
e1 -= e;
}
e2 = 0;
if (e1 > 0) {
if ( (i = e1 & 15) !=0)
- dval(rv) *= tens[i];
+ dval(&rv) *= tens[i];
if (e1 &= ~15) {
e1 >>= 4;
- while(e1 >= (1 << n_bigtens-1)) {
- e2 += ((word0(rv) & Exp_mask)
+ 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;
+ 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;
+ 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];
+ dval(&rv) *= bigtens[j];
}
}
else if (e1 < 0) {
e1 = -e1;
if ( (i = e1 & 15) !=0)
- dval(rv) /= tens[i];
+ dval(&rv) /= tens[i];
if (e1 &= ~15) {
e1 >>= 4;
- while(e1 >= (1 << n_bigtens-1)) {
- e2 += ((word0(rv) & Exp_mask)
+ 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;
+ 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;
+ 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];
+ dval(&rv) *= tinytens[j];
}
}
#ifdef IBM
*/
e2 <<= 2;
#endif
- rvb = d2b(dval(rv), &rve, &rvbits); /* rv = rvb * 2^rve */
+ rvb = d2b(dval(&rv), &rve, &rvbits); /* rv = rvb * 2^rve */
rve += e2;
if ((j = rvbits - nbits) > 0) {
rshift(rvb, j);
rvb->x[0] = 0;
*exp = emin;
irv = STRTOG_Underflow | STRTOG_Inexlo;
+/* When __DARWIN_UNIX03 is set, we don't need this (errno is set later) */
+#if !defined(NO_ERRNO) && !__DARWIN_UNIX03
+ errno = ERANGE;
+#endif
goto ret;
}
rvb->x[0] = rvb->wds = rvbits = 1;
/* Put digits into bd: true value = bd * 10^e */
- bd0 = s2b(s0, nd0, nd, y);
+ bd0 = s2b(s0, nd0, nd, y, dplen);
for(;;) {
bd = Balloc(bd0->k);
}
else
irv = STRTOG_Normal | STRTOG_Inexhi;
- if (bbbits < nbits && !denorm || !(rvb->x[0] & 1))
+ if ((bbbits < nbits && !denorm) || !(rvb->x[0] & 1))
break;
if (dsign) {
rvb = increment(rvb);
}
break;
}
- if ((dval(adj) = ratio(delta, bs)) <= 2.) {
+ if ((dval(&adj) = ratio(delta, bs)) <= 2.) {
adj1:
inex = STRTOG_Inexlo;
if (dsign) {
irv = STRTOG_Underflow | STRTOG_Inexlo;
break;
}
- adj0 = dval(adj) = 1.;
+ adj0 = dval(&adj) = 1.;
}
else {
- adj0 = dval(adj) *= 0.5;
+ adj0 = dval(&adj) *= 0.5;
if (dsign) {
asub = 0;
inex = STRTOG_Inexlo;
}
- if (dval(adj) < 2147483647.) {
+ if (dval(&adj) < 2147483647.) {
L = adj0;
adj0 -= L;
switch(rd) {
inex = STRTOG_Inexact - inex;
}
}
- dval(adj) = L;
+ dval(&adj) = L;
}
}
y = rve + rvbits;
- /* adj *= ulp(dval(rv)); */
+ /* adj *= ulp(dval(&rv)); */
/* if (asub) rv -= adj; else rv += adj; */
if (!denorm && rvbits < nbits) {
rve -= j;
rvbits = nbits;
}
- ab = d2b(dval(adj), &abe, &abits);
+ ab = d2b(dval(&adj), &abe, &abits);
if (abe < 0)
rshift(ab, -abe);
else if (abe > 0)
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) {
+ 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) {
+ else if (dval(&adj) > tol && adj0 < 1. - tol) {
irv |= inex;
break;
}
if (sudden_underflow) {
rvb->wds = 0;
irv = STRTOG_Underflow | STRTOG_Inexlo;
-#ifndef NO_ERRNO
+#if !defined(NO_ERRNO) && __DARWIN_UNIX03
errno = ERANGE;
#endif
}
(rvb->wds > 0 ? STRTOG_Denormal : STRTOG_Zero);
if (irv & STRTOG_Inexact) {
irv |= STRTOG_Underflow;
-#ifndef NO_ERRNO
+#if !defined(NO_ERRNO) && __DARWIN_UNIX03
errno = ERANGE;
#endif
}
copybits(bits, nbits, rvb);
Bfree(rvb);
}
+ if (strunc)
+#ifdef FREE
+ FREE(strunc);
+#else
+ free(strunc);
+#endif
return irv;
}
projects / apple / libc.git / blobdiff