X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.c;h=18f8606bffd669b98605c3dbe6bb577ea442f9e9;hb=5f2d99664d8a6923d24892ffc0569f4e03e22edd;hp=fd4df1d026970aac457d2a3b7ac2fb9e92249fdb;hpb=4b711db359c9778a062571f88eafc4dab0b9c81d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.c b/perly.c index fd4df1d..18f8606 100644 --- a/perly.c +++ b/perly.c @@ -1,6 +1,6 @@ /* 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. @@ -89,17 +89,11 @@ do { \ YYFPRINTF Args; \ } while (0) -# define YYDSYMPRINT(Args) \ -do { \ - if (yydebug) \ - yysymprint Args; \ -} while (0) - # 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) @@ -109,7 +103,7 @@ do { \ `--------------------------------*/ static void -yysymprint (pTHX_ PerlIO *yyoutput, int yytype, const YYSTYPE *yyvaluep) +yysymprint(PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep) { if (yytype < YYNTOKENS) { YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); @@ -189,7 +183,6 @@ do { \ #else /* !DEBUGGING */ # define YYDPRINTF(Args) -# define YYDSYMPRINT(Args) # define YYDSYMPRINTF(Title, Token, Value) # define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns) # define YY_REDUCE_PRINT(Rule) @@ -250,6 +243,7 @@ yystpcpy (pTHX_ char *yydest, const char *yysrc) 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. */ @@ -302,6 +296,11 @@ Perl_yyparse (pTHX) rule. */ int yylen; +#ifdef PERL_MAD + if (PL_madskills) + return madparse(); +#endif + YYDPRINTF ((Perl_debug_log, "Starting parse\n")); ENTER; /* force stack free before we return */ @@ -310,8 +309,8 @@ Perl_yyparse (pTHX) 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)); + yyss_sv = newSV(YYINITDEPTH * sizeof(short)); + yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE)); SAVEFREESV(yyss_sv); SAVEFREESV(yyvs_sv); yyss = (short *) SvPVX(yyss_sv); @@ -320,7 +319,7 @@ Perl_yyparse (pTHX) yyssp = yyss; yyvsp = yyvs; #ifdef DEBUGGING - yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *)); + yyns_sv = newSV(YYINITDEPTH * sizeof(char *)); SAVEFREESV(yyns_sv); /* XXX This seems strange to cast char * to char ** */ yyns = (const char **) SvPVX(yyns_sv); @@ -409,7 +408,11 @@ Perl_yyparse (pTHX) /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((Perl_debug_log, "Reading a token: ")); +#ifdef PERL_MAD + yychar = PL_madskills ? madlex() : yylex(); +#else yychar = yylex(); +#endif # ifdef EBCDIC if (yychar >= 0 && yychar < 255) { yychar = NATIVE_TO_ASCII(yychar);