X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0aded6e1de0ffebe70e2ec9f995c5ca8a55617d4..bd9f0ebfcceb3f4cd93610fee8a3982e77d70277:/perly.c?ds=sidebyside diff --git a/perly.c b/perly.c index c8ee62f..5e5758a 100644 --- a/perly.c +++ b/perly.c @@ -1,6 +1,6 @@ /* perly.c * - * Copyright (c) 2004, 2005, 2006, 2007, by Larry Wall and others + * Copyright (c) 2004, 2005, 2006, 2007, 2008 by 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. @@ -34,6 +34,9 @@ typedef unsigned short int yytype_uint16; typedef short int yytype_int16; typedef signed char yysigned_char; +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#define YYINITDEPTH 200 + #ifdef DEBUGGING # define YYDEBUG 1 #else @@ -193,9 +196,9 @@ static void S_clear_yystack(pTHX_ const yy_parser *parser) { yy_stack_frame *ps = parser->ps; - int i; + int i = 0; - if (!parser->stack || ps == parser->stack) + if (!parser->stack) return; YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n")); @@ -238,7 +241,7 @@ S_clear_yystack(pTHX_ const yy_parser *parser) * that we can safely call op_free() multiple times on each stack op. * So, when clearing the stack, we first, for each op that was being * reduced, call op_free with op_latefree=1. This ensures that all ops - * hanging off these op are freed, but the reducing ops themselces are + * hanging off these op are freed, but the reducing ops themselves are * just undefed. Then we set op_latefreed=0 on *all* ops on the stack * and free them. A little thought should convince you that this * two-part approach to the reducing ops should handle the first three @@ -266,19 +269,23 @@ S_clear_yystack(pTHX_ const yy_parser *parser) #ifdef DISABLE_STACK_FREE + for (i=0; i< parser->yylen; i++) { + SvREFCNT_dec(ps[-i].compcv); + } ps -= parser->yylen; - PERL_UNUSED_VAR(i); #else /* clear any reducing ops (1st pass) */ for (i=0; i< parser->yylen; i++) { + LEAVE_SCOPE(ps[-i].savestack_ix); if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval && ps[-i].val.opval) { if ( ! (ps[-i].val.opval->op_attached && !ps[-i].val.opval->op_latefreed)) { - if (ps[-i].comppad != PL_comppad) { - PAD_RESTORE_LOCAL(ps[-i].comppad); + if (ps[-i].compcv != PL_compcv) { + PL_compcv = ps[-i].compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); } op_free(ps[-i].val.opval); } @@ -289,11 +296,13 @@ S_clear_yystack(pTHX_ const yy_parser *parser) /* now free whole the stack, including the just-reduced ops */ while (ps > parser->stack) { + LEAVE_SCOPE(ps->savestack_ix); if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) { - if (ps->comppad != PL_comppad) { - PAD_RESTORE_LOCAL(ps->comppad); + if (ps->compcv != PL_compcv) { + PL_compcv = ps->compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); } YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); #ifndef DISABLE_STACK_FREE @@ -302,24 +311,13 @@ S_clear_yystack(pTHX_ const yy_parser *parser) #endif op_free(ps->val.opval); } + SvREFCNT_dec(ps->compcv); ps--; } -} -/* delete a parser object */ - -#ifndef PERL_IN_MADLY_C -void -Perl_parser_free(pTHX_ const yy_parser *parser) -{ - S_clear_yystack(aTHX_ parser); Safefree(parser->stack); - Safefree(parser->lex_brackstack); - Safefree(parser->lex_casestack); - PL_parser = parser->old_parser; - Safefree(parser); } -#endif + /*----------. | yyparse. | @@ -327,9 +325,9 @@ Perl_parser_free(pTHX_ const yy_parser *parser) int #ifdef PERL_IN_MADLY_C -Perl_madparse (pTHX) +Perl_madparse (pTHX_ int gramtype) #else -Perl_yyparse (pTHX) +Perl_yyparse (pTHX_ int gramtype) #endif { dVAR; @@ -353,17 +351,32 @@ Perl_yyparse (pTHX) #ifndef PERL_IN_MADLY_C # ifdef PERL_MAD if (PL_madskills) - return madparse(); + return madparse(gramtype); # endif #endif YYDPRINTF ((Perl_debug_log, "Starting parse\n")); parser = PL_parser; - ps = parser->ps; - ENTER; /* force parser free before we return */ - SAVEPARSER(parser); + ENTER; /* force parser state cleanup/restoration before we return */ + SAVEPPTR(parser->yylval.pval); + SAVEINT(parser->yychar); + SAVEINT(parser->yyerrstatus); + SAVEINT(parser->stack_size); + SAVEINT(parser->yylen); + SAVEVPTR(parser->stack); + SAVEVPTR(parser->ps); + + /* initialise state for this parse */ + parser->yychar = gramtype; + parser->yyerrstatus = 0; + parser->stack_size = YYINITDEPTH; + parser->yylen = 0; + Newx(parser->stack, YYINITDEPTH, yy_stack_frame); + ps = parser->ps = parser->stack; + ps->state = 0; + SAVEDESTRUCTOR_X(S_clear_yystack, parser); /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | @@ -463,7 +476,8 @@ Perl_yyparse (pTHX) YYPUSHSTACK; ps->state = yyn; ps->val = parser->yylval; - ps->comppad = PL_comppad; + ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING ps->name = (const char *)(yytname[yytoken]); #endif @@ -536,12 +550,12 @@ Perl_yyparse (pTHX) } -#ifndef DISABLE_STACK_FREE /* any just-reduced ops with the op_latefreed flag cleared need to be * freed; the rest need the flag resetting */ { int i; for (i=0; i< parser->yylen; i++) { +#ifndef DISABLE_STACK_FREE if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval && ps[-i].val.opval) { @@ -549,9 +563,10 @@ Perl_yyparse (pTHX) if (ps[-i].val.opval->op_latefreed) op_free(ps[-i].val.opval); } +#endif + SvREFCNT_dec(ps[-i].compcv); } } -#endif parser->ps = ps -= (parser->yylen-1); @@ -560,7 +575,8 @@ Perl_yyparse (pTHX) number reduced by. */ ps->val = yyval; - ps->comppad = PL_comppad; + ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING ps->name = (const char *)(yytname [yyr1[yyn]]); #endif @@ -594,26 +610,32 @@ Perl_yyparse (pTHX) /* Return failure if at end of input. */ if (parser->yychar == YYEOF) { /* Pop the error token. */ + SvREFCNT_dec(ps->compcv); YYPOPSTACK; /* Pop the rest of the stack. */ while (ps > parser->stack) { YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val); + LEAVE_SCOPE(ps->savestack_ix); if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) { YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); - if (ps->comppad != PL_comppad) { - PAD_RESTORE_LOCAL(ps->comppad); + if (ps->compcv != PL_compcv) { + PL_compcv = ps->compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); } ps->val.opval->op_latefree = 0; op_free(ps->val.opval); } + SvREFCNT_dec(ps->compcv); YYPOPSTACK; } YYABORT; } YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval); + if (yy_type_tab[yytoken] == toketype_opval) + op_free(parser->yylval.opval); parser->yychar = YYEMPTY; } @@ -645,14 +667,17 @@ Perl_yyparse (pTHX) YYABORT; YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val); + LEAVE_SCOPE(ps->savestack_ix); if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) { YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); - if (ps->comppad != PL_comppad) { - PAD_RESTORE_LOCAL(ps->comppad); + if (ps->compcv != PL_compcv) { + PL_compcv = ps->compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); } ps->val.opval->op_latefree = 0; op_free(ps->val.opval); } + SvREFCNT_dec(ps->compcv); YYPOPSTACK; yystate = ps->state; @@ -667,7 +692,8 @@ Perl_yyparse (pTHX) YYPUSHSTACK; ps->state = yyn; ps->val = parser->yylval; - ps->comppad = PL_comppad; + ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING ps->name =""; #endif @@ -680,6 +706,9 @@ Perl_yyparse (pTHX) `-------------------------------------*/ yyacceptlab: yyresult = 0; + for (ps=parser->ps; ps > parser->stack; ps--) { + SvREFCNT_dec(ps->compcv); + } parser->ps = parser->stack; /* disable cleanup */ goto yyreturn; @@ -691,7 +720,7 @@ Perl_yyparse (pTHX) goto yyreturn; yyreturn: - LEAVE; /* force parser free before we return */ + LEAVE; /* force parser stack cleanup before we return */ return yyresult; }