Enable v (verbose) switch on -Dp to display the top 8 elements

on the parser stack at each reduce.  Also,

Subject: Re: switch from byacc to bison
From: "Craig A. Berry" <craigberry@mac.com>
Message-ID: <craigberry-8058A3.13264414022004@onion.develooper.com>

change #if DEBUGGING to #ifdef ... in perly.c

p4raw-id: //depot/perl@22305

diff --git a/perly.c b/perly.c
index 3a7e9bc..b18e202 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -81,7 +81,7 @@ while (0)
 # define YYLEX yylex_r (&yylval, &yychar)
 
 /* Enable debugging if requested.  */
-#if DEBUGGING
+#ifdef DEBUGGING
 
 #  define yydebug (DEBUG_p_TEST)
 
@@ -99,11 +99,11 @@ do {                                                \
        yysymprint Args;                        \
 } while (0)
 
-#  define YYDSYMPRINTF(Title, Token, Value, Location)          \
+#  define YYDSYMPRINTF(Title, Token, Value)                    \
 do {                                                           \
     if (yydebug) {                                             \
        YYFPRINTF (Perl_debug_log, "%s ", Title);               \
-       yysymprint (aTHX_ Perl_debug_log,  Token, Value);               \
+       yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
        YYFPRINTF (Perl_debug_log, "\n");                       \
     }                                                          \
 } while (0)
@@ -122,6 +122,8 @@ yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
        YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
 #   ifdef YYPRINT
        YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+#   else
+       YYFPRINTF (yyoutput, "0x%x", yyvaluep->ival);
 #   endif
     }
     else
@@ -135,24 +137,41 @@ yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
 }
 
 
-/*------------------------------------------------------------------.
-| yy_stack_print -- Print the state stack from its BOTTOM up to its |
-| TOP (cinluded).                                                   |
-`------------------------------------------------------------------*/
+/*  yy_stack_print()
+ *  print the top 8 items on the parse stack.  The args have the same
+ *  meanings as the local vars in yyparse() of the same name */
 
 static void
-yy_stack_print (pTHX_ short *bottom, short *top)
+yy_stack_print (pTHX_ short *yyss, short *yyssp, YYSTYPE *yyvs, char**yyns)
 {
-    YYFPRINTF (Perl_debug_log, "Stack now");
-    for (/* Nothing. */; bottom <= top; ++bottom)
-       YYFPRINTF (Perl_debug_log, " %d", *bottom);
-    YYFPRINTF (Perl_debug_log, "\n");
+    int i;
+    int start = 1;
+    int count = (int)(yyssp - yyss);
+
+    if (count > 8) {
+       start = count - 8 + 1;
+       count = 8;
+    }
+
+    PerlIO_printf(Perl_debug_log, "\nindex:");
+    for (i=0; i < count; i++)
+       PerlIO_printf(Perl_debug_log, " %8d", start+i);
+    PerlIO_printf(Perl_debug_log, "\nstate:");
+    for (i=0, yyss += start; i < count; i++, yyss++)
+       PerlIO_printf(Perl_debug_log, " %8d", *yyss);
+    PerlIO_printf(Perl_debug_log, "\ntoken:");
+    for (i=0, yyns += start; i < count; i++, yyns++)
+       PerlIO_printf(Perl_debug_log, " %8.8s", *yyns);
+    PerlIO_printf(Perl_debug_log, "\nvalue:");
+    for (i=0, yyvs += start; i < count; i++, yyvs++)
+       PerlIO_printf(Perl_debug_log, " %8x", yyvs->ival);
+    PerlIO_printf(Perl_debug_log, "\n\n");
 }
 
-#  define YY_STACK_PRINT(Bottom, Top)                          \
+#  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)              \
 do {                                                           \
-    if (yydebug)                                               \
-       yy_stack_print (aTHX_ (Bottom), (Top));                 \
+    if (yydebug && DEBUG_v_TEST)                               \
+       yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
 } while (0)
 
 
@@ -182,8 +201,8 @@ do {                                        \
 #else /* !DEBUGGING */
 #  define YYDPRINTF(Args)
 #  define YYDSYMPRINT(Args)
-#  define YYDSYMPRINTF(Title, Token, Value, Location)
-#  define YY_STACK_PRINT(Bottom, Top)
+#  define YYDSYMPRINTF(Title, Token, Value)
+#  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
 #  define YY_REDUCE_PRINT(Rule)
 #endif /* !DEBUGGING */
 
@@ -293,7 +312,15 @@ Perl_yyparse (pTHX)
       * SvPVX points to the stacks */
     SV *yyss_sv, *yyvs_sv;
 
-#define YYPOPSTACK   (yyvsp--, yyssp--)
+#ifdef DEBUGGING
+    /* maintain also a stack of token/rule names for debugging with -Dpv */
+    char **yyns, **yynsp;
+    SV *yyns_sv;
+#  define YYPOPSTACK   (yyvsp--, yyssp--, yynsp--)
+#else
+#  define YYPOPSTACK   (yyvsp--, yyssp--)
+#endif
+
 
     YYSIZE_T yystacksize = YYINITDEPTH;
 
@@ -308,30 +335,35 @@ Perl_yyparse (pTHX)
 
     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 
-    yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
-    yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
 #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
+    yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
+    yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
     SAVEFREESV(yyss_sv);
     SAVEFREESV(yyvs_sv);
     yyss = (short *) SvPVX(yyss_sv);
     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
+    /* note that elements zero of yyvs and yyns are not used */
+    yyssp = yyss;
+    yyvsp = yyvs;
+#ifdef DEBUGGING
+    yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
+    SAVEFREESV(yyns_sv);
+    yyns = (char **) SvPVX(yyns_sv);
+    yynsp = yyns;
+#endif
 
     yystate = 0;
     yyerrstatus = 0;
     yynerrs = 0;
     yychar = YYEMPTY;          /* Cause a token to be read.  */
 
-    /* Initialize stack pointers.
-         Waste one element of value and location stack
-         so that they stay on the same level as the state stack.
-         The wasted elements are never initialized.  */
 
-    yyssp = yyss;
-    yyvsp = yyvs;
+
+    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 
     goto yysetstate;
 
@@ -362,6 +394,13 @@ Perl_yyparse (pTHX)
         SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
         yyss = (short *) SvPVX(yyss_sv);
         yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
+#ifdef DEBUGGING
+        SvGROW(yyns_sv, yystacksize * sizeof(char *));
+        yyns = (char **) SvPVX(yyns_sv);
+        if (! yyns)
+              goto yyoverflowlab;
+        yynsp = yyns + yysize - 1;
+#endif
         if (!yyss || ! yyvs)
               goto yyoverflowlab;
 
@@ -376,8 +415,6 @@ Perl_yyparse (pTHX)
               YYABORT;
     }
 
-    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-
     goto yybackup;
 
   /*-----------.
@@ -409,7 +446,7 @@ Perl_yyparse (pTHX)
     }
     else {
        yytoken = YYTRANSLATE (yychar);
-       YYDSYMPRINTF ("Next token is", yytoken, &yylval, &yylloc);
+       YYDSYMPRINTF ("Next token is", yytoken, &yylval);
     }
 
     /* If the proper action on seeing token YYTOKEN is to reduce or to
@@ -436,6 +473,9 @@ Perl_yyparse (pTHX)
        yychar = YYEMPTY;
 
     *++yyvsp = yylval;
+#ifdef DEBUGGING
+    *++yynsp = (char *)(yytname[yytoken]);
+#endif
 
 
     /* Count tokens shifted since error; after three, turn off error
@@ -444,6 +484,8 @@ Perl_yyparse (pTHX)
        yyerrstatus--;
 
     yystate = yyn;
+    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
     goto yynewstate;
 
 
@@ -487,11 +529,15 @@ Perl_yyparse (pTHX)
 
     yyvsp -= yylen;
     yyssp -= yylen;
+#ifdef DEBUGGING
+    yynsp -= yylen;
+#endif
 
-    YY_STACK_PRINT (yyss, yyssp);
 
     *++yyvsp = yyval;
-
+#ifdef DEBUGGING
+    *++yynsp = (char *)(yytname [yyr1[yyn]]);
+#endif
 
     /* Now `shift' the result of the reduction.  Determine what state
          that goes to, based on the state we popped back to and the rule
@@ -505,6 +551,17 @@ Perl_yyparse (pTHX)
     else
        yystate = yydefgoto[yyn - YYNTOKENS];
 
+    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
+#ifdef DEBUGGING
+    /* tmp push yystate for stack print; this is normally pushed later in
+     * yynewstate */
+    yyssp++;
+    *yyssp = yystate;
+    YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
+    yyssp--;
+#endif
+
     goto yynewstate;
 
 
@@ -575,14 +632,14 @@ Perl_yyparse (pTHX)
            YYPOPSTACK;
            /* Pop the rest of the stack.  */
            while (yyss < yyssp) {
-               YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+               YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
                yydestruct (yystos[*yyssp], yyvsp);
                YYPOPSTACK;
            }
            YYABORT;
        }
 
-       YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
+       YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
        yydestruct (yytoken, &yylval);
        yychar = YYEMPTY;
 
@@ -614,12 +671,15 @@ Perl_yyparse (pTHX)
        if (yyssp == yyss)
            YYABORT;
 
-       YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
+       YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
        yydestruct (yystos[yystate], yyvsp);
        yyvsp--;
+#ifdef DEBUGGING
+       yynsp--;
+#endif
        yystate = *--yyssp;
 
-       YY_STACK_PRINT (yyss, yyssp);
+       YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
     }
 
     if (yyn == YYFINAL)
@@ -628,8 +688,13 @@ Perl_yyparse (pTHX)
     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 
     *++yyvsp = yylval;
+#ifdef DEBUGGING
+    *++yynsp ="<err>";
+#endif
 
     yystate = yyn;
+    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
     goto yynewstate;
 
 

diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 551bbcb..a6b90da 100644 (file)
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -367,7 +367,7 @@ the format of the output is explained in L<perldebguts>.
 As an alternative, specify a number instead of list of letters (e.g.,
 B<-D14> is equivalent to B<-Dtls>):
 
-        1  p  Tokenizing and parsing
+        1  p  Tokenizing and parsing (with v, displays parse stack)
         2  s  Stack snapshots
                 with v, displays all stacks
         4  l  Context (loop) stack processing