[perl5.git] / numeric.c

/*    numeric.c
 *
 *    Copyright (c) 2001, Larry Wall
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
 */

/*
 * "That only makes eleven (plus one mislaid) and not fourteen, unless
 * wizards count differently to other people."
 */

#include "EXTERN.h"
#define PERL_IN_NUMERIC_C
#include "perl.h"

U32
Perl_cast_ulong(pTHX_ NV f)
{
  if (f < 0.0)
    return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
  if (f < U32_MAX_P1) {
#if CASTFLAGS & 2
    if (f < U32_MAX_P1_HALF)
      return (U32) f;
    f -= U32_MAX_P1_HALF;
    return ((U32) f) | (1 + U32_MAX >> 1);
#else
    return (U32) f;
#endif
  }
  return f > 0 ? U32_MAX : 0 /* NaN */;
}

I32
Perl_cast_i32(pTHX_ NV f)
{
  if (f < I32_MAX_P1)
    return f < I32_MIN ? I32_MIN : (I32) f;
  if (f < U32_MAX_P1) {
#if CASTFLAGS & 2
    if (f < U32_MAX_P1_HALF)
      return (I32)(U32) f;
    f -= U32_MAX_P1_HALF;
    return (I32)(((U32) f) | (1 + U32_MAX >> 1));
#else
    return (I32)(U32) f;
#endif
  }
  return f > 0 ? (I32)U32_MAX : 0 /* NaN */;
}

IV
Perl_cast_iv(pTHX_ NV f)
{
  if (f < IV_MAX_P1)
    return f < IV_MIN ? IV_MIN : (IV) f;
  if (f < UV_MAX_P1) {
#if CASTFLAGS & 2
    /* For future flexibility allowing for sizeof(UV) >= sizeof(IV)  */
    if (f < UV_MAX_P1_HALF)
      return (IV)(UV) f;
    f -= UV_MAX_P1_HALF;
    return (IV)(((UV) f) | (1 + UV_MAX >> 1));
#else
    return (IV)(UV) f;
#endif
  }
  return f > 0 ? (IV)UV_MAX : 0 /* NaN */;
}

UV
Perl_cast_uv(pTHX_ NV f)
{
  if (f < 0.0)
    return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
  if (f < UV_MAX_P1) {
#if CASTFLAGS & 2
    if (f < UV_MAX_P1_HALF)
      return (UV) f;
    f -= UV_MAX_P1_HALF;
    return ((UV) f) | (1 + UV_MAX >> 1);
#else
    return (UV) f;
#endif
  }
  return f > 0 ? UV_MAX : 0 /* NaN */;
}

#if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
/*
 * This hack is to force load of "huge" support from libm.a
 * So it is in perl for (say) POSIX to use.
 * Needed for SunOS with Sun's 'acc' for example.
 */
NV
Perl_huge(void)
{
#   if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
    return HUGE_VALL;
#   endif
    return HUGE_VAL;
}
#endif

NV
Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
{
    register char *s = start;
    register NV rnv = 0.0;
    register UV ruv = 0;
    register bool seenb = FALSE;
    register bool overflowed = FALSE;

    for (; len-- && *s; s++) {
	if (!(*s == '0' || *s == '1')) {
	    if (*s == '_' && len && *retlen
		&& (s[1] == '0' || s[1] == '1'))
	    {
		--len;
		++s;
	    }
	    else if (seenb == FALSE && *s == 'b' && ruv == 0) {
		/* Disallow 0bbb0b0bbb... */
		seenb = TRUE;
		continue;
	    }
	    else {
		if (ckWARN(WARN_DIGIT))
		    Perl_warner(aTHX_ WARN_DIGIT,
				"Illegal binary digit '%c' ignored", *s);
		break;
	    }
	}
	if (!overflowed) {
	    register UV xuv = ruv << 1;

	    if ((xuv >> 1) != ruv) {
		overflowed = TRUE;
		rnv = (NV) ruv;
		if (ckWARN_d(WARN_OVERFLOW))
		    Perl_warner(aTHX_ WARN_OVERFLOW,
				"Integer overflow in binary number");
	    }
	    else
		ruv = xuv | (*s - '0');
	}
	if (overflowed) {
	    rnv *= 2;
	    /* If an NV has not enough bits in its mantissa to
	     * represent an UV this summing of small low-order numbers
	     * is a waste of time (because the NV cannot preserve
	     * the low-order bits anyway): we could just remember when
	     * did we overflow and in the end just multiply rnv by the
	     * right amount. */
	    rnv += (*s - '0');
	}
    }
    if (!overflowed)
	rnv = (NV) ruv;
    if (   ( overflowed && rnv > 4294967295.0)
#if UVSIZE > 4
	|| (!overflowed && ruv > 0xffffffff  )
#endif
	) {
	if (ckWARN(WARN_PORTABLE))
	    Perl_warner(aTHX_ WARN_PORTABLE,
			"Binary number > 0b11111111111111111111111111111111 non-portable");
    }
    *retlen = s - start;
    return rnv;
}

NV
Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
{
    register char *s = start;
    register NV rnv = 0.0;
    register UV ruv = 0;
    register bool overflowed = FALSE;

    for (; len-- && *s; s++) {
	if (!(*s >= '0' && *s <= '7')) {
	    if (*s == '_' && len && *retlen
		&& (s[1] >= '0' && s[1] <= '7'))
	    {
		--len;
		++s;
	    }
	    else {
		/* Allow \octal to work the DWIM way (that is, stop scanning
		 * as soon as non-octal characters are seen, complain only iff
		 * someone seems to want to use the digits eight and nine). */
		if (*s == '8' || *s == '9') {
		    if (ckWARN(WARN_DIGIT))
			Perl_warner(aTHX_ WARN_DIGIT,
				    "Illegal octal digit '%c' ignored", *s);
		}
		break;
	    }
	}
	if (!overflowed) {
	    register UV xuv = ruv << 3;

	    if ((xuv >> 3) != ruv) {
		overflowed = TRUE;
		rnv = (NV) ruv;
		if (ckWARN_d(WARN_OVERFLOW))
		    Perl_warner(aTHX_ WARN_OVERFLOW,
				"Integer overflow in octal number");
	    }
	    else
		ruv = xuv | (*s - '0');
	}
	if (overflowed) {
	    rnv *= 8.0;
	    /* If an NV has not enough bits in its mantissa to
	     * represent an UV this summing of small low-order numbers
	     * is a waste of time (because the NV cannot preserve
	     * the low-order bits anyway): we could just remember when
	     * did we overflow and in the end just multiply rnv by the
	     * right amount of 8-tuples. */
	    rnv += (NV)(*s - '0');
	}
    }
    if (!overflowed)
	rnv = (NV) ruv;
    if (   ( overflowed && rnv > 4294967295.0)
#if UVSIZE > 4
	|| (!overflowed && ruv > 0xffffffff  )
#endif
	) {
	if (ckWARN(WARN_PORTABLE))
	    Perl_warner(aTHX_ WARN_PORTABLE,
			"Octal number > 037777777777 non-portable");
    }
    *retlen = s - start;
    return rnv;
}

NV
Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
{
    register char *s = start;
    register NV rnv = 0.0;
    register UV ruv = 0;
    register bool overflowed = FALSE;
    char *hexdigit;

    if (len > 2) {
	if (s[0] == 'x') {
	    s++;
	    len--;
	}
	else if (len > 3 && s[0] == '0' && s[1] == 'x') {
	    s+=2;
	    len-=2;
	}
    }

    for (; len-- && *s; s++) {
	hexdigit = strchr((char *) PL_hexdigit, *s);
	if (!hexdigit) {
	    if (*s == '_' && len && *retlen && s[1]
		&& (hexdigit = strchr((char *) PL_hexdigit, s[1])))
	    {
		--len;
		++s;
	    }
	    else {
		if (ckWARN(WARN_DIGIT))
		    Perl_warner(aTHX_ WARN_DIGIT,
				"Illegal hexadecimal digit '%c' ignored", *s);
		break;
	    }
	}
	if (!overflowed) {
	    register UV xuv = ruv << 4;

	    if ((xuv >> 4) != ruv) {
		overflowed = TRUE;
		rnv = (NV) ruv;
		if (ckWARN_d(WARN_OVERFLOW))
		    Perl_warner(aTHX_ WARN_OVERFLOW,
				"Integer overflow in hexadecimal number");
	    }
	    else
		ruv = xuv | ((hexdigit - PL_hexdigit) & 15);
	}
	if (overflowed) {
	    rnv *= 16.0;
	    /* If an NV has not enough bits in its mantissa to
	     * represent an UV this summing of small low-order numbers
	     * is a waste of time (because the NV cannot preserve
	     * the low-order bits anyway): we could just remember when
	     * did we overflow and in the end just multiply rnv by the
	     * right amount of 16-tuples. */
	    rnv += (NV)((hexdigit - PL_hexdigit) & 15);
	}
    }
    if (!overflowed)
	rnv = (NV) ruv;
    if (   ( overflowed && rnv > 4294967295.0)
#if UVSIZE > 4
	|| (!overflowed && ruv > 0xffffffff  )
#endif
	) {
	if (ckWARN(WARN_PORTABLE))
	    Perl_warner(aTHX_ WARN_PORTABLE,
			"Hexadecimal number > 0xffffffff non-portable");
    }
    *retlen = s - start;
    return rnv;
}

/*
=for apidoc grok_numeric_radix

Scan and skip for a numeric decimal separator (radix).

=cut
 */
bool
Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
    if (PL_numeric_radix_sv && IN_LOCALE) { 
        STRLEN len;
        char* radix = SvPV(PL_numeric_radix_sv, len);
        if (*sp + len <= send && memEQ(*sp, radix, len)) {
            *sp += len;
            return TRUE; 
        }
    }
    /* always try "." if numeric radix didn't match because
     * we may have data from different locales mixed */
#endif
    if (*sp < send && **sp == '.') {
        ++*sp;
        return TRUE;
    }
    return FALSE;
}

/*
=for apidoc grok_number

Recognise (or not) a number.  The type of the number is returned
(0 if unrecognised), otherwise it is a bit-ORed combination of
IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT,
IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h).

If the value of the number can fit an in UV, it is returned in the *valuep
IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV
will never be set unless *valuep is valid, but *valuep may have been assigned
to during processing even though IS_NUMBER_IN_UV is not set on return.
If valuep is NULL, IS_NUMBER_IN_UV will be set for the same cases as when
valuep is non-NULL, but no actual assignment (or SEGV) will occur.

IS_NUMBER_NOT_INT will be set with IS_NUMBER_IN_UV if trailing decimals were
seen (in which case *valuep gives the true value truncated to an integer), and
IS_NUMBER_NEG if the number is negative (in which case *valuep holds the
absolute value).  IS_NUMBER_IN_UV is not set if e notation was used or the
number is larger than a UV.

=cut
 */
int
Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
  const char *s = pv;
  const char *send = pv + len;
  const UV max_div_10 = UV_MAX / 10;
  const char max_mod_10 = UV_MAX % 10;
  int numtype = 0;
  int sawinf = 0;
  int sawnan = 0;

  while (s < send && isSPACE(*s))
    s++;
  if (s == send) {
    return 0;
  } else if (*s == '-') {
    s++;
    numtype = IS_NUMBER_NEG;
  }
  else if (*s == '+')
  s++;

  if (s == send)
    return 0;

  /* next must be digit or the radix separator or beginning of infinity */
  if (isDIGIT(*s)) {
    /* UVs are at least 32 bits, so the first 9 decimal digits cannot
       overflow.  */
    UV value = *s - '0';
    /* This construction seems to be more optimiser friendly.
       (without it gcc does the isDIGIT test and the *s - '0' separately)
       With it gcc on arm is managing 6 instructions (6 cycles) per digit.
       In theory the optimiser could deduce how far to unroll the loop
       before checking for overflow.  */
    if (++s < send) {
      int digit = *s - '0';
      if (digit >= 0 && digit <= 9) {
        value = value * 10 + digit;
        if (++s < send) {
          digit = *s - '0';
          if (digit >= 0 && digit <= 9) {
            value = value * 10 + digit;
            if (++s < send) {
              digit = *s - '0';
              if (digit >= 0 && digit <= 9) {
                value = value * 10 + digit;
		if (++s < send) {
                  digit = *s - '0';
                  if (digit >= 0 && digit <= 9) {
                    value = value * 10 + digit;
                    if (++s < send) {
                      digit = *s - '0';
                      if (digit >= 0 && digit <= 9) {
                        value = value * 10 + digit;
                        if (++s < send) {
                          digit = *s - '0';
                          if (digit >= 0 && digit <= 9) {
                            value = value * 10 + digit;
                            if (++s < send) {
                              digit = *s - '0';
                              if (digit >= 0 && digit <= 9) {
                                value = value * 10 + digit;
                                if (++s < send) {
                                  digit = *s - '0';
                                  if (digit >= 0 && digit <= 9) {
                                    value = value * 10 + digit;
                                    if (++s < send) {
                                      /* Now got 9 digits, so need to check
                                         each time for overflow.  */
                                      digit = *s - '0';
                                      while (digit >= 0 && digit <= 9
                                             && (value < max_div_10
                                                 || (value == max_div_10
                                                     && digit <= max_mod_10))) {
                                        value = value * 10 + digit;
                                        if (++s < send)
                                          digit = *s - '0';
                                        else
                                          break;
                                      }
                                      if (digit >= 0 && digit <= 9
                                          && (s < send)) {
                                        /* value overflowed.
                                           skip the remaining digits, don't
                                           worry about setting *valuep.  */
                                        do {
                                          s++;
                                        } while (s < send && isDIGIT(*s));
                                        numtype |=
                                          IS_NUMBER_GREATER_THAN_UV_MAX;
                                        goto skip_value;
                                      }
                                    }
                                  }
				}
                              }
                            }
                          }
                        }
                      }
                    }
                  }
                }
              }
            }
          }
	}
      }
    }
    numtype |= IS_NUMBER_IN_UV;
    if (valuep)
      *valuep = value;

  skip_value:
    if (GROK_NUMERIC_RADIX(&s, send)) {
      numtype |= IS_NUMBER_NOT_INT;
      while (s < send && isDIGIT(*s))  /* optional digits after the radix */
        s++;
    }
  }
  else if (GROK_NUMERIC_RADIX(&s, send)) {
    numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
    /* no digits before the radix means we need digits after it */
    if (s < send && isDIGIT(*s)) {
      do {
        s++;
      } while (s < send && isDIGIT(*s));
      if (valuep) {
        /* integer approximation is valid - it's 0.  */
        *valuep = 0;
      }
    }
    else
      return 0;
  } else if (*s == 'I' || *s == 'i') {
    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
    s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
    s++; if (s < send && (*s == 'I' || *s == 'i')) {
      s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
      s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
      s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
      s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
      s++;
    }
    sawinf = 1;
  } else if (*s == 'N' || *s == 'n') {
    /* XXX TODO: There are signaling NaNs and quiet NaNs. */
    s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
    s++;
    sawnan = 1;
  } else
    return 0;

  if (sawinf) {
    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
    numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
  } else if (sawnan) {
    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
    numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
  } else if (s < send) {
    /* we can have an optional exponent part */
    if (*s == 'e' || *s == 'E') {
      /* The only flag we keep is sign.  Blow away any "it's UV"  */
      numtype &= IS_NUMBER_NEG;
      numtype |= IS_NUMBER_NOT_INT;
      s++;
      if (s < send && (*s == '-' || *s == '+'))
        s++;
      if (s < send && isDIGIT(*s)) {
        do {
          s++;
        } while (s < send && isDIGIT(*s));
      }
      else
      return 0;
    }
  }
  while (s < send && isSPACE(*s))
    s++;
  if (s >= send)
    return numtype;
  if (len == 10 && memEQ(pv, "0 but true", 10)) {
    if (valuep)
      *valuep = 0;
    return IS_NUMBER_IN_UV;
  }
  return 0;
}

NV
S_mulexp10(NV value, I32 exponent)
{
    NV result = 1.0;
    NV power = 10.0;
    bool negative = 0;
    I32 bit;

    if (exponent == 0)
	return value;
    else if (exponent < 0) {
	negative = 1;
	exponent = -exponent;
    }

    /* On OpenVMS VAX we by default use the D_FLOAT double format,
     * and that format does not have *easy* capabilities [1] for
     * overflowing doubles 'silently' as IEEE fp does.  We also need 
     * to support G_FLOAT on both VAX and Alpha, and though the exponent 
     * range is much larger than D_FLOAT it still doesn't do silent 
     * overflow.  Therefore we need to detect early whether we would 
     * overflow (this is the behaviour of the native string-to-float 
     * conversion routines, and therefore of native applications, too).
     *
     * [1] Trying to establish a condition handler to trap floating point
     *     exceptions is not a good idea. */
#if defined(VMS) && !defined(__IEEE_FP) && defined(NV_MAX_10_EXP)
    if (!negative &&
        (log10(value) + exponent) >= (NV_MAX_10_EXP))
        return NV_MAX;
#endif

    /* In UNICOS and in certain Cray models (such as T90) there is no
     * IEEE fp, and no way at all from C to catch fp overflows gracefully.
     * There is something you can do if you are willing to use some
     * inline assembler: the instruction is called DFI-- but that will
     * disable *all* floating point interrupts, a little bit too large
     * a hammer.  Therefore we need to catch potential overflows before
     * it's too late. */
#if defined(_UNICOS) && defined(NV_MAX_10_EXP)
    if (!negative &&
	(log10(value) + exponent) >= NV_MAX_10_EXP)
        return NV_MAX;
#endif

    for (bit = 1; exponent; bit <<= 1) {
	if (exponent & bit) {
	    exponent ^= bit;
	    result *= power;
	}
	/* Floating point exceptions are supposed to be turned off. */
	power *= power;
    }
    return negative ? value / result : value * result;
}

NV
Perl_my_atof(pTHX_ const char* s)
{
    NV x = 0.0;
#ifdef USE_LOCALE_NUMERIC
    if (PL_numeric_local && IN_LOCALE) {
	NV y;

	/* Scan the number twice; once using locale and once without;
	 * choose the larger result (in absolute value). */
	Perl_atof2(aTHX_ s, &x);
	SET_NUMERIC_STANDARD();
	Perl_atof2(aTHX_ s, &y);
	SET_NUMERIC_LOCAL();
	if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
	    return y;
    }
    else
	Perl_atof2(aTHX_ s, &x);
#else
    Perl_atof2(aTHX_ s, &x);
#endif
    return x;
}

char*
Perl_my_atof2(pTHX_ const char* orig, NV* value)
{
    NV result = 0.0;
    bool negative = 0;
    char* s = (char*)orig;
    char* send = s + strlen(orig) - 1;
    bool seendigit = 0;
    I32 expextra = 0;
    I32 exponent = 0;
    I32 i;
/* this is arbitrary */
#define PARTLIM 6
/* we want the largest integers we can usefully use */
#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
#   define PARTSIZE ((int)TYPE_DIGITS(U64)-1)
    U64 part[PARTLIM];
#else
#   define PARTSIZE ((int)TYPE_DIGITS(U32)-1)
    U32 part[PARTLIM];
#endif
    I32 ipart = 0;	/* index into part[] */
    I32 offcount;	/* number of digits in least significant part */

    /* leading whitespace */
    while (isSPACE(*s))
	++s;

    /* sign */
    switch (*s) {
	case '-':
	    negative = 1;
	    /* fall through */
	case '+':
	    ++s;
    }

    part[0] = offcount = 0;
    if (isDIGIT(*s)) {
	seendigit = 1;	/* get this over with */

	/* skip leading zeros */
	while (*s == '0')
	    ++s;
    }

    /* integer digits */
    while (isDIGIT(*s)) {
	if (++offcount > PARTSIZE) {
	    if (++ipart < PARTLIM) {
		part[ipart] = 0;
		offcount = 1;	/* ++0 */
	    }
	    else {
		/* limits of precision reached */
		--ipart;
		--offcount;
		if (*s >= '5')
		    ++part[ipart];
		while (isDIGIT(*s)) {
		    ++expextra;
		    ++s;
		}
		/* warn of loss of precision? */
		break;
	    }
	}
	part[ipart] = part[ipart] * 10 + (*s++ - '0');
    }

    /* decimal point */
    if (GROK_NUMERIC_RADIX((const char **)&s, send)) {
	if (isDIGIT(*s))
	    seendigit = 1;	/* get this over with */

	/* decimal digits */
	while (isDIGIT(*s)) {
	    if (++offcount > PARTSIZE) {
		if (++ipart < PARTLIM) {
		    part[ipart] = 0;
		    offcount = 1;	/* ++0 */
		}
		else {
		    /* limits of precision reached */
		    --ipart;
		    --offcount;
		    if (*s >= '5')
			++part[ipart];
		    while (isDIGIT(*s))
			++s;
		    /* warn of loss of precision? */
		    break;
		}
	    }
	    --expextra;
	    part[ipart] = part[ipart] * 10 + (*s++ - '0');
	}
    }

    /* combine components of mantissa */
    for (i = 0; i <= ipart; ++i)
	result += S_mulexp10((NV)part[ipart - i],
		i ? offcount + (i - 1) * PARTSIZE : 0);

    if (seendigit && (*s == 'e' || *s == 'E')) {
	bool expnegative = 0;

	++s;
	switch (*s) {
	    case '-':
		expnegative = 1;
		/* fall through */
	    case '+':
		++s;
	}
	while (isDIGIT(*s))
	    exponent = exponent * 10 + (*s++ - '0');
	if (expnegative)
	    exponent = -exponent;
    }

    /* now apply the exponent */
    exponent += expextra;
    result = S_mulexp10(result, exponent);

    /* now apply the sign */
    if (negative)
	result = -result;
    *value = result;
    return s;
}
Commit	Line	Data
98994639 HS	1	/* numeric.c
	2	*
	3	* Copyright (c) 2001, Larry Wall
	4	*
	5	* You may distribute under the terms of either the GNU General Public
	6	* License or the Artistic License, as specified in the README file.
	7	*
	8	*/
	9
	10	/*
	11	* "That only makes eleven (plus one mislaid) and not fourteen, unless
	12	* wizards count differently to other people."
	13	*/
	14
	15	#include "EXTERN.h"
	16	#define PERL_IN_NUMERIC_C
	17	#include "perl.h"
	18
	19	U32
	20	Perl_cast_ulong(pTHX_ NV f)
	21	{
	22	if (f < 0.0)
	23	return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
	24	if (f < U32_MAX_P1) {
	25	#if CASTFLAGS & 2
	26	if (f < U32_MAX_P1_HALF)
	27	return (U32) f;
	28	f -= U32_MAX_P1_HALF;
	29	return ((U32) f) \| (1 + U32_MAX >> 1);
	30	#else
	31	return (U32) f;
	32	#endif
	33	}
	34	return f > 0 ? U32_MAX : 0 /* NaN */;
	35	}
	36
	37	I32
	38	Perl_cast_i32(pTHX_ NV f)
	39	{
	40	if (f < I32_MAX_P1)
	41	return f < I32_MIN ? I32_MIN : (I32) f;
	42	if (f < U32_MAX_P1) {
	43	#if CASTFLAGS & 2
	44	if (f < U32_MAX_P1_HALF)
	45	return (I32)(U32) f;
	46	f -= U32_MAX_P1_HALF;
	47	return (I32)(((U32) f) \| (1 + U32_MAX >> 1));
	48	#else
	49	return (I32)(U32) f;
	50	#endif
	51	}
	52	return f > 0 ? (I32)U32_MAX : 0 /* NaN */;
	53	}
	54
	55	IV
	56	Perl_cast_iv(pTHX_ NV f)
	57	{
	58	if (f < IV_MAX_P1)
	59	return f < IV_MIN ? IV_MIN : (IV) f;
	60	if (f < UV_MAX_P1) {
	61	#if CASTFLAGS & 2
	62	/* For future flexibility allowing for sizeof(UV) >= sizeof(IV) */
	63	if (f < UV_MAX_P1_HALF)
	64	return (IV)(UV) f;
65	f -= UV_MAX_P1_HALF;
66	return (IV)(((UV) f) \| (1 + UV_MAX >> 1));
67	#else
68	return (IV)(UV) f;
69	#endif
70	}
71	return f > 0 ? (IV)UV_MAX : 0 /* NaN */;
72	}
73
74	UV
75	Perl_cast_uv(pTHX_ NV f)
76	{
77	if (f < 0.0)
78	return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
79	if (f < UV_MAX_P1) {
80	#if CASTFLAGS & 2
81	if (f < UV_MAX_P1_HALF)
82	return (UV) f;
83	f -= UV_MAX_P1_HALF;
84	return ((UV) f) \| (1 + UV_MAX >> 1);
85	#else
86	return (UV) f;
87	#endif
88	}
89	return f > 0 ? UV_MAX : 0 /* NaN */;
90	}
91
92	#if defined(HUGE_VAL) \|\| (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
93	/*
94	* This hack is to force load of "huge" support from libm.a
95	* So it is in perl for (say) POSIX to use.
96	* Needed for SunOS with Sun's 'acc' for example.
97	*/
98	NV
99	Perl_huge(void)
100	{
101	# if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
102	return HUGE_VALL;
103	# endif
104	return HUGE_VAL;
105	}
106	#endif
107
108	NV
109	Perl_scan_bin(pTHX_ char start, STRLEN len, STRLEN retlen)
110	{
111	register char *s = start;
112	register NV rnv = 0.0;
113	register UV ruv = 0;
114	register bool seenb = FALSE;
115	register bool overflowed = FALSE;
116
117	for (; len-- && *s; s++) {
118	if (!(s == '0' \|\| s == '1')) {
119	if (s == '_' && len && retlen
120	&& (s[1] == '0' \|\| s[1] == '1'))
121	{
122	--len;
123	++s;
124	}
125	else if (seenb == FALSE && *s == 'b' && ruv == 0) {
126	/* Disallow 0bbb0b0bbb... */
127	seenb = TRUE;
128	continue;
129	}
130	else {
131	if (ckWARN(WARN_DIGIT))
132	Perl_warner(aTHX_ WARN_DIGIT,
133	"Illegal binary digit '%c' ignored", *s);
134	break;
135	}
136	}
137	if (!overflowed) {
138	register UV xuv = ruv << 1;
139
140	if ((xuv >> 1) != ruv) {
141	overflowed = TRUE;
142	rnv = (NV) ruv;
143	if (ckWARN_d(WARN_OVERFLOW))
144	Perl_warner(aTHX_ WARN_OVERFLOW,
145	"Integer overflow in binary number");
146	}
147	else
148	ruv = xuv \| (*s - '0');
149	}
150	if (overflowed) {
151	rnv *= 2;
152	/* If an NV has not enough bits in its mantissa to
153	* represent an UV this summing of small low-order numbers
154	* is a waste of time (because the NV cannot preserve
155	* the low-order bits anyway): we could just remember when
156	* did we overflow and in the end just multiply rnv by the
157	* right amount. */
158	rnv += (*s - '0');
159	}
160	}
161	if (!overflowed)
162	rnv = (NV) ruv;
163	if ( ( overflowed && rnv > 4294967295.0)
164	#if UVSIZE > 4
165	\|\| (!overflowed && ruv > 0xffffffff )
166	#endif
167	) {
168	if (ckWARN(WARN_PORTABLE))
169	Perl_warner(aTHX_ WARN_PORTABLE,
170	"Binary number > 0b11111111111111111111111111111111 non-portable");
171	}
172	*retlen = s - start;
173	return rnv;
174	}
175
176	NV
177	Perl_scan_oct(pTHX_ char start, STRLEN len, STRLEN retlen)
178	{
179	register char *s = start;
180	register NV rnv = 0.0;
181	register UV ruv = 0;
182	register bool overflowed = FALSE;
183
184	for (; len-- && *s; s++) {
185	if (!(s >= '0' && s <= '7')) {
186	if (s == '_' && len && retlen
187	&& (s[1] >= '0' && s[1] <= '7'))
188	{
189	--len;
190	++s;
191	}
192	else {
193	/* Allow \octal to work the DWIM way (that is, stop scanning
194	* as soon as non-octal characters are seen, complain only iff
195	* someone seems to want to use the digits eight and nine). */
196	if (s == '8' \|\| s == '9') {
197	if (ckWARN(WARN_DIGIT))
198	Perl_warner(aTHX_ WARN_DIGIT,
199	"Illegal octal digit '%c' ignored", *s);
200	}
201	break;
202	}
203	}
204	if (!overflowed) {
205	register UV xuv = ruv << 3;
206
207	if ((xuv >> 3) != ruv) {
208	overflowed = TRUE;
209	rnv = (NV) ruv;
210	if (ckWARN_d(WARN_OVERFLOW))
211	Perl_warner(aTHX_ WARN_OVERFLOW,
212	"Integer overflow in octal number");
213	}
214	else
215	ruv = xuv \| (*s - '0');
216	}
217	if (overflowed) {
218	rnv *= 8.0;
219	/* If an NV has not enough bits in its mantissa to
220	* represent an UV this summing of small low-order numbers
221	* is a waste of time (because the NV cannot preserve
222	* the low-order bits anyway): we could just remember when
223	* did we overflow and in the end just multiply rnv by the
224	* right amount of 8-tuples. */
225	rnv += (NV)(*s - '0');
226	}
227	}
228	if (!overflowed)
229	rnv = (NV) ruv;
230	if ( ( overflowed && rnv > 4294967295.0)
231	#if UVSIZE > 4
232	\|\| (!overflowed && ruv > 0xffffffff )
233	#endif
234	) {
235	if (ckWARN(WARN_PORTABLE))
236	Perl_warner(aTHX_ WARN_PORTABLE,
237	"Octal number > 037777777777 non-portable");
238	}
239	*retlen = s - start;
240	return rnv;
241	}
242
243	NV
244	Perl_scan_hex(pTHX_ char start, STRLEN len, STRLEN retlen)
245	{
246	register char *s = start;
247	register NV rnv = 0.0;
248	register UV ruv = 0;
249	register bool overflowed = FALSE;
250	char *hexdigit;
251
252	if (len > 2) {
253	if (s[0] == 'x') {
254	s++;
255	len--;
256	}
257	else if (len > 3 && s[0] == '0' && s[1] == 'x') {
258	s+=2;
259	len-=2;
260	}
261	}
262
263	for (; len-- && *s; s++) {
264	hexdigit = strchr((char ) PL_hexdigit, s);
265	if (!hexdigit) {
266	if (s == '_' && len && retlen && s[1]
267	&& (hexdigit = strchr((char *) PL_hexdigit, s[1])))
268	{
269	--len;
270	++s;
271	}
272	else {
273	if (ckWARN(WARN_DIGIT))
274	Perl_warner(aTHX_ WARN_DIGIT,
275	"Illegal hexadecimal digit '%c' ignored", *s);
276	break;
277	}
278	}
279	if (!overflowed) {
280	register UV xuv = ruv << 4;
281
282	if ((xuv >> 4) != ruv) {
283	overflowed = TRUE;
284	rnv = (NV) ruv;
285	if (ckWARN_d(WARN_OVERFLOW))
286	Perl_warner(aTHX_ WARN_OVERFLOW,
287	"Integer overflow in hexadecimal number");
288	}
289	else
290	ruv = xuv \| ((hexdigit - PL_hexdigit) & 15);
291	}
292	if (overflowed) {
293	rnv *= 16.0;
294	/* If an NV has not enough bits in its mantissa to
295	* represent an UV this summing of small low-order numbers
296	* is a waste of time (because the NV cannot preserve
297	* the low-order bits anyway): we could just remember when
298	* did we overflow and in the end just multiply rnv by the
299	* right amount of 16-tuples. */
300	rnv += (NV)((hexdigit - PL_hexdigit) & 15);
301	}
302	}
303	if (!overflowed)
304	rnv = (NV) ruv;
305	if ( ( overflowed && rnv > 4294967295.0)
306	#if UVSIZE > 4
307	\|\| (!overflowed && ruv > 0xffffffff )
308	#endif
309	) {
310	if (ckWARN(WARN_PORTABLE))
311	Perl_warner(aTHX_ WARN_PORTABLE,
312	"Hexadecimal number > 0xffffffff non-portable");
313	}
314	*retlen = s - start;
315	return rnv;
316	}
317
318	/*
319	=for apidoc grok_numeric_radix
320
321	Scan and skip for a numeric decimal separator (radix).
322
323	=cut
324	*/
325	bool
326	Perl_grok_numeric_radix(pTHX_ const char *sp, const char send)
327	{
328	#ifdef USE_LOCALE_NUMERIC
329	if (PL_numeric_radix_sv && IN_LOCALE) {
330	STRLEN len;
331	char* radix = SvPV(PL_numeric_radix_sv, len);
332	if (sp + len <= send && memEQ(sp, radix, len)) {
333	*sp += len;
334	return TRUE;
335	}
336	}
337	/* always try "." if numeric radix didn't match because
338	* we may have data from different locales mixed */
339	#endif
340	if (sp < send && *sp == '.') {
341	++*sp;
342	return TRUE;
343	}
344	return FALSE;
345	}
346
347	/*
348	=for apidoc grok_number
349
350	Recognise (or not) a number. The type of the number is returned
351	(0 if unrecognised), otherwise it is a bit-ORed combination of
352	IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT,
aa8b85de	353	IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h).
60939fb8 NC	354
	355	If the value of the number can fit an in UV, it is returned in the *valuep
	356	IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV
	357	will never be set unless valuep is valid, but valuep may have been assigned
	358	to during processing even though IS_NUMBER_IN_UV is not set on return.
	359	If valuep is NULL, IS_NUMBER_IN_UV will be set for the same cases as when
	360	valuep is non-NULL, but no actual assignment (or SEGV) will occur.
	361
	362	IS_NUMBER_NOT_INT will be set with IS_NUMBER_IN_UV if trailing decimals were
	363	seen (in which case *valuep gives the true value truncated to an integer), and
	364	IS_NUMBER_NEG if the number is negative (in which case *valuep holds the
	365	absolute value). IS_NUMBER_IN_UV is not set if e notation was used or the
	366	number is larger than a UV.
98994639 HS	367
	368	=cut
	369	*/
	370	int
	371	Perl_grok_number(pTHX_ const char pv, STRLEN len, UV valuep)
	372	{
60939fb8 NC	373	const char *s = pv;
	374	const char *send = pv + len;
	375	const UV max_div_10 = UV_MAX / 10;
	376	const char max_mod_10 = UV_MAX % 10;
	377	int numtype = 0;
	378	int sawinf = 0;
aa8b85de	379	int sawnan = 0;
60939fb8 NC	380
	381	while (s < send && isSPACE(*s))
	382	s++;
	383	if (s == send) {
	384	return 0;
	385	} else if (*s == '-') {
	386	s++;
	387	numtype = IS_NUMBER_NEG;
	388	}
	389	else if (*s == '+')
	390	s++;
	391
	392	if (s == send)
	393	return 0;
	394
	395	/* next must be digit or the radix separator or beginning of infinity */
	396	if (isDIGIT(*s)) {
	397	/* UVs are at least 32 bits, so the first 9 decimal digits cannot
	398	overflow. */
	399	UV value = *s - '0';
	400	/* This construction seems to be more optimiser friendly.
	401	(without it gcc does the isDIGIT test and the *s - '0' separately)
	402	With it gcc on arm is managing 6 instructions (6 cycles) per digit.
	403	In theory the optimiser could deduce how far to unroll the loop
	404	before checking for overflow. */
58bb9ec3 NC	405	if (++s < send) {
58bb9ec3 NC	406	int digit = *s - '0';
60939fb8 NC	407	if (digit >= 0 && digit <= 9) {
60939fb8 NC	408	value = value * 10 + digit;
58bb9ec3 NC	409	if (++s < send) {
58bb9ec3 NC	410	digit = *s - '0';
60939fb8 NC	411	if (digit >= 0 && digit <= 9) {
60939fb8 NC	412	value = value * 10 + digit;
58bb9ec3 NC	413	if (++s < send) {
58bb9ec3 NC	414	digit = *s - '0';
60939fb8 NC	415	if (digit >= 0 && digit <= 9) {
60939fb8 NC	416	value = value * 10 + digit;
58bb9ec3 NC	417	if (++s < send) {
58bb9ec3 NC	418	digit = *s - '0';
60939fb8 NC	419	if (digit >= 0 && digit <= 9) {
60939fb8 NC	420	value = value * 10 + digit;
58bb9ec3 NC	421	if (++s < send) {
58bb9ec3 NC	422	digit = *s - '0';
60939fb8 NC	423	if (digit >= 0 && digit <= 9) {
60939fb8 NC	424	value = value * 10 + digit;
58bb9ec3 NC	425	if (++s < send) {
58bb9ec3 NC	426	digit = *s - '0';
60939fb8 NC	427	if (digit >= 0 && digit <= 9) {
60939fb8 NC	428	value = value * 10 + digit;
58bb9ec3 NC	429	if (++s < send) {
58bb9ec3 NC	430	digit = *s - '0';
60939fb8 NC	431	if (digit >= 0 && digit <= 9) {
60939fb8 NC	432	value = value * 10 + digit;
58bb9ec3 NC	433	if (++s < send) {
58bb9ec3 NC	434	digit = *s - '0';
60939fb8 NC	435	if (digit >= 0 && digit <= 9) {
60939fb8 NC	436	value = value * 10 + digit;
58bb9ec3	437	if (++s < send) {
60939fb8 NC	438	/* Now got 9 digits, so need to check
60939fb8 NC	439	each time for overflow. */
58bb9ec3	440	digit = *s - '0';
60939fb8 NC	441	while (digit >= 0 && digit <= 9
	442	&& (value < max_div_10
	443	\|\| (value == max_div_10
	444	&& digit <= max_mod_10))) {
	445	value = value * 10 + digit;
58bb9ec3 NC	446	if (++s < send)
58bb9ec3 NC	447	digit = *s - '0';
60939fb8 NC	448	else
	449	break;
	450	}
	451	if (digit >= 0 && digit <= 9
51bd16da	452	&& (s < send)) {
60939fb8 NC	453	/* value overflowed.
	454	skip the remaining digits, don't
	455	worry about setting valuep. /
	456	do {
	457	s++;
	458	} while (s < send && isDIGIT(*s));
	459	numtype \|=
	460	IS_NUMBER_GREATER_THAN_UV_MAX;
	461	goto skip_value;
	462	}
	463	}
	464	}
98994639	465	}
60939fb8 NC	466	}
	467	}
	468	}
	469	}
	470	}
	471	}
	472	}
	473	}
	474	}
	475	}
	476	}
98994639	477	}
60939fb8	478	}
98994639	479	}
60939fb8 NC	480	numtype \|= IS_NUMBER_IN_UV;
	481	if (valuep)
	482	*valuep = value;
	483
	484	skip_value:
	485	if (GROK_NUMERIC_RADIX(&s, send)) {
	486	numtype \|= IS_NUMBER_NOT_INT;
	487	while (s < send && isDIGIT(s)) / optional digits after the radix */
	488	s++;
98994639	489	}
60939fb8 NC	490	}
	491	else if (GROK_NUMERIC_RADIX(&s, send)) {
	492	numtype \|= IS_NUMBER_NOT_INT \| IS_NUMBER_IN_UV; /* valuep assigned below */
	493	/* no digits before the radix means we need digits after it */
	494	if (s < send && isDIGIT(*s)) {
	495	do {
	496	s++;
	497	} while (s < send && isDIGIT(*s));
	498	if (valuep) {
	499	/* integer approximation is valid - it's 0. */
	500	*valuep = 0;
	501	}
98994639	502	}
60939fb8 NC	503	else
	504	return 0;
	505	} else if (s == 'I' \|\| s == 'i') {
	506	s++; if (s == send \|\| (s != 'N' && s != 'n')) return 0;
	507	s++; if (s == send \|\| (s != 'F' && s != 'f')) return 0;
	508	s++; if (s < send && (s == 'I' \|\| s == 'i')) {
	509	s++; if (s == send \|\| (s != 'N' && s != 'n')) return 0;
	510	s++; if (s == send \|\| (s != 'I' && s != 'i')) return 0;
	511	s++; if (s == send \|\| (s != 'T' && s != 't')) return 0;
	512	s++; if (s == send \|\| (s != 'Y' && s != 'y')) return 0;
	513	s++;
98994639	514	}
60939fb8	515	sawinf = 1;
aa8b85de JH	516	} else if (s == 'N' \|\| s == 'n') {
	517	/* XXX TODO: There are signaling NaNs and quiet NaNs. */
	518	s++; if (s == send \|\| (s != 'A' && s != 'a')) return 0;
	519	s++; if (s == send \|\| (s != 'N' && s != 'n')) return 0;
	520	s++;
	521	sawnan = 1;
	522	} else
98994639	523	return 0;
60939fb8 NC	524
	525	if (sawinf) {
	526	numtype &= IS_NUMBER_NEG; /* Keep track of sign */
	527	numtype \|= IS_NUMBER_INFINITY \| IS_NUMBER_NOT_INT;
aa8b85de JH	528	} else if (sawnan) {
	529	numtype &= IS_NUMBER_NEG; /* Keep track of sign */
	530	numtype \|= IS_NUMBER_NAN \| IS_NUMBER_NOT_INT;
60939fb8 NC	531	} else if (s < send) {
	532	/* we can have an optional exponent part */
	533	if (s == 'e' \|\| s == 'E') {
	534	/* The only flag we keep is sign. Blow away any "it's UV" */
	535	numtype &= IS_NUMBER_NEG;
	536	numtype \|= IS_NUMBER_NOT_INT;
	537	s++;
	538	if (s < send && (s == '-' \|\| s == '+'))
	539	s++;
	540	if (s < send && isDIGIT(*s)) {
	541	do {
	542	s++;
	543	} while (s < send && isDIGIT(*s));
	544	}
	545	else
	546	return 0;
	547	}
	548	}
	549	while (s < send && isSPACE(*s))
	550	s++;
	551	if (s >= send)
aa8b85de	552	return numtype;
60939fb8 NC	553	if (len == 10 && memEQ(pv, "0 but true", 10)) {
	554	if (valuep)
	555	*valuep = 0;
	556	return IS_NUMBER_IN_UV;
	557	}
	558	return 0;
98994639 HS	559	}
	560
	561	NV
	562	S_mulexp10(NV value, I32 exponent)
	563	{
	564	NV result = 1.0;
	565	NV power = 10.0;
	566	bool negative = 0;
	567	I32 bit;
	568
	569	if (exponent == 0)
	570	return value;
	571	else if (exponent < 0) {
	572	negative = 1;
	573	exponent = -exponent;
	574	}
87032ba1	575
24866caa	576	/* On OpenVMS VAX we by default use the D_FLOAT double format,
67597c89	577	* and that format does not have easy capabilities [1] for
24866caa CB	578	* overflowing doubles 'silently' as IEEE fp does. We also need
	579	* to support G_FLOAT on both VAX and Alpha, and though the exponent
	580	* range is much larger than D_FLOAT it still doesn't do silent
	581	* overflow. Therefore we need to detect early whether we would
	582	* overflow (this is the behaviour of the native string-to-float
	583	* conversion routines, and therefore of native applications, too).
67597c89	584	*
24866caa CB	585	* [1] Trying to establish a condition handler to trap floating point
	586	* exceptions is not a good idea. */
	587	#if defined(VMS) && !defined(__IEEE_FP) && defined(NV_MAX_10_EXP)
67597c89	588	if (!negative &&
24866caa	589	(log10(value) + exponent) >= (NV_MAX_10_EXP))
67597c89	590	return NV_MAX;
67597c89	591	#endif
87032ba1 JH	592
	593	/* In UNICOS and in certain Cray models (such as T90) there is no
	594	* IEEE fp, and no way at all from C to catch fp overflows gracefully.
	595	* There is something you can do if you are willing to use some
	596	* inline assembler: the instruction is called DFI-- but that will
	597	* disable all floating point interrupts, a little bit too large
	598	* a hammer. Therefore we need to catch potential overflows before
	599	* it's too late. */
	600	#if defined(_UNICOS) && defined(NV_MAX_10_EXP)
	601	if (!negative &&
	602	(log10(value) + exponent) >= NV_MAX_10_EXP)
	603	return NV_MAX;
	604	#endif
	605
98994639 HS	606	for (bit = 1; exponent; bit <<= 1) {
	607	if (exponent & bit) {
	608	exponent ^= bit;
	609	result *= power;
	610	}
7014c407	611	/* Floating point exceptions are supposed to be turned off. */
98994639 HS	612	power *= power;
	613	}
	614	return negative ? value / result : value * result;
	615	}
	616
	617	NV
	618	Perl_my_atof(pTHX_ const char* s)
	619	{
	620	NV x = 0.0;
	621	#ifdef USE_LOCALE_NUMERIC
	622	if (PL_numeric_local && IN_LOCALE) {
	623	NV y;
	624
	625	/* Scan the number twice; once using locale and once without;
	626	* choose the larger result (in absolute value). */
	627	Perl_atof2(aTHX_ s, &x);
	628	SET_NUMERIC_STANDARD();
	629	Perl_atof2(aTHX_ s, &y);
	630	SET_NUMERIC_LOCAL();
	631	if ((y < 0.0 && y < x) \|\| (y > 0.0 && y > x))
	632	return y;
	633	}
	634	else
	635	Perl_atof2(aTHX_ s, &x);
	636	#else
	637	Perl_atof2(aTHX_ s, &x);
	638	#endif
	639	return x;
	640	}
	641
	642	char*
	643	Perl_my_atof2(pTHX_ const char* orig, NV* value)
	644	{
	645	NV result = 0.0;
	646	bool negative = 0;
	647	char* s = (char*)orig;
	648	char* send = s + strlen(orig) - 1;
	649	bool seendigit = 0;
	650	I32 expextra = 0;
	651	I32 exponent = 0;
	652	I32 i;
	653	/* this is arbitrary */
	654	#define PARTLIM 6
	655	/* we want the largest integers we can usefully use */
	656	#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
	657	# define PARTSIZE ((int)TYPE_DIGITS(U64)-1)
	658	U64 part[PARTLIM];
	659	#else
	660	# define PARTSIZE ((int)TYPE_DIGITS(U32)-1)
	661	U32 part[PARTLIM];
	662	#endif
	663	I32 ipart = 0; /* index into part[] */
	664	I32 offcount; /* number of digits in least significant part */
	665
96a05aee HS	666	/* leading whitespace */
	667	while (isSPACE(*s))
	668	++s;
	669
98994639 HS	670	/* sign */
	671	switch (*s) {
	672	case '-':
	673	negative = 1;
	674	/* fall through */
	675	case '+':
	676	++s;
	677	}
	678
	679	part[0] = offcount = 0;
	680	if (isDIGIT(*s)) {
	681	seendigit = 1; /* get this over with */
	682
	683	/* skip leading zeros */
	684	while (*s == '0')
	685	++s;
	686	}
	687
	688	/* integer digits */
	689	while (isDIGIT(*s)) {
	690	if (++offcount > PARTSIZE) {
	691	if (++ipart < PARTLIM) {
	692	part[ipart] = 0;
	693	offcount = 1; /* ++0 */
	694	}
	695	else {
	696	/* limits of precision reached */
	697	--ipart;
	698	--offcount;
	699	if (*s >= '5')
	700	++part[ipart];
	701	while (isDIGIT(*s)) {
	702	++expextra;
	703	++s;
	704	}
	705	/* warn of loss of precision? */
	706	break;
	707	}
	708	}
	709	part[ipart] = part[ipart] * 10 + (*s++ - '0');
	710	}
	711
	712	/* decimal point */
	713	if (GROK_NUMERIC_RADIX((const char **)&s, send)) {
	714	if (isDIGIT(*s))
	715	seendigit = 1; /* get this over with */
	716
	717	/* decimal digits */
	718	while (isDIGIT(*s)) {
	719	if (++offcount > PARTSIZE) {
	720	if (++ipart < PARTLIM) {
	721	part[ipart] = 0;
	722	offcount = 1; /* ++0 */
	723	}
	724	else {
	725	/* limits of precision reached */
	726	--ipart;
	727	--offcount;
	728	if (*s >= '5')
	729	++part[ipart];
	730	while (isDIGIT(*s))
	731	++s;
	732	/* warn of loss of precision? */
	733	break;
734	}
735	}
736	--expextra;
737	part[ipart] = part[ipart] * 10 + (*s++ - '0');
738	}
739	}
740
741	/* combine components of mantissa */
742	for (i = 0; i <= ipart; ++i)
743	result += S_mulexp10((NV)part[ipart - i],
744	i ? offcount + (i - 1) * PARTSIZE : 0);
745
746	if (seendigit && (s == 'e' \|\| s == 'E')) {
747	bool expnegative = 0;
748
749	++s;
750	switch (*s) {
751	case '-':
752	expnegative = 1;
753	/* fall through */
754	case '+':
755	++s;
756	}
757	while (isDIGIT(*s))
758	exponent = exponent * 10 + (*s++ - '0');
759	if (expnegative)
760	exponent = -exponent;
761	}
762
763	/* now apply the exponent */
764	exponent += expextra;
765	result = S_mulexp10(result, exponent);
766
767	/* now apply the sign */
768	if (negative)
769	result = -result;
770	*value = result;
771	return s;
772	}
773