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

diff --git a/embed.h b/embed.h
index b73e25f..b4c8f6a 100644 (file)
--- 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 b403e57..e846cac 100755 (executable)
--- 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 39a13ba..9eb4175 100644 (file)
--- 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 d03d3de..2b5108f 100644 (file)
--- 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 5170b36..af0159e 100644 (file)
--- 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 eed9f70..59129b1 100644 (file)
--- 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 2f8f015..2ec1f8c 100644 (file)
--- 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;
 }