From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 28 Feb 2004 22:37:08 +0000 (+0000)
Subject: make the bison-based parser threadsafe and capable of deep
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12fbd33b4c244f0a97c39c9f6411b444814dbc56;p=p5sagit%2Fp5-mst-13.2.git

make the bison-based parser threadsafe and capable of deep
recursion by eradicating Perl_yylex_r()

p4raw-id: //depot/perl@22408
---

diff --git a/embed.fnc b/embed.fnc
index 972d34d..75d9831 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -853,9 +853,6 @@ p	|void	|watch		|char** addr
 Ap	|I32	|whichsig	|char* sig
 p	|void	|write_to_stderr|const char* message|int msglen
 p	|int	|yyerror	|char* s
-#ifdef USE_PURE_BISON
-p	|int	|yylex_r	|YYSTYPE *lvalp|int *lcharp
-#endif
 p	|int	|yylex
 p	|int	|yyparse
 p	|int	|yywarn		|char* s
diff --git a/embed.h b/embed.h
index 66c1e09..187f2ea 100644
--- a/embed.h
+++ b/embed.h
@@ -1138,11 +1138,6 @@
 #ifdef PERL_CORE
 #define yyerror			Perl_yyerror
 #endif
-#ifdef USE_PURE_BISON
-#ifdef PERL_CORE
-#define yylex_r			Perl_yylex_r
-#endif
-#endif
 #ifdef PERL_CORE
 #define yylex			Perl_yylex
 #endif
@@ -3640,11 +3635,6 @@
 #ifdef PERL_CORE
 #define yyerror(a)		Perl_yyerror(aTHX_ a)
 #endif
-#ifdef USE_PURE_BISON
-#ifdef PERL_CORE
-#define yylex_r(a,b)		Perl_yylex_r(aTHX_ a,b)
-#endif
-#endif
 #ifdef PERL_CORE
 #define yylex()			Perl_yylex(aTHX)
 #endif
diff --git a/embedvar.h b/embedvar.h
index d8a874b..8db07af 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -457,6 +457,8 @@
 #define PL_xpvnv_root		(vTHX->Ixpvnv_root)
 #define PL_xrv_arenaroot	(vTHX->Ixrv_arenaroot)
 #define PL_xrv_root		(vTHX->Ixrv_root)
+#define PL_yycharp		(vTHX->Iyycharp)
+#define PL_yylvalp		(vTHX->Iyylvalp)
 
 #else	/* !MULTIPLICITY */
 
@@ -756,6 +758,8 @@
 #define PL_Ixpvnv_root		PL_xpvnv_root
 #define PL_Ixrv_arenaroot	PL_xrv_arenaroot
 #define PL_Ixrv_root		PL_xrv_root
+#define PL_Iyycharp		PL_yycharp
+#define PL_Iyylvalp		PL_yylvalp
 
 #define PL_TSv			PL_Sv
 #define PL_TXpv			PL_Xpv
diff --git a/intrpvar.h b/intrpvar.h
index c97b91e..065119d 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -396,6 +396,10 @@ PERLVARA(Ilast_swash_key,10,	U8)
 PERLVAR(Ilast_swash_tmps,	U8 *)
 PERLVAR(Ilast_swash_slen,	STRLEN)
 
+/* perly.c globals */
+PERLVAR(Iyycharp,	int *)
+PERLVAR(Iyylvalp,	YYSTYPE *)
+
 PERLVARI(Iglob_index,	int,	0)
 PERLVAR(Isrand_called,	bool)
 PERLVARA(Iuudmap,256,	char)
diff --git a/mg.c b/mg.c
index 9f3075d..340ab6a 100644
--- a/mg.c
+++ b/mg.c
@@ -566,9 +566,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
     case '\004':		/* ^D */
 	sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
-#if defined(YYDEBUG) && defined(DEBUGGING)
-	PL_yydebug = DEBUG_p_TEST;
-#endif
 	break;
     case '\005':  /* ^E */
 	 if (*(mg->mg_ptr+1) == '\0') {
diff --git a/perl.h b/perl.h
index ca0737c..3aec746 100644
--- a/perl.h
+++ b/perl.h
@@ -11,12 +11,6 @@
 #ifndef H_PERL
 #define H_PERL 1
 
-/* XXX DAPM tmp - always do this now - probably nedd to remove all trace
- * of the define at some pooint. Feb 04 */
-
-#define USE_PURE_BISON 1
-
-
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff.
diff --git a/perlapi.h b/perlapi.h
index f3051ac..d7eaf87 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -672,6 +672,10 @@ END_EXTERN_C
 #define PL_xrv_arenaroot	(*Perl_Ixrv_arenaroot_ptr(aTHX))
 #undef  PL_xrv_root
 #define PL_xrv_root		(*Perl_Ixrv_root_ptr(aTHX))
+#undef  PL_yycharp
+#define PL_yycharp		(*Perl_Iyycharp_ptr(aTHX))
+#undef  PL_yylvalp
+#define PL_yylvalp		(*Perl_Iyylvalp_ptr(aTHX))
 #undef  PL_Sv
 #define PL_Sv			(*Perl_TSv_ptr(aTHX))
 #undef  PL_Xpv
diff --git a/perly.c b/perly.c
index b18e202..2e8da75 100644
--- a/perly.c
+++ b/perly.c
@@ -76,10 +76,6 @@ while (0)
 #define YYTERROR	1
 #define YYERRCODE	256
 
-/* YYLEX -- calling `yylex' with the right arguments.  */
-
-# define YYLEX yylex_r (&yylval, &yychar)
-
 /* Enable debugging if requested.  */
 #ifdef DEBUGGING
 
@@ -335,11 +331,12 @@ Perl_yyparse (pTHX)
 
     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 
-#ifdef USE_ITHREADS
-    /* XXX is this needed anymore? DAPM 13-Feb-04;
-     * if not, delete the correspinding LEAVE too */
     ENTER;			/* force stack free before we return */
-#endif
+    SAVEVPTR(PL_yycharp);
+    SAVEVPTR(PL_yylvalp);
+    PL_yycharp = &yychar; /* so PL_yyerror() can access it */
+    PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
+
     yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
     yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
     SAVEFREESV(yyss_sv);
@@ -437,7 +434,12 @@ Perl_yyparse (pTHX)
     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
     if (yychar == YYEMPTY) {
 	YYDPRINTF ((Perl_debug_log, "Reading a token: "));
-	yychar = YYLEX;
+	yychar = yylex();
+#  ifdef EBCDIC
+	if (yychar >= 0 && yychar < 255) {
+	    yychar = NATIVE_TO_ASCII(yychar);
+	}
+#  endif
     }
 
     if (yychar <= YYEOF) {
@@ -722,9 +724,7 @@ Perl_yyparse (pTHX)
 
   yyreturn:
 
-#ifdef USE_ITHREADS
-	LEAVE;			/* force stack free before we return */
-#endif
+    LEAVE;			/* force stack free before we return */
 
     return yyresult;
 }
diff --git a/proto.h b/proto.h
index 8f3a2e0..ea084d8 100644
--- a/proto.h
+++ b/proto.h
@@ -815,9 +815,6 @@ PERL_CALLCONV void	Perl_watch(pTHX_ char** addr);
 PERL_CALLCONV I32	Perl_whichsig(pTHX_ char* sig);
 PERL_CALLCONV void	Perl_write_to_stderr(pTHX_ const char* message, int msglen);
 PERL_CALLCONV int	Perl_yyerror(pTHX_ char* s);
-#ifdef USE_PURE_BISON
-PERL_CALLCONV int	Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp);
-#endif
 PERL_CALLCONV int	Perl_yylex(pTHX);
 PERL_CALLCONV int	Perl_yyparse(pTHX);
 PERL_CALLCONV int	Perl_yywarn(pTHX_ char* s);
diff --git a/toke.c b/toke.c
index 627468c..a26c724 100644
--- a/toke.c
+++ b/toke.c
@@ -23,8 +23,8 @@
 #define PERL_IN_TOKE_C
 #include "perl.h"
 
-#define yychar	PL_yychar
-#define yylval	PL_yylval
+#define yychar	(*PL_yycharp)
+#define yylval	(*PL_yylvalp)
 
 static char ident_too_long[] = "Identifier too long";
 static char c_without_g[] = "Use of /c modifier is meaningless without /g";
@@ -79,22 +79,6 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #undef ff_next
 #endif
 
-#ifdef USE_PURE_BISON
-#  ifndef YYMAXLEVEL
-#    define YYMAXLEVEL 100
-#  endif
-YYSTYPE* yylval_pointer[YYMAXLEVEL];
-int* yychar_pointer[YYMAXLEVEL];
-int yyactlevel = -1;
-#  undef yylval
-#  undef yychar
-#  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_r(aTHX_ yylval_pointer[yyactlevel],yychar_pointer[yyactlevel])
-#endif
-
 #include "keywords.h"
 
 /* CLINE is a macro that ensures PL_copline has a sane value */
@@ -2176,31 +2160,6 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
       if we already built the token before, use it.
 */
 
-#ifdef USE_PURE_BISON
-int
-Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
-{
-    int r;
-
-    yyactlevel++;
-    yylval_pointer[yyactlevel] = lvalp;
-    yychar_pointer[yyactlevel] = lcharp;
-    if (yyactlevel >= YYMAXLEVEL)
-	Perl_croak(aTHX_ "panic: YYMAXLEVEL");
-
-    r = Perl_yylex(aTHX);
-#  ifdef EBCDIC
-    if (r >= 0 && r < 255) {
-	r = NATIVE_TO_ASCII(r);
-    }
-#  endif
-
-    if (yyactlevel > 0)
-       yyactlevel--;
-
-    return r;
-}
-#endif
 
 #ifdef __SC__
 #pragma segment Perl_yylex
@@ -7802,12 +7761,7 @@ Perl_yyerror(pTHX_ char *s)
     }
     else if (yychar > 255)
 	where = "next token ???";
-#ifdef USE_PURE_BISON
-/*  GNU Bison sets the value -2 */
-    else if (yychar == -2) {
-#else
-    else if ((yychar & 127) == 127) {
-#endif
+    else if (yychar == -2) { /* YYEMPTY */
 	if (PL_lex_state == LEX_NORMAL ||
 	   (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
 	    where = "at end of line";