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.
25 #define PERL_IN_PERLY_C
30 typedef unsigned char yytype_uint8;
31 typedef signed char yytype_int8;
32 typedef unsigned short int yytype_uint16;
33 typedef short int yytype_int16;
34 typedef signed char yysigned_char;
36 /* YYINITDEPTH -- initial size of the parser's stacks. */
37 #define YYINITDEPTH 200
53 # define YY_NULLPTR NULL
56 /* contains all the parser state tables; auto-generated from perly.y */
59 # define YYSIZE_T size_t
64 #define YYACCEPT goto yyacceptlab
65 #define YYABORT goto yyabortlab
66 #define YYERROR goto yyerrlab1
68 /* Enable debugging if requested. */
71 # define yydebug (DEBUG_p_TEST)
73 # define YYFPRINTF PerlIO_printf
75 # define YYDPRINTF(Args) \
81 # define YYDSYMPRINTF(Title, Token, Value) \
84 YYFPRINTF (Perl_debug_log, "%s ", Title); \
85 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
86 YYFPRINTF (Perl_debug_log, "\n"); \
90 /*--------------------------------.
91 | Print this symbol on YYOUTPUT. |
92 `--------------------------------*/
95 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
98 if (yytype < YYNTOKENS) {
99 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
101 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
103 YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival);
107 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
109 YYFPRINTF (yyoutput, ")");
114 * print the top 8 items on the parse stack.
118 yy_stack_print (pTHX_ const yy_parser *parser)
120 const yy_stack_frame *ps, *min;
122 min = parser->ps - 8 + 1;
123 if (min <= parser->stack)
124 min = parser->stack + 1;
126 PerlIO_printf(Perl_debug_log, "\nindex:");
127 for (ps = min; ps <= parser->ps; ps++)
128 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
130 PerlIO_printf(Perl_debug_log, "\nstate:");
131 for (ps = min; ps <= parser->ps; ps++)
132 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
134 PerlIO_printf(Perl_debug_log, "\ntoken:");
135 for (ps = min; ps <= parser->ps; ps++)
136 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
138 PerlIO_printf(Perl_debug_log, "\nvalue:");
139 for (ps = min; ps <= parser->ps; ps++) {
140 switch (yy_type_tab[yystos[ps->state]]) {
142 PerlIO_printf(Perl_debug_log, " %8.8s",
144 ? PL_op_name[ps->val.opval->op_type]
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 #if PERL_BISON_VERSION >= 30000 /* 3.0+ */
178 for (yyi = 0; yyi < yyr2[yyrule]; yyi++)
179 YYFPRINTF (Perl_debug_log, "%s ",
180 yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]);
182 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
183 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
185 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
188 # define YY_REDUCE_PRINT(Rule) \
191 yy_reduce_print (aTHX_ Rule); \
194 #else /* !DEBUGGING */
195 # define YYDPRINTF(Args)
196 # define YYDSYMPRINTF(Title, Token, Value)
197 # define YY_STACK_PRINT(parser)
198 # define YY_REDUCE_PRINT(Rule)
199 #endif /* !DEBUGGING */
201 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
202 * parse stack, thus avoiding leaks if we die */
205 S_clear_yystack(pTHX_ const yy_parser *parser)
207 yy_stack_frame *ps = parser->ps;
213 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
215 for (i=0; i< parser->yylen; i++) {
216 SvREFCNT_dec(ps[-i].compcv);
220 /* now free whole the stack, including the just-reduced ops */
222 while (ps > parser->stack) {
223 LEAVE_SCOPE(ps->savestack_ix);
224 if (yy_type_tab[yystos[ps->state]] == toketype_opval
227 if (ps->compcv && (ps->compcv != PL_compcv)) {
228 PL_compcv = ps->compcv;
229 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
230 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
232 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
233 op_free(ps->val.opval);
235 SvREFCNT_dec(ps->compcv);
239 Safefree(parser->stack);
248 Perl_yyparse (pTHX_ int gramtype)
255 /* Lookahead token as an internal (translated) token number. */
258 yy_parser *parser; /* the parser object */
259 yy_stack_frame *ps; /* current parser stack frame */
261 #define YYPOPSTACK parser->ps = --ps
262 #define YYPUSHSTACK parser->ps = ++ps
264 /* The variable used to return semantic value and location from the
265 action routines: ie $$. */
268 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
272 ENTER; /* force parser state cleanup/restoration before we return */
273 SAVEPPTR(parser->yylval.pval);
274 SAVEINT(parser->yychar);
275 SAVEINT(parser->yyerrstatus);
276 SAVEINT(parser->yylen);
277 SAVEVPTR(parser->stack);
278 SAVEVPTR(parser->stack_max1);
279 SAVEVPTR(parser->ps);
281 /* initialise state for this parse */
282 parser->yychar = gramtype;
283 yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
285 parser->yyerrstatus = 0;
287 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
288 parser->stack_max1 = parser->stack + YYINITDEPTH - 1;
289 ps = parser->ps = parser->stack;
291 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
294 /* main loop: shift some tokens, then reduce when possible */
297 /* shift a token, or quit when it's possible to reduce */
301 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
305 /* Grow the stack? We always leave 1 spare slot, in case of a
306 * '' -> 'foo' reduction.
307 * Note that stack_max1 points to the (top-1)th allocated stack
308 * element to make this check faster */
310 if (ps >= parser->stack_max1) {
311 Size_t pos = ps - parser->stack;
312 Size_t newsize = 2 * (parser->stack_max1 + 2 - parser->stack);
313 /* this will croak on insufficient memory */
314 Renew(parser->stack, newsize, yy_stack_frame);
315 ps = parser->ps = parser->stack + pos;
316 parser->stack_max1 = parser->stack + newsize - 1;
318 YYDPRINTF((Perl_debug_log,
319 "parser stack size increased to %lu frames\n",
320 (unsigned long int)newsize));
323 /* Do appropriate processing given the current state. Read a
324 * lookahead token if we need one and don't already have one.
327 /* First try to decide what to do without reference to
328 * lookahead token. */
330 yyn = yypact[yystate];
331 if (yyn == YYPACT_NINF)
334 /* Not known => get a lookahead token if don't already have
335 * one. YYCHAR is either YYEMPTY or YYEOF or a valid
336 * lookahead symbol. */
338 if (parser->yychar == YYEMPTY) {
339 YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
340 parser->yychar = yylex();
341 assert(parser->yychar >= 0);
342 if (parser->yychar == YYEOF) {
343 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
345 /* perly.tab is shipped based on an ASCII system, so need
346 * to index it with characters translated to ASCII.
347 * Although it's not designed for this purpose, we can use
348 * NATIVE_TO_UNI here. It returns its argument on ASCII
349 * platforms, and on EBCDIC translates native to ascii in
350 * the 0-255 range, leaving every other possible input
351 * unchanged. This jibes with yylex() returning some bare
352 * characters in that range, but all tokens it returns are
353 * either 0, or above 255. There could be a problem if NULs
354 * weren't 0, or were ever returned as raw chars by yylex() */
355 yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
358 /* make sure no-one's changed yychar since the last call to yylex */
359 assert(yytoken == YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)));
360 YYDSYMPRINTF("lookahead token is", yytoken, &parser->yylval);
363 /* If the proper action on seeing token YYTOKEN is to reduce or to
364 * detect an error, take that action.
365 * Casting yyn to unsigned allows a >=0 test to be included as
366 * part of the <=YYLAST test for speed */
368 if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) {
370 /* do the default action for the current state. */
371 yyn = yydefact[yystate];
374 break; /* time to reduce */
379 if (yyn == 0 || yyn == YYTABLE_NINF)
382 break; /* time to reduce */
388 /* Shift the lookahead token. */
389 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
391 /* Discard the token being shifted unless it is eof. */
392 if (parser->yychar != YYEOF)
393 parser->yychar = YYEMPTY;
397 ps->val = parser->yylval;
398 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
399 ps->savestack_ix = PL_savestack_ix;
401 ps->name = (const char *)(yytname[yytoken]);
404 /* Count tokens shifted since error; after three, turn off error
406 if (parser->yyerrstatus)
407 parser->yyerrstatus--;
413 /* yyn is the number of a rule to reduce with. */
414 parser->yylen = yyr2[yyn];
416 /* If YYLEN is nonzero, implement the default value of the action:
419 Otherwise, the following line sets YYVAL to garbage.
420 This behavior is undocumented and Bison
421 users should not rely upon it. Assigning to YYVAL
422 unconditionally makes the parser a bit smaller, and it avoids a
423 GCC warning that YYVAL may be used uninitialized. */
424 yyval = ps[1-parser->yylen].val;
426 YY_STACK_PRINT(parser);
427 YY_REDUCE_PRINT (yyn);
431 /* contains all the rule actions; auto-generated from perly.y */
438 for (i=0; i< parser->yylen; i++) {
439 SvREFCNT_dec(ps[-i].compcv);
443 parser->ps = ps -= (parser->yylen-1);
445 /* Now shift the result of the reduction. Determine what state
446 that goes to, based on the state we popped back to and the rule
447 number reduced by. */
450 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
451 ps->savestack_ix = PL_savestack_ix;
453 ps->name = (const char *)(yytname [yyr1[yyn]]);
458 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
459 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
460 yystate = yytable[yystate];
462 yystate = yydefgoto[yyn - YYNTOKENS];
468 /*------------------------------------.
469 | yyerrlab -- here on detecting error |
470 `------------------------------------*/
472 /* If not already recovering from an error, report this error. */
473 if (!parser->yyerrstatus) {
474 yyerror ("syntax error");
478 if (parser->yyerrstatus == 3) {
479 /* If just tried and failed to reuse lookahead token after an
480 error, discard it. */
482 /* Return failure if at end of input. */
483 if (parser->yychar == YYEOF) {
484 /* Pop the error token. */
485 SvREFCNT_dec(ps->compcv);
487 /* Pop the rest of the stack. */
488 while (ps > parser->stack) {
489 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
490 LEAVE_SCOPE(ps->savestack_ix);
491 if (yy_type_tab[yystos[ps->state]] == toketype_opval
494 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
495 if (ps->compcv != PL_compcv) {
496 PL_compcv = ps->compcv;
497 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
499 op_free(ps->val.opval);
501 SvREFCNT_dec(ps->compcv);
507 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
508 parser->yychar = YYEMPTY;
512 /* Else will try to reuse lookahead token after shifting the error
517 /*----------------------------------------------------.
518 | yyerrlab1 -- error raised explicitly by an action. |
519 `----------------------------------------------------*/
521 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
524 yyn = yypact[yystate];
525 if (yyn != YYPACT_NINF) {
527 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
534 /* Pop the current state because it cannot handle the error token. */
535 if (ps == parser->stack)
538 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
539 LEAVE_SCOPE(ps->savestack_ix);
540 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
541 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
542 if (ps->compcv != PL_compcv) {
543 PL_compcv = ps->compcv;
544 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
546 op_free(ps->val.opval);
548 SvREFCNT_dec(ps->compcv);
552 YY_STACK_PRINT(parser);
558 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
562 ps->val = parser->yylval;
563 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
564 ps->savestack_ix = PL_savestack_ix;
572 /*-------------------------------------.
573 | yyacceptlab -- YYACCEPT comes here. |
574 `-------------------------------------*/
577 for (ps=parser->ps; ps > parser->stack; ps--) {
578 SvREFCNT_dec(ps->compcv);
580 parser->ps = parser->stack; /* disable cleanup */
583 /*-----------------------------------.
584 | yyabortlab -- YYABORT comes here. |
585 `-----------------------------------*/
591 LEAVE; /* force parser stack cleanup before we return */
596 * ex: set ts=8 sts=4 sw=4 et: