3 * Copyright (c) 2004, 2005, 2006, 2007, 2008,
4 * 2009, 2010, 2011 by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
9 * Note that this file was originally generated as an output from
10 * GNU bison version 1.875, but now the code is statically maintained
11 * and edited; the bits that are dependent on perly.y are now
12 * #included from the files perly.tab and perly.act.
14 * Here is an important copyright statement from the original, generated
17 * As a special exception, when this file is copied by Bison into a
18 * Bison output file, you may use that output file without
19 * restriction. This special exception was added by the Free
20 * Software Foundation in version 1.24 of Bison.
22 * Note that this file is also #included in madly.c, to allow compilation
23 * of a second parser, Perl_madparse, that is identical to Perl_yyparse,
24 * but which includes extra code for dumping the parse tree.
25 * This is controlled by the PERL_IN_MADLY_C define.
29 #define PERL_IN_PERLY_C
32 typedef unsigned char yytype_uint8;
33 typedef signed char yytype_int8;
34 typedef unsigned short int yytype_uint16;
35 typedef short int yytype_int16;
36 typedef signed char yysigned_char;
38 /* YYINITDEPTH -- initial size of the parser's stacks. */
39 #define YYINITDEPTH 200
47 /* contains all the parser state tables; auto-generated from perly.y */
50 # define YYSIZE_T size_t
55 #define YYACCEPT goto yyacceptlab
56 #define YYABORT goto yyabortlab
57 #define YYERROR goto yyerrlab1
59 /* Enable debugging if requested. */
62 # define yydebug (DEBUG_p_TEST)
64 # define YYFPRINTF PerlIO_printf
66 # define YYDPRINTF(Args) \
72 # define YYDSYMPRINTF(Title, Token, Value) \
75 YYFPRINTF (Perl_debug_log, "%s ", Title); \
76 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
77 YYFPRINTF (Perl_debug_log, "\n"); \
81 /*--------------------------------.
82 | Print this symbol on YYOUTPUT. |
83 `--------------------------------*/
86 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
88 if (yytype < YYNTOKENS) {
89 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
91 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
93 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
97 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
99 YYFPRINTF (yyoutput, ")");
104 * print the top 8 items on the parse stack.
108 yy_stack_print (pTHX_ const yy_parser *parser)
110 const yy_stack_frame *ps, *min;
112 min = parser->ps - 8 + 1;
113 if (min <= parser->stack)
114 min = parser->stack + 1;
116 PerlIO_printf(Perl_debug_log, "\nindex:");
117 for (ps = min; ps <= parser->ps; ps++)
118 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
120 PerlIO_printf(Perl_debug_log, "\nstate:");
121 for (ps = min; ps <= parser->ps; ps++)
122 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
124 PerlIO_printf(Perl_debug_log, "\ntoken:");
125 for (ps = min; ps <= parser->ps; ps++)
126 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
128 PerlIO_printf(Perl_debug_log, "\nvalue:");
129 for (ps = min; ps <= parser->ps; ps++) {
130 switch (yy_type_tab[yystos[ps->state]]) {
132 PerlIO_printf(Perl_debug_log, " %8.8s",
134 ? PL_op_name[ps->val.opval->op_type]
138 #ifndef PERL_IN_MADLY_C
139 case toketype_i_tkval:
142 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
145 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
148 PerlIO_printf(Perl_debug_log, "\n\n");
151 # define YY_STACK_PRINT(parser) \
153 if (yydebug && DEBUG_v_TEST) \
154 yy_stack_print (aTHX_ parser); \
158 /*------------------------------------------------.
159 | Report that the YYRULE is going to be reduced. |
160 `------------------------------------------------*/
163 yy_reduce_print (pTHX_ int yyrule)
166 const unsigned int yylineno = yyrline[yyrule];
167 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
168 yyrule - 1, yylineno);
169 /* Print the symbols being reduced, and their result. */
170 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
171 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
172 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
175 # define YY_REDUCE_PRINT(Rule) \
178 yy_reduce_print (aTHX_ Rule); \
181 #else /* !DEBUGGING */
182 # define YYDPRINTF(Args)
183 # define YYDSYMPRINTF(Title, Token, Value)
184 # define YY_STACK_PRINT(parser)
185 # define YY_REDUCE_PRINT(Rule)
186 #endif /* !DEBUGGING */
188 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
189 * parse stack, thus avoiding leaks if we die */
192 S_clear_yystack(pTHX_ const yy_parser *parser)
194 yy_stack_frame *ps = parser->ps;
200 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
202 /* Freeing ops on the stack, and the op_latefree / op_latefreed /
205 * When we pop tokens off the stack during error recovery, or when
206 * we pop all the tokens off the stack after a die during a shift or
207 * reduce (i.e. Perl_croak somewhere in yylex() or in one of the
208 * newFOO() functions), then it's possible that some of these tokens are
209 * of type opval, pointing to an OP. All these ops are orphans; each is
210 * its own miniature subtree that has not yet been attached to a
211 * larger tree. In this case, we should clearly free the op (making
212 * sure, for each op we free that we have PL_comppad pointing to the
213 * right place for freeing any SVs attached to the op in threaded
216 * However, there is a particular problem if we die in newFOO() called
217 * by a reducing action; e.g.
220 * { $$ = newFOO($1,$2,$3) }
223 * OP *newFOO { ....; if (...) croak; .... }
225 * In this case, when we come to clean bar baz and boz off the stack,
226 * we don't know whether newFOO() has already:
229 * * attached them to part of a larger tree
230 * * attached them to PL_compcv
231 * * attached them to PL_compcv then freed it (as in BEGIN {die } )
233 * To get round this problem, we set the flag op_latefree on every op
234 * that gets pushed onto the parser stack. If op_free() sees this
235 * flag, it clears the op and frees any children,, but *doesn't* free
236 * the op itself; instead it sets the op_latefreed flag. This means
237 * that we can safely call op_free() multiple times on each stack op.
238 * So, when clearing the stack, we first, for each op that was being
239 * reduced, call op_free with op_latefree=1. This ensures that all ops
240 * hanging off these op are freed, but the reducing ops themselves are
241 * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
242 * and free them. A little thought should convince you that this
243 * two-part approach to the reducing ops should handle the first three
244 * cases above safely.
246 * In the case of attaching to PL_compcv (currently just newATTRSUB
247 * does this), then we set the op_attached flag on the op that has
248 * been so attached, then avoid doing the final op_free during
249 * cleanup, on the assumption that it will happen (or has already
250 * happened) when PL_compcv is freed.
252 * Note this is fairly fragile mechanism. A more robust approach
253 * would be to use two of these flag bits as 2-bit reference count
254 * field for each op, indicating whether it is pointed to from:
258 * but this would involve reworking all code (core and external) that
259 * manipulate op trees.
261 * XXX DAPM 17/1/07 I've decided its too fragile for now, and so have
264 #define DISABLE_STACK_FREE
267 #ifdef DISABLE_STACK_FREE
268 for (i=0; i< parser->yylen; i++) {
269 SvREFCNT_dec(ps[-i].compcv);
273 /* clear any reducing ops (1st pass) */
275 for (i=0; i< parser->yylen; i++) {
276 LEAVE_SCOPE(ps[-i].savestack_ix);
277 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
278 && ps[-i].val.opval) {
279 if ( ! (ps[-i].val.opval->op_attached
280 && !ps[-i].val.opval->op_latefreed))
282 if (ps[-i].compcv != PL_compcv) {
283 PL_compcv = ps[-i].compcv;
284 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
286 op_free(ps[-i].val.opval);
292 /* now free whole the stack, including the just-reduced ops */
294 while (ps > parser->stack) {
295 LEAVE_SCOPE(ps->savestack_ix);
296 if (yy_type_tab[yystos[ps->state]] == toketype_opval
299 if (ps->compcv != PL_compcv) {
300 PL_compcv = ps->compcv;
301 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
303 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
304 #ifndef DISABLE_STACK_FREE
305 ps->val.opval->op_latefree = 0;
306 if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
308 op_free(ps->val.opval);
310 SvREFCNT_dec(ps->compcv);
314 Safefree(parser->stack);
323 #ifdef PERL_IN_MADLY_C
324 Perl_madparse (pTHX_ int gramtype)
326 Perl_yyparse (pTHX_ int gramtype)
330 register int yystate;
334 /* Lookahead token as an internal (translated) token number. */
337 register yy_parser *parser; /* the parser object */
338 register yy_stack_frame *ps; /* current parser stack frame */
340 #define YYPOPSTACK parser->ps = --ps
341 #define YYPUSHSTACK parser->ps = ++ps
343 /* The variable used to return semantic value and location from the
344 action routines: ie $$. */
347 #ifndef PERL_IN_MADLY_C
350 return madparse(gramtype);
354 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
358 ENTER; /* force parser state cleanup/restoration before we return */
359 SAVEPPTR(parser->yylval.pval);
360 SAVEINT(parser->yychar);
361 SAVEINT(parser->yyerrstatus);
362 SAVEINT(parser->stack_size);
363 SAVEINT(parser->yylen);
364 SAVEVPTR(parser->stack);
365 SAVEVPTR(parser->ps);
367 /* initialise state for this parse */
368 parser->yychar = gramtype;
369 parser->yyerrstatus = 0;
370 parser->stack_size = YYINITDEPTH;
372 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
373 ps = parser->ps = parser->stack;
375 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
377 /*------------------------------------------------------------.
378 | yynewstate -- Push a new state, which is found in yystate. |
379 `------------------------------------------------------------*/
384 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
386 #ifndef DISABLE_STACK_FREE
387 if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
388 ps->val.opval->op_latefree = 1;
389 ps->val.opval->op_latefreed = 0;
396 size_t size = ps - parser->stack + 1;
398 /* grow the stack? We always leave 1 spare slot,
399 * in case of a '' -> 'foo' reduction */
401 if (size >= (size_t)parser->stack_size - 1) {
402 /* this will croak on insufficient memory */
403 parser->stack_size *= 2;
404 Renew(parser->stack, parser->stack_size, yy_stack_frame);
405 ps = parser->ps = parser->stack + size -1;
407 YYDPRINTF((Perl_debug_log,
408 "parser stack size increased to %lu frames\n",
409 (unsigned long int)parser->stack_size));
413 /* Do appropriate processing given the current state. */
414 /* Read a lookahead token if we need one and don't already have one. */
416 /* First try to decide what to do without reference to lookahead token. */
418 yyn = yypact[yystate];
419 if (yyn == YYPACT_NINF)
422 /* Not known => get a lookahead token if don't already have one. */
424 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
425 if (parser->yychar == YYEMPTY) {
426 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
427 #ifdef PERL_IN_MADLY_C
428 parser->yychar = PL_madskills ? madlex() : yylex();
430 parser->yychar = yylex();
434 if (parser->yychar >= 0 && parser->yychar < 255) {
435 parser->yychar = NATIVE_TO_ASCII(parser->yychar);
440 if (parser->yychar <= YYEOF) {
441 parser->yychar = yytoken = YYEOF;
442 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
445 yytoken = YYTRANSLATE (parser->yychar);
446 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
449 /* If the proper action on seeing token YYTOKEN is to reduce or to
450 detect an error, take that action. */
452 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
456 if (yyn == 0 || yyn == YYTABLE_NINF)
465 /* Shift the lookahead token. */
466 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
468 /* Discard the token being shifted unless it is eof. */
469 if (parser->yychar != YYEOF)
470 parser->yychar = YYEMPTY;
474 ps->val = parser->yylval;
475 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
476 ps->savestack_ix = PL_savestack_ix;
478 ps->name = (const char *)(yytname[yytoken]);
481 /* Count tokens shifted since error; after three, turn off error
483 if (parser->yyerrstatus)
484 parser->yyerrstatus--;
489 /*-----------------------------------------------------------.
490 | yydefault -- do the default action for the current state. |
491 `-----------------------------------------------------------*/
493 yyn = yydefact[yystate];
499 /*-----------------------------.
500 | yyreduce -- Do a reduction. |
501 `-----------------------------*/
503 /* yyn is the number of a rule to reduce with. */
504 parser->yylen = yyr2[yyn];
506 /* If YYLEN is nonzero, implement the default value of the action:
509 Otherwise, the following line sets YYVAL to garbage.
510 This behavior is undocumented and Bison
511 users should not rely upon it. Assigning to YYVAL
512 unconditionally makes the parser a bit smaller, and it avoids a
513 GCC warning that YYVAL may be used uninitialized. */
514 yyval = ps[1-parser->yylen].val;
516 YY_STACK_PRINT(parser);
517 YY_REDUCE_PRINT (yyn);
522 #define dep() deprecate("\"do\" to call subroutines")
524 #ifdef PERL_IN_MADLY_C
525 # define IVAL(i) (i)->tk_lval.ival
526 # define PVAL(p) (p)->tk_lval.pval
527 # define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
528 # define TOKEN_FREE(a) token_free(a)
529 # define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
530 # define IF_MAD(a,b) (a)
536 # define TOKEN_GETMAD(a,b,c)
537 # define TOKEN_FREE(a)
538 # define OP_GETMAD(a,b,c)
539 # define IF_MAD(a,b) (b)
544 /* contains all the rule actions; auto-generated from perly.y */
549 /* any just-reduced ops with the op_latefreed flag cleared need to be
550 * freed; the rest need the flag resetting */
553 for (i=0; i< parser->yylen; i++) {
554 #ifndef DISABLE_STACK_FREE
555 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
558 ps[-i].val.opval->op_latefree = 0;
559 if (ps[-i].val.opval->op_latefreed)
560 op_free(ps[-i].val.opval);
563 SvREFCNT_dec(ps[-i].compcv);
567 parser->ps = ps -= (parser->yylen-1);
569 /* Now shift the result of the reduction. Determine what state
570 that goes to, based on the state we popped back to and the rule
571 number reduced by. */
574 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
575 ps->savestack_ix = PL_savestack_ix;
577 ps->name = (const char *)(yytname [yyr1[yyn]]);
582 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
583 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
584 yystate = yytable[yystate];
586 yystate = yydefgoto[yyn - YYNTOKENS];
592 /*------------------------------------.
593 | yyerrlab -- here on detecting error |
594 `------------------------------------*/
596 /* If not already recovering from an error, report this error. */
597 if (!parser->yyerrstatus) {
598 yyerror ("syntax error");
602 if (parser->yyerrstatus == 3) {
603 /* If just tried and failed to reuse lookahead token after an
604 error, discard it. */
606 /* Return failure if at end of input. */
607 if (parser->yychar == YYEOF) {
608 /* Pop the error token. */
609 SvREFCNT_dec(ps->compcv);
611 /* Pop the rest of the stack. */
612 while (ps > parser->stack) {
613 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
614 LEAVE_SCOPE(ps->savestack_ix);
615 if (yy_type_tab[yystos[ps->state]] == toketype_opval
618 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
619 if (ps->compcv != PL_compcv) {
620 PL_compcv = ps->compcv;
621 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
623 ps->val.opval->op_latefree = 0;
624 op_free(ps->val.opval);
626 SvREFCNT_dec(ps->compcv);
632 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
633 if (yy_type_tab[yytoken] == toketype_opval)
634 op_free(parser->yylval.opval);
635 parser->yychar = YYEMPTY;
639 /* Else will try to reuse lookahead token after shifting the error
644 /*----------------------------------------------------.
645 | yyerrlab1 -- error raised explicitly by an action. |
646 `----------------------------------------------------*/
648 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
651 yyn = yypact[yystate];
652 if (yyn != YYPACT_NINF) {
654 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
661 /* Pop the current state because it cannot handle the error token. */
662 if (ps == parser->stack)
665 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
666 LEAVE_SCOPE(ps->savestack_ix);
667 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
668 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
669 if (ps->compcv != PL_compcv) {
670 PL_compcv = ps->compcv;
671 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
673 ps->val.opval->op_latefree = 0;
674 op_free(ps->val.opval);
676 SvREFCNT_dec(ps->compcv);
680 YY_STACK_PRINT(parser);
686 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
690 ps->val = parser->yylval;
691 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
692 ps->savestack_ix = PL_savestack_ix;
700 /*-------------------------------------.
701 | yyacceptlab -- YYACCEPT comes here. |
702 `-------------------------------------*/
705 for (ps=parser->ps; ps > parser->stack; ps--) {
706 SvREFCNT_dec(ps->compcv);
708 parser->ps = parser->stack; /* disable cleanup */
711 /*-----------------------------------.
712 | yyabortlab -- YYABORT comes here. |
713 `-----------------------------------*/
719 LEAVE; /* force parser stack cleanup before we return */
725 * c-indentation-style: bsd
727 * indent-tabs-mode: nil
730 * ex: set ts=8 sts=4 sw=4 et: