Make scan_num() reëntrant, as suggested in

Subject: [PATCH perl@7229] Rentrant parser and yylex()
Message-ID: <5930DC161690D211966700902715754702DA09CD@madt009a.siemens.es>

p4raw-id: //depot/perl@7382

7 files changed, 18 insertions, 23 deletions

diff --git a/embed.h b/embed.h
index b73e25fdb4..b4c8f6ab35 100644
--- a/embed.h
+++ b/embed.h
@@ -2069,7 +2069,7 @@
 #define scalarvoid(a)		Perl_scalarvoid(aTHX_ a)
 #define scan_bin(a,b,c)		Perl_scan_bin(aTHX_ a,b,c)
 #define scan_hex(a,b,c)		Perl_scan_hex(aTHX_ a,b,c)
-#define scan_num(a)		Perl_scan_num(aTHX_ a)
+#define scan_num(a,b)		Perl_scan_num(aTHX_ a,b)
 #define scan_oct(a,b,c)		Perl_scan_oct(aTHX_ a,b,c)
 #define scope(a)		Perl_scope(aTHX_ a)
 #define screaminstr(a,b,c,d,e,f)	Perl_screaminstr(aTHX_ a,b,c,d,e,f)
diff --git a/embed.pl b/embed.pl
index b403e57a38..e846cac3f6 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1943,7 +1943,7 @@ p	|OP*	|scalarseq	|OP* o
 p	|OP*	|scalarvoid	|OP* o
 Ap	|NV	|scan_bin	|char* start|I32 len|I32* retlen
 Ap	|NV	|scan_hex	|char* start|I32 len|I32* retlen
-Ap	|char*	|scan_num	|char* s
+Ap	|char*	|scan_num	|char* s|YYSTYPE *lvalp
 Ap	|NV	|scan_oct	|char* start|I32 len|I32* retlen
 p	|OP*	|scope		|OP* o
 Ap	|char*	|screaminstr	|SV* bigsv|SV* littlesv|I32 start_shift \
diff --git a/perlapi.c b/perlapi.c
index 39a13ba60e..9eb4175051 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -2652,9 +2652,9 @@ Perl_scan_hex(pTHXo_ char* start, I32 len, I32* retlen)
 
 #undef  Perl_scan_num
 char*
-Perl_scan_num(pTHXo_ char* s)
+Perl_scan_num(pTHXo_ char* s, YYSTYPE *lvalp)
 {
-    return ((CPerlObj*)pPerl)->Perl_scan_num(s);
+    return ((CPerlObj*)pPerl)->Perl_scan_num(s, lvalp);
 }
 
 #undef  Perl_scan_oct
diff --git a/perly.c b/perly.c
index d03d3dee98..2b5108fac1 100644
--- a/perly.c
+++ b/perly.c
@@ -1747,7 +1747,7 @@ case 35:
 break;
 case 37:
 #line 269 "perly.y"
-{ (void)scan_num("1"); yyval.opval = yylval.opval; }
+{ (void)scan_num("1", &yylval); yyval.opval = yylval.opval; }
 break;
 case 39:
 #line 274 "perly.y"
diff --git a/perly.y b/perly.y
index 5170b365f3..af0159e721 100644
--- a/perly.y
+++ b/perly.y
@@ -266,7 +266,7 @@ nexpr	:	/* NULL */
 	;
 
 texpr	:	/* NULL means true */
-			{ (void)scan_num("1"); $$ = yylval.opval; }
+			{ (void)scan_num("1", &yylval); $$ = yylval.opval; }
 	|	expr
 	;
 
diff --git a/proto.h b/proto.h
index eed9f70cea..59129b1d00 100644
--- a/proto.h
+++ b/proto.h
@@ -679,7 +679,7 @@ PERL_CALLCONV OP*	Perl_scalarseq(pTHX_ OP* o);
 PERL_CALLCONV OP*	Perl_scalarvoid(pTHX_ OP* o);
 PERL_CALLCONV NV	Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen);
 PERL_CALLCONV NV	Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen);
-PERL_CALLCONV char*	Perl_scan_num(pTHX_ char* s);
+PERL_CALLCONV char*	Perl_scan_num(pTHX_ char* s, YYSTYPE *lvalp);
 PERL_CALLCONV NV	Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen);
 PERL_CALLCONV OP*	Perl_scope(pTHX_ OP* o);
 PERL_CALLCONV char*	Perl_screaminstr(pTHX_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last);
diff --git a/toke.c b/toke.c
index 2f8f015788..2ec1f8cb30 100644
--- a/toke.c
+++ b/toke.c
@@ -848,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)) {
@@ -2071,20 +2071,15 @@ Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
 Perl_yylex(pTHX)
 #endif
 {
-
+    dTHR;
     int r;
 
 #ifdef USE_PURE_BISON
-/* increment level and store the argument pointers */
-    yyactlevel++;
-    if (yyactlevel >= YYMAXLEVEL) {
-/* What to do ??? */
-    }
     yylval_pointer[yyactlevel] = lvalp;
     yychar_pointer[yyactlevel] = lcharp;
-    /* Save last pointer at the bottom */
-    yylval_pointer[0] = lvalp;
-    yychar_pointer[0] = lcharp;
+    yyactlevel++;
+    if (yyactlevel >= YYMAXLEVEL)
+	Perl_croak(aTHX_ "panic: YYMAXLEVEL");
 #endif
 
     r = S_syylex(aTHX);
@@ -3549,7 +3544,7 @@ S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
 	/* 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);
@@ -3619,7 +3614,7 @@ S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
 	    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;> */
@@ -3630,7 +3625,7 @@ S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
 		gv = gv_fetchpv(s, FALSE, SVt_PVCV);
 		*start = c;
 		if (!gv) {
-		    s = scan_num(s);
+		    s = scan_num(s, &yylval);
 		    TERM(THING);
 		}
 	    }
@@ -6739,7 +6734,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 */
@@ -7152,9 +7147,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;
 }