Reëntrancy fix.

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

p4raw-id: //depot/perl@7381

4 files changed, 45 insertions, 12 deletions

diff --git a/embed.h b/embed.h
index 50a9d9e071..b73e25fdb4 100644
--- a/embed.h
+++ b/embed.h
@@ -749,6 +749,7 @@
 #else
 #define yylex			Perl_yylex
 #endif
+#define syylex			S_syylex
 #define yyparse			Perl_yyparse
 #define yywarn			Perl_yywarn
 #if defined(MYMALLOC)
@@ -2206,6 +2207,7 @@
 #else
 #define yylex()			Perl_yylex(aTHX)
 #endif
+#define syylex()		S_syylex(aTHX)
 #define yyparse()		Perl_yyparse(aTHX)
 #define yywarn(a)		Perl_yywarn(aTHX_ a)
 #if defined(MYMALLOC)
@@ -4325,6 +4327,8 @@
 #define Perl_yylex		CPerlObj::Perl_yylex
 #define yylex			Perl_yylex
 #endif
+#define S_syylex		CPerlObj::S_syylex
+#define syylex			S_syylex
 #define Perl_yyparse		CPerlObj::Perl_yyparse
 #define yyparse			Perl_yyparse
 #define Perl_yywarn		CPerlObj::Perl_yywarn
diff --git a/embed.pl b/embed.pl
index 9e05b1b984..b403e57a38 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2094,6 +2094,7 @@ p	|int	|yylex		|YYSTYPE *lvalp|int *lcharp
 #else
 p	|int	|yylex
 #endif
+sp	|int	|syylex
 p	|int	|yyparse
 p	|int	|yywarn		|char* s
 #if defined(MYMALLOC)
diff --git a/proto.h b/proto.h
index 1b3c2806b0..eed9f70cea 100644
--- a/proto.h
+++ b/proto.h
@@ -837,6 +837,7 @@ PERL_CALLCONV int	Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
 #else
 PERL_CALLCONV int	Perl_yylex(pTHX);
 #endif
+STATIC int	S_syylex(pTHX);
 PERL_CALLCONV int	Perl_yyparse(pTHX);
 PERL_CALLCONV int	Perl_yywarn(pTHX_ char* s);
 #if defined(MYMALLOC)
diff --git a/toke.c b/toke.c
index b3c667407c..2f8f015788 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"
@@ -2067,6 +2071,34 @@ Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
 Perl_yylex(pTHX)
 #endif
 {
+
+    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;
+#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;
@@ -2075,11 +2107,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 */