| /* perly.c |
| * |
| * Copyright (c) 2004, 2005, 2006, 2007, 2008, |
| * 2009, 2010, 2011 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. |
| * |
| * Note that this file was originally generated as an output from |
| * GNU bison version 1.875, but now the code is statically maintained |
| * and edited; the bits that are dependent on perly.y are now |
| * #included from the files perly.tab and perly.act. |
| * |
| * Here is an important copyright statement from the original, generated |
| * file: |
| * |
| * As a special exception, when this file is copied by Bison into a |
| * Bison output file, you may use that output file without |
| * restriction. This special exception was added by the Free |
| * Software Foundation in version 1.24 of Bison. |
| * |
| * Note that this file is also #included in madly.c, to allow compilation |
| * of a second parser, Perl_madparse, that is identical to Perl_yyparse, |
| * but which includes extra code for dumping the parse tree. |
| * This is controlled by the PERL_IN_MADLY_C define. |
| */ |
| |
| #include "EXTERN.h" |
| #define PERL_IN_PERLY_C |
| #include "perl.h" |
| |
| typedef unsigned char yytype_uint8; |
| typedef signed char yytype_int8; |
| 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 |
| # define YYDEBUG 0 |
| #endif |
| |
| /* contains all the parser state tables; auto-generated from perly.y */ |
| #include "perly.tab" |
| |
| # define YYSIZE_T size_t |
| |
| #define YYEOF 0 |
| #define YYTERROR 1 |
| |
| #define YYACCEPT goto yyacceptlab |
| #define YYABORT goto yyabortlab |
| #define YYERROR goto yyerrlab1 |
| |
| /* Enable debugging if requested. */ |
| #ifdef DEBUGGING |
| |
| # define yydebug (DEBUG_p_TEST) |
| |
| # define YYFPRINTF PerlIO_printf |
| |
| # define YYDPRINTF(Args) \ |
| do { \ |
| if (yydebug) \ |
| YYFPRINTF Args; \ |
| } while (0) |
| |
| # define YYDSYMPRINTF(Title, Token, Value) \ |
| do { \ |
| if (yydebug) { \ |
| YYFPRINTF (Perl_debug_log, "%s ", Title); \ |
| yysymprint (aTHX_ Perl_debug_log, Token, Value); \ |
| YYFPRINTF (Perl_debug_log, "\n"); \ |
| } \ |
| } while (0) |
| |
| /*--------------------------------. |
| | Print this symbol on YYOUTPUT. | |
| `--------------------------------*/ |
| |
| static void |
| yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const 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]); |
| |
| YYFPRINTF (yyoutput, ")"); |
| } |
| |
| |
| /* yy_stack_print() |
| * print the top 8 items on the parse stack. |
| */ |
| |
| static void |
| yy_stack_print (pTHX_ const yy_parser *parser) |
| { |
| const yy_stack_frame *ps, *min; |
| |
| min = parser->ps - 8 + 1; |
| if (min <= parser->stack) |
| min = parser->stack + 1; |
| |
| PerlIO_printf(Perl_debug_log, "\nindex:"); |
| for (ps = min; ps <= parser->ps; ps++) |
| PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack)); |
| |
| PerlIO_printf(Perl_debug_log, "\nstate:"); |
| for (ps = min; ps <= parser->ps; ps++) |
| PerlIO_printf(Perl_debug_log, " %8d", ps->state); |
| |
| PerlIO_printf(Perl_debug_log, "\ntoken:"); |
| for (ps = min; ps <= parser->ps; ps++) |
| PerlIO_printf(Perl_debug_log, " %8.8s", ps->name); |
| |
| PerlIO_printf(Perl_debug_log, "\nvalue:"); |
| for (ps = min; ps <= parser->ps; ps++) { |
| switch (yy_type_tab[yystos[ps->state]]) { |
| case toketype_opval: |
| PerlIO_printf(Perl_debug_log, " %8.8s", |
| ps->val.opval |
| ? PL_op_name[ps->val.opval->op_type] |
| : "(Nullop)" |
| ); |
| break; |
| #ifndef PERL_IN_MADLY_C |
| case toketype_i_tkval: |
| #endif |
| case toketype_ival: |
| PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival); |
| break; |
| default: |
| PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival); |
| } |
| } |
| PerlIO_printf(Perl_debug_log, "\n\n"); |
| } |
| |
| # define YY_STACK_PRINT(parser) \ |
| do { \ |
| if (yydebug && DEBUG_v_TEST) \ |
| yy_stack_print (aTHX_ parser); \ |
| } while (0) |
| |
| |
| /*------------------------------------------------. |
| | Report that the YYRULE is going to be reduced. | |
| `------------------------------------------------*/ |
| |
| static void |
| yy_reduce_print (pTHX_ int yyrule) |
| { |
| int yyi; |
| 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. */ |
| for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++) |
| YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]); |
| YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]); |
| } |
| |
| # define YY_REDUCE_PRINT(Rule) \ |
| do { \ |
| if (yydebug) \ |
| yy_reduce_print (aTHX_ Rule); \ |
| } while (0) |
| |
| #else /* !DEBUGGING */ |
| # define YYDPRINTF(Args) |
| # define YYDSYMPRINTF(Title, Token, Value) |
| # define YY_STACK_PRINT(parser) |
| # define YY_REDUCE_PRINT(Rule) |
| #endif /* !DEBUGGING */ |
| |
| /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the |
| * parse stack, thus avoiding leaks if we die */ |
| |
| static void |
| S_clear_yystack(pTHX_ const yy_parser *parser) |
| { |
| yy_stack_frame *ps = parser->ps; |
| int i = 0; |
| |
| if (!parser->stack) |
| return; |
| |
| YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n")); |
| |
| /* Freeing ops on the stack, and the op_latefree / op_latefreed / |
| * op_attached flags: |
| * |
| * When we pop tokens off the stack during error recovery, or when |
| * we pop all the tokens off the stack after a die during a shift or |
| * reduce (i.e. Perl_croak somewhere in yylex() or in one of the |
| * newFOO() functions), then it's possible that some of these tokens are |
| * of type opval, pointing to an OP. All these ops are orphans; each is |
| * its own miniature subtree that has not yet been attached to a |
| * larger tree. In this case, we should clearly free the op (making |
| * sure, for each op we free that we have PL_comppad pointing to the |
| * right place for freeing any SVs attached to the op in threaded |
| * builds. |
| * |
| * However, there is a particular problem if we die in newFOO() called |
| * by a reducing action; e.g. |
| * |
| * foo : bar baz boz |
| * { $$ = newFOO($1,$2,$3) } |
| * |
| * where |
| * OP *newFOO { ....; if (...) croak; .... } |
| * |
| * In this case, when we come to clean bar baz and boz off the stack, |
| * we don't know whether newFOO() has already: |
| * * freed them |
| * * left them as is |
| * * attached them to part of a larger tree |
| * * attached them to PL_compcv |
| * * attached them to PL_compcv then freed it (as in BEGIN {die } ) |
| * |
| * To get round this problem, we set the flag op_latefree on every op |
| * that gets pushed onto the parser stack. If op_free() sees this |
| * flag, it clears the op and frees any children,, but *doesn't* free |
| * the op itself; instead it sets the op_latefreed flag. This means |
| * 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 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 |
| * cases above safely. |
| * |
| * In the case of attaching to PL_compcv (currently just newATTRSUB |
| * does this), then we set the op_attached flag on the op that has |
| * been so attached, then avoid doing the final op_free during |
| * cleanup, on the assumption that it will happen (or has already |
| * happened) when PL_compcv is freed. |
| * |
| * Note this is fairly fragile mechanism. A more robust approach |
| * would be to use two of these flag bits as 2-bit reference count |
| * field for each op, indicating whether it is pointed to from: |
| * * a parent op |
| * * the parser stack |
| * * 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 |
| for (i=0; i< parser->yylen; i++) { |
| SvREFCNT_dec(ps[-i].compcv); |
| } |
| ps -= parser->yylen; |
| #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].compcv != PL_compcv) { |
| PL_compcv = ps[-i].compcv; |
| PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); |
| } |
| op_free(ps[-i].val.opval); |
| } |
| } |
| } |
| #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) |
| { |
| 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 |
| ps->val.opval->op_latefree = 0; |
| if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed)) |
| #endif |
| op_free(ps->val.opval); |
| } |
| SvREFCNT_dec(ps->compcv); |
| ps--; |
| } |
| |
| Safefree(parser->stack); |
| } |
| |
| |
| /*----------. |
| | yyparse. | |
| `----------*/ |
| |
| int |
| #ifdef PERL_IN_MADLY_C |
| Perl_madparse (pTHX_ int gramtype) |
| #else |
| Perl_yyparse (pTHX_ int gramtype) |
| #endif |
| { |
| dVAR; |
| register int yystate; |
| register int yyn; |
| int yyresult; |
| |
| /* Lookahead token as an internal (translated) token number. */ |
| int yytoken = 0; |
| |
| register yy_parser *parser; /* the parser object */ |
| register yy_stack_frame *ps; /* current parser stack frame */ |
| |
| #define YYPOPSTACK parser->ps = --ps |
| #define YYPUSHSTACK parser->ps = ++ps |
| |
| /* The variable used to return semantic value and location from the |
| action routines: ie $$. */ |
| YYSTYPE yyval; |
| |
| #ifndef PERL_IN_MADLY_C |
| # ifdef PERL_MAD |
| if (PL_madskills) |
| return madparse(gramtype); |
| # endif |
| #endif |
| |
| YYDPRINTF ((Perl_debug_log, "Starting parse\n")); |
| |
| parser = PL_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. | |
| `------------------------------------------------------------*/ |
| yynewstate: |
| |
| yystate = ps->state; |
| |
| 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; |
| |
| { |
| size_t size = ps - parser->stack + 1; |
| |
| /* grow the stack? We always leave 1 spare slot, |
| * in case of a '' -> 'foo' reduction */ |
| |
| 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); |
| ps = parser->ps = parser->stack + size -1; |
| |
| YYDPRINTF((Perl_debug_log, |
| "parser stack size increased to %lu frames\n", |
| (unsigned long int)parser->stack_size)); |
| } |
| } |
| |
| /* Do appropriate processing given the current state. */ |
| /* Read a lookahead token if we need one and don't already have one. */ |
| |
| /* First try to decide what to do without reference to lookahead token. */ |
| |
| yyn = yypact[yystate]; |
| if (yyn == YYPACT_NINF) |
| goto yydefault; |
| |
| /* Not known => get a lookahead token if don't already have one. */ |
| |
| /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ |
| if (parser->yychar == YYEMPTY) { |
| YYDPRINTF ((Perl_debug_log, "Reading a token: ")); |
| #ifdef PERL_IN_MADLY_C |
| parser->yychar = PL_madskills ? madlex() : yylex(); |
| #else |
| parser->yychar = yylex(); |
| #endif |
| |
| # ifdef EBCDIC |
| if (parser->yychar >= 0 && parser->yychar < 255) { |
| parser->yychar = NATIVE_TO_ASCII(parser->yychar); |
| } |
| # endif |
| } |
| |
| if (parser->yychar <= YYEOF) { |
| parser->yychar = yytoken = YYEOF; |
| YYDPRINTF ((Perl_debug_log, "Now at end of input.\n")); |
| } |
| else { |
| yytoken = YYTRANSLATE (parser->yychar); |
| YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval); |
| } |
| |
| /* If the proper action on seeing token YYTOKEN is to reduce or to |
| detect an error, take that action. */ |
| yyn += yytoken; |
| if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) |
| goto yydefault; |
| yyn = yytable[yyn]; |
| if (yyn <= 0) { |
| if (yyn == 0 || yyn == YYTABLE_NINF) |
| goto yyerrlab; |
| yyn = -yyn; |
| goto yyreduce; |
| } |
| |
| if (yyn == YYFINAL) |
| YYACCEPT; |
| |
| /* Shift the lookahead token. */ |
| YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken])); |
| |
| /* Discard the token being shifted unless it is eof. */ |
| if (parser->yychar != YYEOF) |
| parser->yychar = YYEMPTY; |
| |
| YYPUSHSTACK; |
| ps->state = yyn; |
| ps->val = parser->yylval; |
| ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); |
| ps->savestack_ix = PL_savestack_ix; |
| #ifdef DEBUGGING |
| ps->name = (const char *)(yytname[yytoken]); |
| #endif |
| |
| /* Count tokens shifted since error; after three, turn off error |
| status. */ |
| if (parser->yyerrstatus) |
| parser->yyerrstatus--; |
| |
| goto yynewstate; |
| |
| |
| /*-----------------------------------------------------------. |
| | yydefault -- do the default action for the current state. | |
| `-----------------------------------------------------------*/ |
| yydefault: |
| yyn = yydefact[yystate]; |
| if (yyn == 0) |
| goto yyerrlab; |
| goto yyreduce; |
| |
| |
| /*-----------------------------. |
| | yyreduce -- Do a reduction. | |
| `-----------------------------*/ |
| yyreduce: |
| /* yyn is the number of a rule to reduce with. */ |
| parser->yylen = yyr2[yyn]; |
| |
| /* If YYLEN is nonzero, implement the default value of the action: |
| "$$ = $1". |
| |
| Otherwise, the following line sets YYVAL to garbage. |
| This behavior is undocumented and Bison |
| users should not rely upon it. Assigning to YYVAL |
| unconditionally makes the parser a bit smaller, and it avoids a |
| GCC warning that YYVAL may be used uninitialized. */ |
| yyval = ps[1-parser->yylen].val; |
| |
| YY_STACK_PRINT(parser); |
| YY_REDUCE_PRINT (yyn); |
| |
| switch (yyn) { |
| |
| |
| #define dep() deprecate("\"do\" to call subroutines") |
| |
| #ifdef PERL_IN_MADLY_C |
| # define IVAL(i) (i)->tk_lval.ival |
| # define PVAL(p) (p)->tk_lval.pval |
| # define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c)) |
| # define TOKEN_FREE(a) token_free(a) |
| # define OP_GETMAD(a,b,c) op_getmad((a),(b),(c)) |
| # define IF_MAD(a,b) (a) |
| # define DO_MAD(a) a |
| # define MAD |
| #else |
| # define IVAL(i) (i) |
| # define PVAL(p) (p) |
| # define TOKEN_GETMAD(a,b,c) |
| # define TOKEN_FREE(a) |
| # define OP_GETMAD(a,b,c) |
| # define IF_MAD(a,b) (b) |
| # define DO_MAD(a) |
| # undef MAD |
| #endif |
| |
| /* contains all the rule actions; auto-generated from perly.y */ |
| #include "perly.act" |
| |
| } |
| |
| /* 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) |
| { |
| ps[-i].val.opval->op_latefree = 0; |
| if (ps[-i].val.opval->op_latefreed) |
| op_free(ps[-i].val.opval); |
| } |
| #endif |
| SvREFCNT_dec(ps[-i].compcv); |
| } |
| } |
| |
| parser->ps = ps -= (parser->yylen-1); |
| |
| /* 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. */ |
| |
| ps->val = yyval; |
| ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); |
| ps->savestack_ix = PL_savestack_ix; |
| #ifdef DEBUGGING |
| ps->name = (const char *)(yytname [yyr1[yyn]]); |
| #endif |
| |
| yyn = yyr1[yyn]; |
| |
| yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state; |
| if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state) |
| yystate = yytable[yystate]; |
| else |
| yystate = yydefgoto[yyn - YYNTOKENS]; |
| ps->state = yystate; |
| |
| goto yynewstate; |
| |
| |
| /*------------------------------------. |
| | yyerrlab -- here on detecting error | |
| `------------------------------------*/ |
| yyerrlab: |
| /* If not already recovering from an error, report this error. */ |
| if (!parser->yyerrstatus) { |
| yyerror ("syntax error"); |
| } |
| |
| |
| if (parser->yyerrstatus == 3) { |
| /* If just tried and failed to reuse lookahead token after an |
| error, discard it. */ |
| |
| /* 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->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; |
| |
| } |
| |
| /* Else will try to reuse lookahead token after shifting the error |
| token. */ |
| goto yyerrlab1; |
| |
| |
| /*----------------------------------------------------. |
| | yyerrlab1 -- error raised explicitly by an action. | |
| `----------------------------------------------------*/ |
| yyerrlab1: |
| parser->yyerrstatus = 3; /* Each real token shifted decrements this. */ |
| |
| for (;;) { |
| yyn = yypact[yystate]; |
| if (yyn != YYPACT_NINF) { |
| yyn += YYTERROR; |
| if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { |
| yyn = yytable[yyn]; |
| if (0 < yyn) |
| break; |
| } |
| } |
| |
| /* Pop the current state because it cannot handle the error token. */ |
| if (ps == parser->stack) |
| 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->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; |
| |
| YY_STACK_PRINT(parser); |
| } |
| |
| if (yyn == YYFINAL) |
| YYACCEPT; |
| |
| YYDPRINTF ((Perl_debug_log, "Shifting error token, ")); |
| |
| YYPUSHSTACK; |
| ps->state = yyn; |
| ps->val = parser->yylval; |
| ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); |
| ps->savestack_ix = PL_savestack_ix; |
| #ifdef DEBUGGING |
| ps->name ="<err>"; |
| #endif |
| |
| goto yynewstate; |
| |
| |
| /*-------------------------------------. |
| | yyacceptlab -- YYACCEPT comes here. | |
| `-------------------------------------*/ |
| yyacceptlab: |
| yyresult = 0; |
| for (ps=parser->ps; ps > parser->stack; ps--) { |
| SvREFCNT_dec(ps->compcv); |
| } |
| parser->ps = parser->stack; /* disable cleanup */ |
| goto yyreturn; |
| |
| /*-----------------------------------. |
| | yyabortlab -- YYABORT comes here. | |
| `-----------------------------------*/ |
| yyabortlab: |
| yyresult = 1; |
| goto yyreturn; |
| |
| yyreturn: |
| LEAVE; /* force parser stack cleanup 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: |
| */ |