view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

#endif

#if !defined(grok_bin) && defined(scan_bin)
static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
    NV r = scan_bin(string, *len, I32_CAST len);
    if (r > UV_MAX) {
        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
        if (result) *result = r;
        return UV_MAX;
    }
    return (UV)r;
}

#   define grok_bin(string, len, flags, result)     \
        _grok_bin((string), (len), (flags), (result))
#endif

#ifndef IN_LOCALE
#   define IN_LOCALE \
	(PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#endif

#ifndef IN_LOCALE_RUNTIME
#   define IN_LOCALE_RUNTIME   (PL_curcop->op_private & HINT_LOCALE)
#endif

#ifndef IN_LOCALE_COMPILETIME
#   define IN_LOCALE_COMPILETIME   (PL_hints & HINT_LOCALE)
#endif


#ifndef IS_NUMBER_IN_UV
#   define IS_NUMBER_IN_UV		            0x01   
#   define IS_NUMBER_GREATER_THAN_UV_MAX    0x02
#   define IS_NUMBER_NOT_INT	            0x04
#   define IS_NUMBER_NEG		            0x08
#   define IS_NUMBER_INFINITY	            0x10 
#   define IS_NUMBER_NAN                    0x20  
#endif
   
#ifndef grok_numeric_radix
#   define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)

#define grok_numeric_radix Perl_grok_numeric_radix
    
bool
Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
    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; 
        }
    }
#else
    /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
     * must manually be requested from locale.h */
#include <locale.h>
    struct lconv *lc = localeconv();
    char *radix = lc->decimal_point;
    if (radix && IN_LOCALE) { 
        STRLEN len = strlen(radix);
        if (*sp + len <= send && memEQ(*sp, radix, len)) {
            *sp += len;
            return TRUE; 
        }
    }
#endif /* PERL_VERSION */
#endif /* USE_LOCALE_NUMERIC */
    /* always try "." if numeric radix didn't match because
     * we may have data from different locales mixed */
    if (*sp < send && **sp == '.') {
        ++*sp;
        return TRUE;
    }
    return FALSE;
}
#endif /* grok_numeric_radix */

#ifndef grok_number

#define grok_number Perl_grok_number

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) {