/* perly.c
*
- * Copyright (c) 2004 Larry Wall
+ * Copyright (c) 2004, 2005, 2006 Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define YYTERROR 1
#define YYERRCODE 256
-/* YYLEX -- calling `yylex' with the right arguments. */
-
-# define YYLEX yylex_r (&yylval, &yychar)
-
/* Enable debugging if requested. */
-#if DEBUGGING
+#ifdef DEBUGGING
# define yydebug (DEBUG_p_TEST)
YYFPRINTF Args; \
} while (0)
-# define YYDSYMPRINT(Args) \
-do { \
- if (yydebug) \
- 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 (Perl_debug_log, Token, Value); \
YYFPRINTF (Perl_debug_log, "\n"); \
} \
} while (0)
`--------------------------------*/
static void
-yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
+yysymprint(PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
{
- /* Pacify ``unused variable'' warnings. */
- (void) yyvaluep;
-
if (yytype < YYNTOKENS) {
YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
# ifdef YYPRINT
YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+ YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
# endif
}
else
YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
- switch (yytype) {
- default:
- break;
- }
YYFPRINTF (yyoutput, ")");
}
-/*------------------------------------------------------------------.
-| 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_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const 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, " %8"UVxf, (UV)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)
yy_reduce_print (pTHX_ int yyrule)
{
int yyi;
- unsigned int yylineno = yyrline[yyrule];
+ const unsigned int yylineno = yyrline[yyrule];
YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
yyrule - 1, yylineno);
/* Print the symbols being reduced, and their result. */
#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 */
#endif /* !YYERROR_VERBOSE */
-
-/*-----------------------------------------------.
-| Release the memory associated to this symbol. |
-`-----------------------------------------------*/
-
-static void
-yydestruct (int yytype, YYSTYPE *yyvaluep)
-{
- /* Pacify ``unused variable'' warnings. */
- (void) yyvaluep;
-
- switch (yytype) {
- default:
- break;
- }
-}
-
-
-
-
/*----------.
| yyparse. |
`----------*/
int
Perl_yyparse (pTHX)
{
+ dVAR;
int yychar; /* The lookahead symbol. */
YYSTYPE yylval; /* The semantic value of the lookahead symbol. */
int yynerrs; /* Number of syntax errors so far. */
int yytoken = 0;
/* two stacks and their tools:
- `yyss': related to states,
- `yyvs': related to semantic values,
+ yyss: related to states,
+ yyvs: related to semantic values,
Refer to the stacks thru separate pointers, to allow yyoverflow
to reallocate them elsewhere. */
* 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 */
+ const char **yyns, **yynsp;
+ SV *yyns_sv;
+# define YYPOPSTACK (yyvsp--, yyssp--, yynsp--)
+#else
+# define YYPOPSTACK (yyvsp--, yyssp--)
+#endif
+
YYSIZE_T yystacksize = YYINITDEPTH;
rule. */
int yylen;
+#ifdef PERL_MAD
+ if (PL_madskills)
+ return madparse();
+#endif
+
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
+ 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(YYINITDEPTH * sizeof(short));
+ yyvs_sv = newSV(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(YYINITDEPTH * sizeof(char *));
+ SAVEFREESV(yyns_sv);
+ /* XXX This seems strange to cast char * to char ** */
+ yyns = (const 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;
if (yyss + yystacksize - 1 <= yyssp) {
/* Get the current used size of the three stacks, in elements. */
- YYSIZE_T yysize = yyssp - yyss + 1;
+ const YYSIZE_T yysize = yyssp - yyss + 1;
/* Extend the stack our own way. */
if (YYMAXDEPTH <= yystacksize)
SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
yyss = (short *) SvPVX(yyss_sv);
yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
+#ifdef DEBUGGING
+ SvGROW(yyns_sv, yystacksize * sizeof(char *));
+ /* XXX This seems strange to cast char * to char ** */
+ yyns = (const char **) SvPVX(yyns_sv);
+ if (! yyns)
+ goto yyoverflowlab;
+ yynsp = yyns + yysize - 1;
+#endif
if (!yyss || ! yyvs)
goto yyoverflowlab;
YYABORT;
}
- YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-
goto yybackup;
/*-----------.
/* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
if (yychar == YYEMPTY) {
YYDPRINTF ((Perl_debug_log, "Reading a token: "));
- yychar = YYLEX;
+#ifdef PERL_MAD
+ yychar = PL_madskills ? madlex() : yylex();
+#else
+ yychar = yylex();
+#endif
+# ifdef EBCDIC
+ if (yychar >= 0 && yychar < 255) {
+ yychar = NATIVE_TO_ASCII(yychar);
+ }
+# endif
}
if (yychar <= YYEOF) {
}
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
yychar = YYEMPTY;
*++yyvsp = yylval;
+#ifdef DEBUGGING
+ *++yynsp = (const char *)(yytname[yytoken]);
+#endif
/* Count tokens shifted since error; after three, turn off error
yyerrstatus--;
yystate = yyn;
+ YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
goto yynewstate;
yylen = yyr2[yyn];
/* If YYLEN is nonzero, implement the default value of the action:
- `$$ = $1'.
+ "$$ = $1".
Otherwise, the following line sets YYVAL to garbage.
This behavior is undocumented and Bison
yyvsp -= yylen;
yyssp -= yylen;
+#ifdef DEBUGGING
+ yynsp -= yylen;
+#endif
- YY_STACK_PRINT (yyss, yyssp);
*++yyvsp = yyval;
+#ifdef DEBUGGING
+ *++yynsp = (const char *)(yytname [yyr1[yyn]]);
+#endif
-
- /* Now `shift' the result of the reduction. Determine what state
+ /* Now shift the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
number reduced by. */
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;
if (YYPACT_NINF < yyn && yyn < YYLAST) {
YYSIZE_T yysize = 0;
- int yytype = YYTRANSLATE (yychar);
+ const int yytype = YYTRANSLATE (yychar);
char *yymsg;
int yyx, yycount;
yysize += yystrlen (yytname[yyx]) + 15, yycount++;
yysize += yystrlen ("syntax error, unexpected ") + 1;
yysize += yystrlen (yytname[yytype]);
- New(yymsg, yysize, char *);
+ Newx(yymsg, yysize, char *);
if (yymsg != 0) {
- char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+ const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
yyp = yystpcpy (yyp, yytname[yytype]);
if (yycount < 5) {
YYPOPSTACK;
/* Pop the rest of the stack. */
while (yyss < yyssp) {
- YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
- yydestruct (yystos[*yyssp], yyvsp);
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
YYPOPSTACK;
}
YYABORT;
}
- YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
- yydestruct (yytoken, &yylval);
+ YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
yychar = YYEMPTY;
}
if (yyssp == yyss)
YYABORT;
- YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
- yydestruct (yystos[yystate], yyvsp);
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
yyvsp--;
+#ifdef DEBUGGING
+ yynsp--;
+#endif
yystate = *--yyssp;
- YY_STACK_PRINT (yyss, yyssp);
+ YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
}
if (yyn == YYFINAL)
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;
yyreturn:
-#ifdef USE_ITHREADS
- LEAVE; /* force stack free before we return */
-#endif
+ LEAVE; /* force stack free before we return */
return yyresult;
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
https://perl5.git.perl.org / perl5.git / blobdiff