One more run_byacc (a hand-tweaked version had slipped in).
[p5sagit/p5-mst-13.2.git] / util.c
diff --git a/util.c b/util.c
index c92bf87..70a1553 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4015,9 +4015,11 @@ Perl_my_atof(pTHX_ const char* s)
 {
     NV x = 0.0;
 #ifdef USE_LOCALE_NUMERIC
-    if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
+    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);
@@ -4036,30 +4038,222 @@ Perl_my_atof(pTHX_ const char* s)
 NV
 S_mulexp10(NV value, I32 exponent)
 {
-    NV result = value;
+    NV result = 1.0;
     NV power = 10.0;
+    bool negative = 0;
     I32 bit;
 
-    if (exponent > 0) {
-       for (bit = 1; exponent; bit <<= 1) {
-           if (exponent & bit) {
-               exponent ^= bit;
-               result *= power;
+    if (exponent == 0)
+       return value;
+    else if (exponent < 0) {
+       negative = 1;
+       exponent = -exponent;
+    }
+    for (bit = 1; exponent; bit <<= 1) {
+       if (exponent & bit) {
+           exponent ^= bit;
+           result *= power;
+       }
+       power *= power;
+    }
+    return negative ? value / result : value * result;
+}
+
+/*
+=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 (defined in perl.h).  If the value
+of the number can fit an in UV, it is returned in the *valuep.
+
+=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 + '0';
+    int numtype = 0;
+    int sawinf = 0;
+
+    while (isSPACE(*s))
+       s++;
+    if (*s == '-') {
+       s++;
+       numtype = IS_NUMBER_NEG;
+    }
+    else if (*s == '+')
+       s++;
+
+    /* 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.  */
+       int digit = *++s - '0';
+       if (digit >= 0 && digit <= 9) {
+           value = value * 10 + digit;
+           digit = *++s - '0';
+           if (digit >= 0 && digit <= 9) {
+               value = value * 10 + digit;
+               digit = *++s - '0';
+               if (digit >= 0 && digit <= 9) {
+                   value = value * 10 + digit;
+                   digit = *++s - '0';
+                   if (digit >= 0 && digit <= 9) {
+                       value = value * 10 + digit;
+                       digit = *++s - '0';
+                       if (digit >= 0 && digit <= 9) {
+                           value = value * 10 + digit;
+                           digit = *++s - '0';
+                           if (digit >= 0 && digit <= 9) {
+                               value = value * 10 + digit;
+                               digit = *++s - '0';
+                               if (digit >= 0 && digit <= 9) {
+                                   value = value * 10 + digit;
+                                   digit = *++s - '0';
+                                   if (digit >= 0 && digit <= 9) {
+                                       value = value * 10 + digit;
+                                       /* 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
+                                                      && *s <= max_mod_10))) {
+                                           value = value * 10 + digit;
+                                           digit = *++s - '0';
+                                       }
+                                       if (digit >= 0 && digit <= 9) {
+                                           /* value overflowed.
+                                              skip the remaining digits, don't
+                                              worry about setting *valuep.  */
+                                           do {
+                                               s++;
+                                           } while (isDIGIT(*s));
+                                           numtype |=
+                                               IS_NUMBER_GREATER_THAN_UV_MAX;
+                                           goto skip_value;
+                                       }
+                                   }
+                               }
+                           }
+                       }
+                   }
+               }
            }
-           power *= power;
+       }
+       numtype |= IS_NUMBER_IN_UV;
+       if (valuep)
+           *valuep = value;
+
+      skip_value:
+       if (GROK_NUMERIC_RADIX(&s, send)) {
+           numtype |= IS_NUMBER_NOT_INT;
+           while (isDIGIT(*s))  /* optional digits after the radix */
+               s++;
        }
     }
-    else if (exponent < 0) {
-       exponent = -exponent;
-       for (bit = 1; exponent; bit <<= 1) {
-           if (exponent & bit) {
-               exponent ^= bit;
-               result /= power;
+    else if (GROK_NUMERIC_RADIX(&s, send)) {
+        numtype |= IS_NUMBER_NOT_INT;
+       /* no digits before the radix means we need digits after it */
+       if (isDIGIT(*s)) {
+           do {
+               s++;
+           } while (isDIGIT(*s));
+           numtype |= IS_NUMBER_IN_UV;
+           if (valuep) {
+               /* integer approximation is valid - it's 0.  */
+               *valuep = 0;
            }
-           power *= power;
+       }
+       else
+           return 0;
+    }
+    else if (*s == 'I' || *s == 'i') {
+        s++; if (*s != 'N' && *s != 'n') return 0;
+       s++; if (*s != 'F' && *s != 'f') return 0;
+       s++; if (*s == 'I' || *s == 'i') {
+           s++; if (*s != 'N' && *s != 'n') return 0;
+           s++; if (*s != 'I' && *s != 'i') return 0;
+           s++; if (*s != 'T' && *s != 't') return 0;
+           s++; if (*s != 'Y' && *s != 'y') return 0;
+           s++;
+       }
+       sawinf = 1;
+    }
+    else /* Add test for NaN here.  */
+        return 0;
+
+    if (sawinf) {
+       numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
+       numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+    } else {
+       /* 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 == '-' || *s == '+')
+               s++;
+           if (isDIGIT(*s)) {
+               do {
+                   s++;
+               } while (isDIGIT(*s));
+           }
+           else
+               return 0;
        }
     }
-    return result;
+    while (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;
 }
 
 char*
@@ -4068,8 +4262,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     NV result = 0.0;
     bool negative = 0;
     char* s = (char*)orig;
-    char* point = "."; /* locale-dependent decimal point equivalent */
-    STRLEN pointlen = 1;
+    char* send = s + strlen(orig) - 1;
     bool seendigit = 0;
     I32 expextra = 0;
     I32 exponent = 0;
@@ -4087,9 +4280,6 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     I32 ipart = 0;     /* index into part[] */
     I32 offcount;      /* number of digits in least significant part */
 
-    if (PL_numeric_radix_sv)
-       point = SvPV(PL_numeric_radix_sv, pointlen);
-
     /* sign */
     switch (*s) {
        case '-':
@@ -4133,8 +4323,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     }
 
     /* decimal point */
-    if (memEQ(s, point, pointlen)) {
-       s += pointlen;
+    if (GROK_NUMERIC_RADIX((const char **)&s, send)) {
        if (isDIGIT(*s))
            seendigit = 1;      /* get this over with */
 
@@ -4636,7 +4825,7 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 #else
 
     if (PerlLIO_lstat(".", &statbuf) < 0) {
-        CWDXS_RETURN_SVUNDEF(sv);
+        SV_CWD_RETURN_UNDEF;
     }
 
     orig_cdev = statbuf.st_dev;
@@ -4672,7 +4861,7 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
             namelen = strlen(dp->d_name);
 #endif
             /* skip . and .. */
-            if (SV_CWD_ISDOT(dp)) {dp->d_name[0] == '.'
+            if (SV_CWD_ISDOT(dp)) {
                 continue;
             }
 
@@ -4896,3 +5085,4 @@ Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
     return FALSE;
 #endif
 }
+