X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=32073a58420620d5502b857993d77b55bb0ad2c8;hb=a7ffa9b9a1a8caeff31a83d25b70b5aca6ba0d12;hp=98212010ec629df9523adc8eb2c50b8cf26b1fb2;hpb=d2f449dd43c68ee43aecff7e17640d02830ae584;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index 9821201..32073a5 100644
--- 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"
@@ -357,7 +361,6 @@ Perl_lex_start(pTHX_ SV *line)
 	    SAVEVPTR(PL_nextval[toke]);
 	}
 	SAVEI32(PL_nexttoke);
-	PL_nexttoke = 0;
     }
     SAVECOPLINE(PL_curcop);
     SAVEPPTR(PL_bufptr);
@@ -391,6 +394,7 @@ Perl_lex_start(pTHX_ SV *line)
     PL_lex_stuff = Nullsv;
     PL_lex_repl = Nullsv;
     PL_lex_inpat = 0;
+    PL_nexttoke = 0;
     PL_lex_inwhat = 0;
     PL_sublex_info.sub_inwhat = 0;
     PL_linestr = line;
@@ -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((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)
@@ -1305,9 +1308,11 @@ S_scan_const(pTHX_ char *start)
 		*d++ = *s++;
 	}
 
-	/* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
+	/* check for embedded arrays
+	   (@foo, @:foo, @'foo, @{foo}, @$foo, @+, @-)
+	   */
 	else if (*s == '@' && s[1]
-		 && (isALNUM_lazy_if(s+1,UTF) || strchr(":'{$", s[1])))
+		 && (isALNUM_lazy_if(s+1,UTF) || strchr(":'{$+-", s[1])))
 	    break;
 
 	/* check for embedded scalars.  only stop if we're sure it's a
@@ -1323,20 +1328,23 @@ S_scan_const(pTHX_ char *start)
 	/* (now in tr/// code again) */
 
 	if (*s & 0x80 && thisutf) {
-	   (void)utf8_to_uv((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 */
@@ -1392,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 */
@@ -1406,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:
@@ -1489,6 +1503,7 @@ S_scan_const(pTHX_ char *start)
 			char *ostart = SvPVX(sv);
 			SvCUR_set(sv, d - ostart);
 			SvPOK_on(sv);
+			*d = '\0';
 			sv_utf8_upgrade(sv);
 			/* this just broke our allocation above... */
 			SvGROW(sv, send - start);
@@ -1521,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;
 
@@ -2065,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;
@@ -2072,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 */
@@ -3519,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);
@@ -3589,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;> */
@@ -3600,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);
 		}
 	    }
@@ -6709,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 */
@@ -7122,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;
 }