Check if stdio supports tweaking lval and cnt simultaneously.

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index b3c6674..32073a5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -80,15 +80,19 @@ static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
 #endif
 
 #ifdef USE_PURE_BISON
-YYSTYPE* yylval_pointer = NULL;
-int* yychar_pointer = NULL;
+#ifndef YYMAXLEVEL
+#define YYMAXLEVEL 100
+#endif
+YYSTYPE* yylval_pointer[YYMAXLEVEL];
+int* yychar_pointer[YYMAXLEVEL];
+int yyactlevel = 0;
 #  undef yylval
 #  undef yychar
-#  define yylval (*yylval_pointer)
-#  define yychar (*yychar_pointer)
-#  define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
-#  undef yylex
-#  define yylex()      Perl_yylex(aTHX_ yylval_pointer, yychar_pointer)
+#  define yylval (*yylval_pointer[yyactlevel])
+#  define yychar (*yychar_pointer[yyactlevel])
+#  define PERL_YYLEX_PARAM yylval_pointer[yyactlevel],yychar_pointer[yyactlevel]
+#  undef yylex 
+#  define yylex()      Perl_yylex(aTHX_ yylval_pointer[yyactlevel],yychar_pointer[yyactlevel])
 #endif
 
 #include "keywords.h"
@@ -809,10 +813,10 @@ Perl_str_to_version(pTHX_ SV *sv)
     bool utf = SvUTF8(sv) ? TRUE : FALSE;
     char *end = start + len;
     while (start < end) {
-       I32 skip;
+       STRLEN skip;
        UV n;
        if (utf)
-           n = utf8_to_uv_chk((U8*)start, &skip, 0);
+           n = utf8_to_uv_chk((U8*)start, len, &skip, 0);
        else {
            n = *(U8*)start;
            skip = 1;
@@ -844,7 +848,7 @@ S_force_version(pTHX_ char *s)
         for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
         if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
            SV *ver;
-            s = scan_num(s);
+            s = scan_num(s, &yylval);
             version = yylval.opval;
            ver = cSVOPx(version)->op_sv;
            if (SvPOK(ver) && !SvNIOK(ver)) {
@@ -1184,7 +1188,6 @@ S_scan_const(pTHX_ char *start)
     bool dorange = FALSE;                      /* are we in a translit range? */
     bool didrange = FALSE;                     /* did we just finish a range? */
     bool has_utf = FALSE;                      /* embedded \x{} */
-    I32 len;                                   /* ? */
     UV uv;
 
     I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
@@ -1325,20 +1328,23 @@ S_scan_const(pTHX_ char *start)
        /* (now in tr/// code again) */
 
        if (*s & 0x80 && thisutf) {
-          (void)utf8_to_uv_chk((U8*)s, &len, 0);
-          if (len == 1) {
-              /* illegal UTF8, make it valid */
-              char *old_pvx = SvPVX(sv);
-              /* need space for one extra char (NOTE: SvCUR() not set here) */
-              d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx);
-              d = (char*)uv_to_utf8((U8*)d, (U8)*s++);
-          }
-          else {
-              while (len--)
-                  *d++ = *s++;
-          }
-          has_utf = TRUE;
-          continue;
+           STRLEN len;
+           UV uv;
+
+           uv = utf8_to_uv_chk((U8*)s, send - s, &len, 1);
+           if (len == 1) {
+               /* illegal UTF8, make it valid */
+               char *old_pvx = SvPVX(sv);
+               /* need space for one extra char (NOTE: SvCUR() not set here) */
+               d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx);
+               d = (char*)uv_to_utf8((U8*)d, (U8)*s++);
+           }
+           else {
+               while (len--)
+                   *d++ = *s++;
+           }
+           has_utf = TRUE;
+           continue;
        }
 
        /* backslashes */
@@ -1394,9 +1400,11 @@ S_scan_const(pTHX_ char *start)
            /* \132 indicates an octal constant */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
-               len = 0;        /* disallow underscores */
-               uv = (UV)scan_oct(s, 3, &len);
-               s += len;
+               {
+                   STRLEN len = 0;     /* disallow underscores */
+                   uv = (UV)scan_oct(s, 3, &len);
+                   s += len;
+               }
                goto NUM_ESCAPE_INSERT;
 
            /* \x24 indicates a hex constant */
@@ -1408,14 +1416,18 @@ S_scan_const(pTHX_ char *start)
                        yyerror("Missing right brace on \\x{}");
                        e = s;
                    }
-                   len = 1;            /* allow underscores */
-                    uv = (UV)scan_hex(s + 1, e - s - 1, &len);
-                    s = e + 1;
+                   {
+                       STRLEN len = 1;         /* allow underscores */
+                       uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+                   }
+                   s = e + 1;
                }
                else {
-                   len = 0;            /* disallow underscores */
-                   uv = (UV)scan_hex(s, 2, &len);
-                   s += len;
+                   {
+                       STRLEN len = 0;         /* disallow underscores */
+                       uv = (UV)scan_hex(s, 2, &len);
+                       s += len;
+                   }
                }
 
              NUM_ESCAPE_INSERT:
@@ -1524,8 +1536,10 @@ S_scan_const(pTHX_ char *start)
                *d = toCTRL(*d); 
                d++;
 #else
-               len = *s++;
-               *d++ = toCTRL(len);
+               {
+                   U8 c = *s++;
+                   *d++ = toCTRL(c);
+               }
 #endif
                continue;
 
@@ -2068,6 +2082,29 @@ Perl_yylex(pTHX)
 #endif
 {
     dTHR;
+    int r;
+
+#ifdef USE_PURE_BISON
+    yylval_pointer[yyactlevel] = lvalp;
+    yychar_pointer[yyactlevel] = lcharp;
+    yyactlevel++;
+    if (yyactlevel >= YYMAXLEVEL)
+       Perl_croak(aTHX_ "panic: YYMAXLEVEL");
+#endif
+
+    r = S_syylex(aTHX);
+
+#ifdef USE_PURE_BISON
+    yyactlevel--;
+#endif
+
+    return r;
+}
+
+STATIC int
+S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
+{
+    dTHR;
     register char *s;
     register char *d;
     register I32 tmp;
@@ -2075,11 +2112,6 @@ Perl_yylex(pTHX)
     GV *gv = Nullgv;
     GV **gvp = 0;
 
-#ifdef USE_PURE_BISON
-    yylval_pointer = lvalp;
-    yychar_pointer = lcharp;
-#endif
-
     /* check if there's an identifier for us to look at */
     if (PL_pending_ident) {
         /* pit holds the identifier we read and pending_ident is reset */
@@ -3522,7 +3554,7 @@ Perl_yylex(pTHX)
        /* FALL THROUGH */
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
-       s = scan_num(s);
+       s = scan_num(s, &yylval);
        if (PL_expect == XOPERATOR)
            no_op("Number",s);
        TERM(THING);
@@ -3592,7 +3624,7 @@ Perl_yylex(pTHX)
            while (isDIGIT(*start) || *start == '_')
                start++;
            if (*start == '.' && isDIGIT(start[1])) {
-               s = scan_num(s);
+               s = scan_num(s, &yylval);
                TERM(THING);
            }
            /* avoid v123abc() or $h{v1}, allow C<print v10;> */
@@ -3603,7 +3635,7 @@ Perl_yylex(pTHX)
                gv = gv_fetchpv(s, FALSE, SVt_PVCV);
                *start = c;
                if (!gv) {
-                   s = scan_num(s);
+                   s = scan_num(s, &yylval);
                    TERM(THING);
                }
            }
@@ -6712,7 +6744,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 */
   
 char *
-Perl_scan_num(pTHX_ char *start)
+Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 {
     register char *s = start;          /* current position in buffer */
     register char *d;                  /* destination in temp buffer */
@@ -7125,9 +7157,9 @@ vstring:
     /* make the op for the constant and return */
 
     if (sv)
-       yylval.opval = newSVOP(OP_CONST, 0, sv);
+       lvalp->opval = newSVOP(OP_CONST, 0, sv);
     else
-       yylval.opval = Nullop;
+       lvalp->opval = Nullop;
 
     return s;
 }