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
54 /* contains all the parser state tables; auto-generated from perly.y */
57 # define YYSIZE_T size_t
62 #define YYACCEPT goto yyacceptlab
63 #define YYABORT goto yyabortlab
64 #define YYERROR goto yyerrlab1
66 /* Enable debugging if requested. */
69 # define yydebug (DEBUG_p_TEST)
71 # define YYFPRINTF PerlIO_printf
73 # define YYDPRINTF(Args) \
79 # define YYDSYMPRINTF(Title, Token, Value) \
82 YYFPRINTF (Perl_debug_log, "%s ", Title); \
83 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
84 YYFPRINTF (Perl_debug_log, "\n"); \
88 /*--------------------------------.
89 | Print this symbol on YYOUTPUT. |
90 `--------------------------------*/
93 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
95 if (yytype < YYNTOKENS) {
96 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
98 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
100 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
104 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
106 YYFPRINTF (yyoutput, ")");
111 * print the top 8 items on the parse stack.
115 yy_stack_print (pTHX_ const yy_parser *parser)
117 const yy_stack_frame *ps, *min;
119 min = parser->ps - 8 + 1;
120 if (min <= parser->stack)
121 min = parser->stack + 1;
123 PerlIO_printf(Perl_debug_log, "\nindex:");
124 for (ps = min; ps <= parser->ps; ps++)
125 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
127 PerlIO_printf(Perl_debug_log, "\nstate:");
128 for (ps = min; ps <= parser->ps; ps++)
129 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
131 PerlIO_printf(Perl_debug_log, "\ntoken:");
132 for (ps = min; ps <= parser->ps; ps++)
133 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
135 PerlIO_printf(Perl_debug_log, "\nvalue:");
136 for (ps = min; ps <= parser->ps; ps++) {
137 switch (yy_type_tab[yystos[ps->state]]) {
139 PerlIO_printf(Perl_debug_log, " %8.8s",
141 ? PL_op_name[ps->val.opval->op_type]
145 #ifndef PERL_IN_MADLY_C
146 case toketype_i_tkval:
149 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
152 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
155 PerlIO_printf(Perl_debug_log, "\n\n");
158 # define YY_STACK_PRINT(parser) \
160 if (yydebug && DEBUG_v_TEST) \
161 yy_stack_print (aTHX_ parser); \
165 /*------------------------------------------------.
166 | Report that the YYRULE is going to be reduced. |
167 `------------------------------------------------*/
170 yy_reduce_print (pTHX_ int yyrule)
173 const unsigned int yylineno = yyrline[yyrule];
174 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
175 yyrule - 1, yylineno);
176 /* Print the symbols being reduced, and their result. */
177 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
178 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
179 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
182 # define YY_REDUCE_PRINT(Rule) \
185 yy_reduce_print (aTHX_ Rule); \
188 #else /* !DEBUGGING */
189 # define YYDPRINTF(Args)
190 # define YYDSYMPRINTF(Title, Token, Value)
191 # define YY_STACK_PRINT(parser)
192 # define YY_REDUCE_PRINT(Rule)
193 #endif /* !DEBUGGING */
195 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
196 * parse stack, thus avoiding leaks if we die */
199 S_clear_yystack(pTHX_ const yy_parser *parser)
201 yy_stack_frame *ps = parser->ps;
207 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
209 for (i=0; i< parser->yylen; i++) {
210 SvREFCNT_dec(ps[-i].compcv);
214 /* now free whole the stack, including the just-reduced ops */
216 while (ps > parser->stack) {
217 LEAVE_SCOPE(ps->savestack_ix);
218 if (yy_type_tab[yystos[ps->state]] == toketype_opval
221 if (ps->compcv != PL_compcv) {
222 PL_compcv = ps->compcv;
223 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
224 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
226 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
227 op_free(ps->val.opval);
229 SvREFCNT_dec(ps->compcv);
233 Safefree(parser->stack);
242 #ifdef PERL_IN_MADLY_C
243 Perl_madparse (pTHX_ int gramtype)
245 Perl_yyparse (pTHX_ int gramtype)
253 /* Lookahead token as an internal (translated) token number. */
256 yy_parser *parser; /* the parser object */
257 yy_stack_frame *ps; /* current parser stack frame */
259 #define YYPOPSTACK parser->ps = --ps
260 #define YYPUSHSTACK parser->ps = ++ps
262 /* The variable used to return semantic value and location from the
263 action routines: ie $$. */
266 #ifndef PERL_IN_MADLY_C
269 return madparse(gramtype);
273 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
277 ENTER; /* force parser state cleanup/restoration before we return */
278 SAVEPPTR(parser->yylval.pval);
279 SAVEINT(parser->yychar);
280 SAVEINT(parser->yyerrstatus);
281 SAVEINT(parser->stack_size);
282 SAVEINT(parser->yylen);
283 SAVEVPTR(parser->stack);
284 SAVEVPTR(parser->ps);
286 /* initialise state for this parse */
287 parser->yychar = gramtype;
288 parser->yyerrstatus = 0;
289 parser->stack_size = YYINITDEPTH;
291 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
292 ps = parser->ps = parser->stack;
294 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
296 /*------------------------------------------------------------.
297 | yynewstate -- Push a new state, which is found in yystate. |
298 `------------------------------------------------------------*/
303 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
308 size_t size = ps - parser->stack + 1;
310 /* grow the stack? We always leave 1 spare slot,
311 * in case of a '' -> 'foo' reduction */
313 if (size >= (size_t)parser->stack_size - 1) {
314 /* this will croak on insufficient memory */
315 parser->stack_size *= 2;
316 Renew(parser->stack, parser->stack_size, yy_stack_frame);
317 ps = parser->ps = parser->stack + size -1;
319 YYDPRINTF((Perl_debug_log,
320 "parser stack size increased to %lu frames\n",
321 (unsigned long int)parser->stack_size));
325 /* Do appropriate processing given the current state. */
326 /* Read a lookahead token if we need one and don't already have one. */
328 /* First try to decide what to do without reference to lookahead token. */
330 yyn = yypact[yystate];
331 if (yyn == YYPACT_NINF)
334 /* Not known => get a lookahead token if don't already have one. */
336 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
337 if (parser->yychar == YYEMPTY) {
338 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
339 #ifdef PERL_IN_MADLY_C
340 parser->yychar = PL_madskills ? madlex() : yylex();
342 parser->yychar = yylex();
345 /* perly.tab is shipped based on an ASCII system; if it were to be regenerated
346 * on a platform that doesn't use ASCII, this translation back would need to be
349 if (parser->yychar >= 0 && parser->yychar < 255) {
350 parser->yychar = NATIVE_TO_LATIN1(parser->yychar);
355 if (parser->yychar <= YYEOF) {
356 parser->yychar = yytoken = YYEOF;
357 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
360 yytoken = YYTRANSLATE (parser->yychar);
361 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
364 /* If the proper action on seeing token YYTOKEN is to reduce or to
365 detect an error, take that action. */
367 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
371 if (yyn == 0 || yyn == YYTABLE_NINF)
380 /* Shift the lookahead token. */
381 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
383 /* Discard the token being shifted unless it is eof. */
384 if (parser->yychar != YYEOF)
385 parser->yychar = YYEMPTY;
389 ps->val = parser->yylval;
390 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
391 ps->savestack_ix = PL_savestack_ix;
393 ps->name = (const char *)(yytname[yytoken]);
396 /* Count tokens shifted since error; after three, turn off error
398 if (parser->yyerrstatus)
399 parser->yyerrstatus--;
404 /*-----------------------------------------------------------.
405 | yydefault -- do the default action for the current state. |
406 `-----------------------------------------------------------*/
408 yyn = yydefact[yystate];
414 /*-----------------------------.
415 | yyreduce -- Do a reduction. |
416 `-----------------------------*/
418 /* yyn is the number of a rule to reduce with. */
419 parser->yylen = yyr2[yyn];
421 /* If YYLEN is nonzero, implement the default value of the action:
424 Otherwise, the following line sets YYVAL to garbage.
425 This behavior is undocumented and Bison
426 users should not rely upon it. Assigning to YYVAL
427 unconditionally makes the parser a bit smaller, and it avoids a
428 GCC warning that YYVAL may be used uninitialized. */
429 yyval = ps[1-parser->yylen].val;
431 YY_STACK_PRINT(parser);
432 YY_REDUCE_PRINT (yyn);
437 #define dep() deprecate("\"do\" to call subroutines")
439 #ifdef PERL_IN_MADLY_C
440 # define IVAL(i) (i)->tk_lval.ival
441 # define PVAL(p) (p)->tk_lval.pval
442 # define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
443 # define TOKEN_FREE(a) token_free(a)
444 # define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
445 # define IF_MAD(a,b) (a)
451 # define TOKEN_GETMAD(a,b,c)
452 # define TOKEN_FREE(a)
453 # define OP_GETMAD(a,b,c)
454 # define IF_MAD(a,b) (b)
459 /* contains all the rule actions; auto-generated from perly.y */
466 for (i=0; i< parser->yylen; i++) {
467 SvREFCNT_dec(ps[-i].compcv);
471 parser->ps = ps -= (parser->yylen-1);
473 /* Now shift the result of the reduction. Determine what state
474 that goes to, based on the state we popped back to and the rule
475 number reduced by. */
478 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
479 ps->savestack_ix = PL_savestack_ix;
481 ps->name = (const char *)(yytname [yyr1[yyn]]);
486 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
487 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
488 yystate = yytable[yystate];
490 yystate = yydefgoto[yyn - YYNTOKENS];
496 /*------------------------------------.
497 | yyerrlab -- here on detecting error |
498 `------------------------------------*/
500 /* If not already recovering from an error, report this error. */
501 if (!parser->yyerrstatus) {
502 yyerror ("syntax error");
506 if (parser->yyerrstatus == 3) {
507 /* If just tried and failed to reuse lookahead token after an
508 error, discard it. */
510 /* Return failure if at end of input. */
511 if (parser->yychar == YYEOF) {
512 /* Pop the error token. */
513 SvREFCNT_dec(ps->compcv);
515 /* Pop the rest of the stack. */
516 while (ps > parser->stack) {
517 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
518 LEAVE_SCOPE(ps->savestack_ix);
519 if (yy_type_tab[yystos[ps->state]] == toketype_opval
522 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
523 if (ps->compcv != PL_compcv) {
524 PL_compcv = ps->compcv;
525 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
527 op_free(ps->val.opval);
529 SvREFCNT_dec(ps->compcv);
535 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
536 parser->yychar = YYEMPTY;
540 /* Else will try to reuse lookahead token after shifting the error
545 /*----------------------------------------------------.
546 | yyerrlab1 -- error raised explicitly by an action. |
547 `----------------------------------------------------*/
549 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
552 yyn = yypact[yystate];
553 if (yyn != YYPACT_NINF) {
555 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
562 /* Pop the current state because it cannot handle the error token. */
563 if (ps == parser->stack)
566 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
567 LEAVE_SCOPE(ps->savestack_ix);
568 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
569 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
570 if (ps->compcv != PL_compcv) {
571 PL_compcv = ps->compcv;
572 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
574 op_free(ps->val.opval);
576 SvREFCNT_dec(ps->compcv);
580 YY_STACK_PRINT(parser);
586 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
590 ps->val = parser->yylval;
591 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
592 ps->savestack_ix = PL_savestack_ix;
600 /*-------------------------------------.
601 | yyacceptlab -- YYACCEPT comes here. |
602 `-------------------------------------*/
605 for (ps=parser->ps; ps > parser->stack; ps--) {
606 SvREFCNT_dec(ps->compcv);
608 parser->ps = parser->stack; /* disable cleanup */
611 /*-----------------------------------.
612 | yyabortlab -- YYABORT comes here. |
613 `-----------------------------------*/
619 LEAVE; /* force parser stack cleanup before we return */
625 * c-indentation-style: bsd
627 * indent-tabs-mode: nil
630 * ex: set ts=8 sts=4 sw=4 et: