/* This functions is only used when unmarshalling.
* The assumptions made here are therefore safe.
* String#to_f uses string_to_double
*/
OBJECT float_from_string(STATE, char *str) {
char *endp;
double d;
d = strtod(str, &endp);
if (str != endp && *endp == '\0') {
return float_new(state, d);
}
/* When we get here, we might have a system that doesn't conform to
C99 (OpenBSD is at least one) that can't handle Infinity / NaN.
We test the strings here manually and fix it if needed. */
int sign = 0;
if (*str == '-') {
sign = 1;
str++;
} else if (*str == '+') {
str++;
}
if (*str == 'I' || *str == 'i') {
return float_new(state, sign ? -HUGE_VAL : HUGE_VAL);
}
if (*str == 'N' || *str == 'n') {
word0(d) = 0x7ff80000;
word1(d) = 0;
return float_new(state, d);
}
return Qnil;
}
#if defined(IEEE_Arith) + defined(VAX)
if ((word0 (d) & Exp_mask) == Exp_mask)
#else
if (word0 (d) == 0x8000)
#endif
{
/* Infinity or NaN */
*decpt = 9999;
s =
#ifdef IEEE_Arith
!word1 (d) && !(word0 (d) & 0xfffff) ? "Infinity" :
#endif
"NaN";
if (rve)
*rve =
#ifdef IEEE_Arith
s[3] ? s + 8 :
#endif
s + 3;
return s;
}
* with " at " changed at "@" and " dot " changed to "."). */
#include "gdtoaimp.h"
double
ulp
#ifdef KR_headers
(x) U *x;
#else
(U *x)
#endif
{
Long L;
U a;
L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1;
#ifndef Sudden_Underflow
if (L > 0) {
#endif
#ifdef IBM
L |= Exp_msk1 >> 4;
#endif
word0(&a) = L;
word1(&a) = 0;
#ifndef Sudden_Underflow
}
else {
L = (unsigned int)-L >> Exp_shift;
if (L < Exp_shift) {
word0(&a) = 0x80000 >> L;
word1(&a) = 0;
strtodI(CONST char *s, char **sp, double *dd)
#endif
{
static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, SI };
ULong bits[2], sign;
Long exp;
int j, k;
U *u;
k = strtodg(s, sp, &fpi, &exp, bits);
u = (U*)dd;
sign = k & STRTOG_Neg ? 0x80000000L : 0;
switch(k & STRTOG_Retmask) {
case STRTOG_NoNumber:
dval(&u[0]) = dval(&u[1]) = 0.;
break;
case STRTOG_Zero:
dval(&u[0]) = dval(&u[1]) = 0.;
#ifdef Sudden_Underflow
if (k & STRTOG_Inexact) {
if (sign)
word0(&u[0]) = 0x80100000L;
else
word0(&u[1]) = 0x100000L;
}
break;
#else
goto contain;
#endif
case STRTOG_Denormal:
word1(&u[0]) = bits[0];
word0(&u[0]) = bits[1];
goto contain;
case STRTOG_Normal:
word1(&u[0]) = bits[0];
word0(&u[0]) = (bits[1] & ~0x100000) | ((exp + 0x3ff + 52) << 20);
contain:
j = k & STRTOG_Inexact;
if (sign) {
word0(&u[0]) |= sign;
j = STRTOG_Inexact - j;
}
switch(j) {
case STRTOG_Inexlo:
#ifdef Sudden_Underflow
if ((u->L[_0] & 0x7ff00000) < 0x3500000) {
word0(&u[1]) = word0(&u[0]) + 0x3500000;
word1(&u[1]) = word1(&u[0]);
dval(&u[1]) += ulp(&u[1]);
word0(&u[1]) -= 0x3500000;
if (!(word0(&u[1]) & 0x7ff00000)) {
word0(&u[1]) = sign;
word1(&u[1]) = 0;
}
}
else
#endif
dval(&u[1]) = dval(&u[0]) + ulp(&u[0]);
break;
case STRTOG_Inexhi:
dval(&u[1]) = dval(&u[0]);
#ifdef Sudden_Underflow
if ((word0(&u[0]) & 0x7ff00000) < 0x3500000) {
word0(&u[0]) += 0x3500000;
dval(&u[0]) -= ulpdown(u);
word0(&u[0]) -= 0x3500000;
if (!(word0(&u[0]) & 0x7ff00000)) {
word0(&u[0]) = sign;
word1(&u[0]) = 0;
}
}
else
#endif
dval(&u[0]) -= ulpdown(u);
break;
default:
dval(&u[1]) = dval(&u[0]);
}
break;
case STRTOG_Infinite:
word0(&u[0]) = word0(&u[1]) = sign | 0x7ff00000;
word1(&u[0]) = word1(&u[1]) = 0;
if (k & STRTOG_Inexact) {
if (sign) {
word0(&u[1]) = 0xffefffffL;
word1(&u[1]) = 0xffffffffL;
}
else {
word0(&u[0]) = 0x7fefffffL;
word1(&u[0]) = 0xffffffffL;
}
}
break;
case STRTOG_NaN:
u->L[0] = (u+1)->L[0] = d_QNAN0;
u->L[1] = (u+1)->L[1] = d_QNAN1;
break;
case STRTOG_NaNbits:
word0(&u[0]) = word0(&u[1]) = 0x7ff00000 | sign | bits[1];
word1(&u[0]) = word1(&u[1]) = bits[0];
}
return k;
}
