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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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";