X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.c;h=eff36d15950b440b44c01719c7ea46f894d2d4da;hb=17eef65c2fb9a95edf9064575d3413b4ec8219b7;hp=bf239fa0d48c7c754c2aa0d276bbaa52c8dd3caf;hpb=22735491a787756cfbfdb6b4e8124a882f0abd9a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.c b/perly.c index bf239fa..eff36d1 100644 --- a/perly.c +++ b/perly.c @@ -1,6 +1,6 @@ /* perly.c * - * Copyright (c) 2004, 2005, 2006 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. @@ -45,7 +45,6 @@ typedef signed char yysigned_char; # define YYSIZE_T size_t -#define YYEMPTY (-2) #define YYEOF 0 #define YYTERROR 1 @@ -112,7 +111,7 @@ yy_stack_print (pTHX_ const yy_parser *parser) PerlIO_printf(Perl_debug_log, "\nindex:"); for (ps = min; ps <= parser->ps; ps++) - PerlIO_printf(Perl_debug_log, " %8d", ps - parser->stack); + PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack)); PerlIO_printf(Perl_debug_log, "\nstate:"); for (ps = min; ps <= parser->ps; ps++) @@ -187,9 +186,6 @@ do { \ # define YY_REDUCE_PRINT(Rule) #endif /* !DEBUGGING */ -/* YYINITDEPTH -- initial size of the parser's stacks. */ -#define YYINITDEPTH 200 - /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the * parse stack, thus avoiding leaks if we die */ @@ -197,9 +193,9 @@ static void S_clear_yystack(pTHX_ const yy_parser *parser) { yy_stack_frame *ps = parser->ps; - int i; + int i = 0; - if (ps == parser->stack) + if (!parser->stack || ps == parser->stack) return; YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n")); @@ -262,11 +258,21 @@ S_clear_yystack(pTHX_ const yy_parser *parser) * * a CV * but this would involve reworking all code (core and external) that * manipulate op trees. - */ + * + * XXX DAPM 17/1/07 I've decided its too fragile for now, and so have + * disabled it */ + +#define DISABLE_STACK_FREE + +#ifdef DISABLE_STACK_FREE + 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 @@ -279,10 +285,12 @@ S_clear_yystack(pTHX_ const yy_parser *parser) } } } +#endif /* 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) { @@ -290,24 +298,16 @@ S_clear_yystack(pTHX_ const yy_parser *parser) PAD_RESTORE_LOCAL(ps->comppad); } YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); +#ifndef DISABLE_STACK_FREE ps->val.opval->op_latefree = 0; if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed)) +#endif op_free(ps->val.opval); } ps--; } } -/* delete a parser object */ - -static void -S_parser_free(pTHX_ const yy_parser *parser) -{ - S_clear_yystack(aTHX_ parser); - Safefree(parser->stack); - PL_parser = parser->old_parser; -} - /*----------. | yyparse. | @@ -334,7 +334,7 @@ Perl_yyparse (pTHX) #define YYPOPSTACK parser->ps = --ps #define YYPUSHSTACK parser->ps = ++ps - /* The variables used to return semantic value and location from the + /* The variable used to return semantic value and location from the action routines: ie $$. */ YYSTYPE yyval; @@ -347,22 +347,11 @@ Perl_yyparse (pTHX) YYDPRINTF ((Perl_debug_log, "Starting parse\n")); - Newx(parser, 1, yy_parser); - parser->old_parser = PL_parser; - PL_parser = parser; - - Newx(ps, YYINITDEPTH, yy_stack_frame); - parser->stack = ps; - parser->ps = ps; - parser->stack_size = YYINITDEPTH; + parser = PL_parser; + ps = parser->ps; - ENTER; /* force parser free before we return */ - SAVEDESTRUCTOR_X(S_parser_free, (void*) parser); - - - ps->state = 0; - parser->yyerrstatus = 0; - parser->yychar = YYEMPTY; /* Cause a token to be read. */ + ENTER; /* force parser stack cleanup before we return */ + SAVEDESTRUCTOR_X(S_clear_yystack, parser); /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | @@ -373,10 +362,12 @@ Perl_yyparse (pTHX) YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate)); +#ifndef DISABLE_STACK_FREE if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) { ps->val.opval->op_latefree = 1; ps->val.opval->op_latefreed = 0; } +#endif parser->yylen = 0; @@ -386,7 +377,7 @@ Perl_yyparse (pTHX) /* grow the stack? We always leave 1 spare slot, * in case of a '' -> 'foo' reduction */ - if (size >= parser->stack_size - 1) { + if (size >= (size_t)parser->stack_size - 1) { /* this will croak on insufficient memory */ parser->stack_size *= 2; Renew(parser->stack, parser->stack_size, yy_stack_frame); @@ -461,6 +452,7 @@ Perl_yyparse (pTHX) ps->state = yyn; ps->val = parser->yylval; ps->comppad = PL_comppad; + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING ps->name = (const char *)(yytname[yytoken]); #endif @@ -533,6 +525,7 @@ 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 */ { @@ -547,6 +540,7 @@ Perl_yyparse (pTHX) } } } +#endif parser->ps = ps -= (parser->yylen-1); @@ -556,6 +550,7 @@ Perl_yyparse (pTHX) ps->val = yyval; ps->comppad = PL_comppad; + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING ps->name = (const char *)(yytname [yyr1[yyn]]); #endif @@ -593,6 +588,7 @@ Perl_yyparse (pTHX) /* 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) { @@ -640,6 +636,7 @@ 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) { @@ -663,6 +660,7 @@ Perl_yyparse (pTHX) ps->state = yyn; ps->val = parser->yylval; ps->comppad = PL_comppad; + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING ps->name =""; #endif @@ -686,7 +684,7 @@ Perl_yyparse (pTHX) goto yyreturn; yyreturn: - LEAVE; /* force parser free before we return */ + LEAVE; /* force parser stack cleanup before we return */ return yyresult; }