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
33 typedef unsigned char yytype_uint8;
34 typedef signed char yytype_int8;
35 typedef unsigned short int yytype_uint16;
36 typedef short int yytype_int16;
37 typedef signed char yysigned_char;
39 /* YYINITDEPTH -- initial size of the parser's stacks. */
40 #define YYINITDEPTH 200
55 /* contains all the parser state tables; auto-generated from perly.y */
58 # define YYSIZE_T size_t
63 #define YYACCEPT goto yyacceptlab
64 #define YYABORT goto yyabortlab
65 #define YYERROR goto yyerrlab1
67 /* Enable debugging if requested. */
70 # define yydebug (DEBUG_p_TEST)
72 # define YYFPRINTF PerlIO_printf
74 # define YYDPRINTF(Args) \
80 # define YYDSYMPRINTF(Title, Token, Value) \
83 YYFPRINTF (Perl_debug_log, "%s ", Title); \
84 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
85 YYFPRINTF (Perl_debug_log, "\n"); \
89 /*--------------------------------.
90 | Print this symbol on YYOUTPUT. |
91 `--------------------------------*/
94 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
96 if (yytype < YYNTOKENS) {
97 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
99 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
101 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
105 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
107 YYFPRINTF (yyoutput, ")");
112 * print the top 8 items on the parse stack.
116 yy_stack_print (pTHX_ const yy_parser *parser)
118 const yy_stack_frame *ps, *min;
120 min = parser->ps - 8 + 1;
121 if (min <= parser->stack)
122 min = parser->stack + 1;
124 PerlIO_printf(Perl_debug_log, "\nindex:");
125 for (ps = min; ps <= parser->ps; ps++)
126 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
128 PerlIO_printf(Perl_debug_log, "\nstate:");
129 for (ps = min; ps <= parser->ps; ps++)
130 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
132 PerlIO_printf(Perl_debug_log, "\ntoken:");
133 for (ps = min; ps <= parser->ps; ps++)
134 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
136 PerlIO_printf(Perl_debug_log, "\nvalue:");
137 for (ps = min; ps <= parser->ps; ps++) {
138 switch (yy_type_tab[yystos[ps->state]]) {
140 PerlIO_printf(Perl_debug_log, " %8.8s",
142 ? PL_op_name[ps->val.opval->op_type]
146 #ifndef PERL_IN_MADLY_C
147 case toketype_i_tkval:
150 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
153 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
156 PerlIO_printf(Perl_debug_log, "\n\n");
159 # define YY_STACK_PRINT(parser) \
161 if (yydebug && DEBUG_v_TEST) \
162 yy_stack_print (aTHX_ parser); \
166 /*------------------------------------------------.
167 | Report that the YYRULE is going to be reduced. |
168 `------------------------------------------------*/
171 yy_reduce_print (pTHX_ int yyrule)
174 const unsigned int yylineno = yyrline[yyrule];
175 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
176 yyrule - 1, yylineno);
177 /* Print the symbols being reduced, and their result. */
178 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
179 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
180 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
183 # define YY_REDUCE_PRINT(Rule) \
186 yy_reduce_print (aTHX_ Rule); \
189 #else /* !DEBUGGING */
190 # define YYDPRINTF(Args)
191 # define YYDSYMPRINTF(Title, Token, Value)
192 # define YY_STACK_PRINT(parser)
193 # define YY_REDUCE_PRINT(Rule)
194 #endif /* !DEBUGGING */
196 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
197 * parse stack, thus avoiding leaks if we die */
200 S_clear_yystack(pTHX_ const yy_parser *parser)
202 yy_stack_frame *ps = parser->ps;
208 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
210 for (i=0; i< parser->yylen; i++) {
211 SvREFCNT_dec(ps[-i].compcv);
215 /* now free whole the stack, including the just-reduced ops */
217 while (ps > parser->stack) {
218 LEAVE_SCOPE(ps->savestack_ix);
219 if (yy_type_tab[yystos[ps->state]] == toketype_opval
222 if (ps->compcv != PL_compcv) {
223 PL_compcv = ps->compcv;
224 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
225 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
227 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
228 op_free(ps->val.opval);
230 SvREFCNT_dec(ps->compcv);
234 Safefree(parser->stack);
243 #ifdef PERL_IN_MADLY_C
244 Perl_madparse (pTHX_ int gramtype)
246 Perl_yyparse (pTHX_ int gramtype)
254 /* Lookahead token as an internal (translated) token number. */
257 yy_parser *parser; /* the parser object */
258 yy_stack_frame *ps; /* current parser stack frame */
260 #define YYPOPSTACK parser->ps = --ps
261 #define YYPUSHSTACK parser->ps = ++ps
263 /* The variable used to return semantic value and location from the
264 action routines: ie $$. */
267 #ifndef PERL_IN_MADLY_C
270 return madparse(gramtype);
274 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
278 ENTER; /* force parser state cleanup/restoration before we return */
279 SAVEPPTR(parser->yylval.pval);
280 SAVEINT(parser->yychar);
281 SAVEINT(parser->yyerrstatus);
282 SAVEINT(parser->stack_size);
283 SAVEINT(parser->yylen);
284 SAVEVPTR(parser->stack);
285 SAVEVPTR(parser->ps);
287 /* initialise state for this parse */
288 parser->yychar = gramtype;
289 parser->yyerrstatus = 0;
290 parser->stack_size = YYINITDEPTH;
292 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
293 ps = parser->ps = parser->stack;
295 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
297 /*------------------------------------------------------------.
298 | yynewstate -- Push a new state, which is found in yystate. |
299 `------------------------------------------------------------*/
304 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
309 size_t size = ps - parser->stack + 1;
311 /* grow the stack? We always leave 1 spare slot,
312 * in case of a '' -> 'foo' reduction */
314 if (size >= (size_t)parser->stack_size - 1) {
315 /* this will croak on insufficient memory */
316 parser->stack_size *= 2;
317 Renew(parser->stack, parser->stack_size, yy_stack_frame);
318 ps = parser->ps = parser->stack + size -1;
320 YYDPRINTF((Perl_debug_log,
321 "parser stack size increased to %lu frames\n",
322 (unsigned long int)parser->stack_size));
326 /* Do appropriate processing given the current state. */
327 /* Read a lookahead token if we need one and don't already have one. */
329 /* First try to decide what to do without reference to lookahead token. */
331 yyn = yypact[yystate];
332 if (yyn == YYPACT_NINF)
335 /* Not known => get a lookahead token if don't already have one. */
337 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
338 if (parser->yychar == YYEMPTY) {
339 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
340 #ifdef PERL_IN_MADLY_C
341 parser->yychar = PL_madskills ? madlex() : yylex();
343 parser->yychar = yylex();
346 /* perly.tab is shipped based on an ASCII system; if it were to be regenerated
347 * on a platform that doesn't use ASCII, this translation back would need to be
350 if (parser->yychar >= 0 && parser->yychar < 255) {
351 parser->yychar = NATIVE_TO_LATIN1(parser->yychar);
356 if (parser->yychar <= YYEOF) {
357 parser->yychar = yytoken = YYEOF;
358 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
361 yytoken = YYTRANSLATE (parser->yychar);
362 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
365 /* If the proper action on seeing token YYTOKEN is to reduce or to
366 detect an error, take that action. */
368 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
372 if (yyn == 0 || yyn == YYTABLE_NINF)
381 /* Shift the lookahead token. */
382 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
384 /* Discard the token being shifted unless it is eof. */
385 if (parser->yychar != YYEOF)
386 parser->yychar = YYEMPTY;
390 ps->val = parser->yylval;
391 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
392 ps->savestack_ix = PL_savestack_ix;
394 ps->name = (const char *)(yytname[yytoken]);
397 /* Count tokens shifted since error; after three, turn off error
399 if (parser->yyerrstatus)
400 parser->yyerrstatus--;
405 /*-----------------------------------------------------------.
406 | yydefault -- do the default action for the current state. |
407 `-----------------------------------------------------------*/
409 yyn = yydefact[yystate];
415 /*-----------------------------.
416 | yyreduce -- Do a reduction. |
417 `-----------------------------*/
419 /* yyn is the number of a rule to reduce with. */
420 parser->yylen = yyr2[yyn];
422 /* If YYLEN is nonzero, implement the default value of the action:
425 Otherwise, the following line sets YYVAL to garbage.
426 This behavior is undocumented and Bison
427 users should not rely upon it. Assigning to YYVAL
428 unconditionally makes the parser a bit smaller, and it avoids a
429 GCC warning that YYVAL may be used uninitialized. */
430 yyval = ps[1-parser->yylen].val;
432 YY_STACK_PRINT(parser);
433 YY_REDUCE_PRINT (yyn);
437 #ifdef PERL_IN_MADLY_C
438 # define IVAL(i) (i)->tk_lval.ival
439 # define PVAL(p) (p)->tk_lval.pval
440 # define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
441 # define TOKEN_FREE(a) token_free(a)
442 # define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
443 # define IF_MAD(a,b) (a)
449 # define TOKEN_GETMAD(a,b,c)
450 # define TOKEN_FREE(a)
451 # define OP_GETMAD(a,b,c)
452 # define IF_MAD(a,b) (b)
457 /* contains all the rule actions; auto-generated from perly.y */
464 for (i=0; i< parser->yylen; i++) {
465 SvREFCNT_dec(ps[-i].compcv);
469 parser->ps = ps -= (parser->yylen-1);
471 /* Now shift the result of the reduction. Determine what state
472 that goes to, based on the state we popped back to and the rule
473 number reduced by. */
476 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
477 ps->savestack_ix = PL_savestack_ix;
479 ps->name = (const char *)(yytname [yyr1[yyn]]);
484 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
485 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
486 yystate = yytable[yystate];
488 yystate = yydefgoto[yyn - YYNTOKENS];
494 /*------------------------------------.
495 | yyerrlab -- here on detecting error |
496 `------------------------------------*/
498 /* If not already recovering from an error, report this error. */
499 if (!parser->yyerrstatus) {
500 yyerror ("syntax error");
504 if (parser->yyerrstatus == 3) {
505 /* If just tried and failed to reuse lookahead token after an
506 error, discard it. */
508 /* Return failure if at end of input. */
509 if (parser->yychar == YYEOF) {
510 /* Pop the error token. */
511 SvREFCNT_dec(ps->compcv);
513 /* Pop the rest of the stack. */
514 while (ps > parser->stack) {
515 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
516 LEAVE_SCOPE(ps->savestack_ix);
517 if (yy_type_tab[yystos[ps->state]] == toketype_opval
520 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
521 if (ps->compcv != PL_compcv) {
522 PL_compcv = ps->compcv;
523 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
525 op_free(ps->val.opval);
527 SvREFCNT_dec(ps->compcv);
533 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
534 parser->yychar = YYEMPTY;
538 /* Else will try to reuse lookahead token after shifting the error
543 /*----------------------------------------------------.
544 | yyerrlab1 -- error raised explicitly by an action. |
545 `----------------------------------------------------*/
547 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
550 yyn = yypact[yystate];
551 if (yyn != YYPACT_NINF) {
553 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
560 /* Pop the current state because it cannot handle the error token. */
561 if (ps == parser->stack)
564 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
565 LEAVE_SCOPE(ps->savestack_ix);
566 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
567 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
568 if (ps->compcv != PL_compcv) {
569 PL_compcv = ps->compcv;
570 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
572 op_free(ps->val.opval);
574 SvREFCNT_dec(ps->compcv);
578 YY_STACK_PRINT(parser);
584 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
588 ps->val = parser->yylval;
589 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
590 ps->savestack_ix = PL_savestack_ix;
598 /*-------------------------------------.
599 | yyacceptlab -- YYACCEPT comes here. |
600 `-------------------------------------*/
603 for (ps=parser->ps; ps > parser->stack; ps--) {
604 SvREFCNT_dec(ps->compcv);
606 parser->ps = parser->stack; /* disable cleanup */
609 /*-----------------------------------.
610 | yyabortlab -- YYABORT comes here. |
611 `-----------------------------------*/
617 LEAVE; /* force parser stack cleanup before we return */
623 * c-indentation-style: bsd
625 * indent-tabs-mode: nil
628 * ex: set ts=8 sts=4 sw=4 et: