[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;
    }
#ifdef __VAX /* avoid %SYSTEM-F-FLTOVF_F sans VAXC$ESTABLISH */
#  if defined(__DECC_VER) && __DECC_VER <= 50390006
    /* __F_FLT_MAX_10_EXP - 5 == 33 */
    if (!negative &&
          (log10(value) + exponent) >= (__F_FLT_MAX_10_EXP - 5))
        return NV_MAX;
#  endif
#endif
    for (bit = 1; exponent; bit <<= 1) {
	if (exponent & bit) {
	    exponent ^= bit;
	    result *= power;
	}
	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	}
a333faaf PP	575	#ifdef __VAX /* avoid %SYSTEM-F-FLTOVF_F sans VAXC$ESTABLISH */
	576	# if defined(__DECC_VER) && __DECC_VER <= 50390006
	577	/* __F_FLT_MAX_10_EXP - 5 == 33 */
	578	if (!negative &&
	579	(log10(value) + exponent) >= (__F_FLT_MAX_10_EXP - 5))
	580	return NV_MAX;
	581	# endif
	582	#endif
98994639 HS	583	for (bit = 1; exponent; bit <<= 1) {
	584	if (exponent & bit) {
	585	exponent ^= bit;
	586	result *= power;
	587	}
	588	power *= power;
	589	}
	590	return negative ? value / result : value * result;
	591	}
	592
	593	NV
	594	Perl_my_atof(pTHX_ const char* s)
	595	{
	596	NV x = 0.0;
	597	#ifdef USE_LOCALE_NUMERIC
	598	if (PL_numeric_local && IN_LOCALE) {
	599	NV y;
	600
	601	/* Scan the number twice; once using locale and once without;
	602	* choose the larger result (in absolute value). */
	603	Perl_atof2(aTHX_ s, &x);
	604	SET_NUMERIC_STANDARD();
	605	Perl_atof2(aTHX_ s, &y);
	606	SET_NUMERIC_LOCAL();
	607	if ((y < 0.0 && y < x) \|\| (y > 0.0 && y > x))
	608	return y;
	609	}
	610	else
	611	Perl_atof2(aTHX_ s, &x);
	612	#else
	613	Perl_atof2(aTHX_ s, &x);
	614	#endif
	615	return x;
	616	}
	617
	618	char*
	619	Perl_my_atof2(pTHX_ const char* orig, NV* value)
	620	{
	621	NV result = 0.0;
	622	bool negative = 0;
	623	char* s = (char*)orig;
	624	char* send = s + strlen(orig) - 1;
	625	bool seendigit = 0;
	626	I32 expextra = 0;
	627	I32 exponent = 0;
	628	I32 i;
	629	/* this is arbitrary */
	630	#define PARTLIM 6
	631	/* we want the largest integers we can usefully use */
	632	#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
	633	# define PARTSIZE ((int)TYPE_DIGITS(U64)-1)
	634	U64 part[PARTLIM];
	635	#else
	636	# define PARTSIZE ((int)TYPE_DIGITS(U32)-1)
	637	U32 part[PARTLIM];
	638	#endif
	639	I32 ipart = 0; /* index into part[] */
	640	I32 offcount; /* number of digits in least significant part */
	641
96a05aee HS	642	/* leading whitespace */
	643	while (isSPACE(*s))
	644	++s;
	645
98994639 HS	646	/* sign */
	647	switch (*s) {
	648	case '-':
	649	negative = 1;
	650	/* fall through */
	651	case '+':
	652	++s;
	653	}
	654
	655	part[0] = offcount = 0;
	656	if (isDIGIT(*s)) {
	657	seendigit = 1; /* get this over with */
	658
	659	/* skip leading zeros */
	660	while (*s == '0')
	661	++s;
	662	}
	663
	664	/* integer digits */
	665	while (isDIGIT(*s)) {
	666	if (++offcount > PARTSIZE) {
	667	if (++ipart < PARTLIM) {
	668	part[ipart] = 0;
	669	offcount = 1; /* ++0 */
	670	}
	671	else {
	672	/* limits of precision reached */
	673	--ipart;
	674	--offcount;
	675	if (*s >= '5')
	676	++part[ipart];
	677	while (isDIGIT(*s)) {
	678	++expextra;
	679	++s;
	680	}
	681	/* warn of loss of precision? */
	682	break;
	683	}
	684	}
	685	part[ipart] = part[ipart] * 10 + (*s++ - '0');
	686	}
	687
	688	/* decimal point */
	689	if (GROK_NUMERIC_RADIX((const char **)&s, send)) {
	690	if (isDIGIT(*s))
	691	seendigit = 1; /* get this over with */
	692
	693	/* decimal digits */
	694	while (isDIGIT(*s)) {
	695	if (++offcount > PARTSIZE) {
	696	if (++ipart < PARTLIM) {
	697	part[ipart] = 0;
	698	offcount = 1; /* ++0 */
	699	}
	700	else {
	701	/* limits of precision reached */
	702	--ipart;
	703	--offcount;
	704	if (*s >= '5')
	705	++part[ipart];
	706	while (isDIGIT(*s))
	707	++s;
	708	/* warn of loss of precision? */
	709	break;
710	}
711	}
712	--expextra;
713	part[ipart] = part[ipart] * 10 + (*s++ - '0');
714	}
715	}
716
717	/* combine components of mantissa */
718	for (i = 0; i <= ipart; ++i)
719	result += S_mulexp10((NV)part[ipart - i],
720	i ? offcount + (i - 1) * PARTSIZE : 0);
721
722	if (seendigit && (s == 'e' \|\| s == 'E')) {
723	bool expnegative = 0;
724
725	++s;
726	switch (*s) {
727	case '-':
728	expnegative = 1;
729	/* fall through */
730	case '+':
731	++s;
732	}
733	while (isDIGIT(*s))
734	exponent = exponent * 10 + (*s++ - '0');
735	if (expnegative)
736	exponent = -exponent;
737	}
738
739	/* now apply the exponent */
740	exponent += expextra;
741	result = S_mulexp10(result, exponent);
742
743	/* now apply the sign */
744	if (negative)
745	result = -result;
746	*value = result;
747	return s;
748	}
749