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
29 typedef unsigned char yytype_uint8;
30 typedef signed char yytype_int8;
31 typedef unsigned short int yytype_uint16;
32 typedef short int yytype_int16;
33 typedef signed char yysigned_char;
35 /* YYINITDEPTH -- initial size of the parser's stacks. */
36 #define YYINITDEPTH 200
51 /* contains all the parser state tables; auto-generated from perly.y */
54 # define YYSIZE_T size_t
59 #define YYACCEPT goto yyacceptlab
60 #define YYABORT goto yyabortlab
61 #define YYERROR goto yyerrlab1
63 /* Enable debugging if requested. */
66 # define yydebug (DEBUG_p_TEST)
68 # define YYFPRINTF PerlIO_printf
70 # define YYDPRINTF(Args) \
76 # define YYDSYMPRINTF(Title, Token, Value) \
79 YYFPRINTF (Perl_debug_log, "%s ", Title); \
80 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
81 YYFPRINTF (Perl_debug_log, "\n"); \
85 /*--------------------------------.
86 | Print this symbol on YYOUTPUT. |
87 `--------------------------------*/
90 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
93 if (yytype < YYNTOKENS) {
94 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
96 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
98 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
102 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
104 YYFPRINTF (yyoutput, ")");
109 * print the top 8 items on the parse stack.
113 yy_stack_print (pTHX_ const yy_parser *parser)
115 const yy_stack_frame *ps, *min;
117 min = parser->ps - 8 + 1;
118 if (min <= parser->stack)
119 min = parser->stack + 1;
121 PerlIO_printf(Perl_debug_log, "\nindex:");
122 for (ps = min; ps <= parser->ps; ps++)
123 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
125 PerlIO_printf(Perl_debug_log, "\nstate:");
126 for (ps = min; ps <= parser->ps; ps++)
127 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
129 PerlIO_printf(Perl_debug_log, "\ntoken:");
130 for (ps = min; ps <= parser->ps; ps++)
131 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
133 PerlIO_printf(Perl_debug_log, "\nvalue:");
134 for (ps = min; ps <= parser->ps; ps++) {
135 switch (yy_type_tab[yystos[ps->state]]) {
137 PerlIO_printf(Perl_debug_log, " %8.8s",
139 ? PL_op_name[ps->val.opval->op_type]
144 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
147 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
150 PerlIO_printf(Perl_debug_log, "\n\n");
153 # define YY_STACK_PRINT(parser) \
155 if (yydebug && DEBUG_v_TEST) \
156 yy_stack_print (aTHX_ parser); \
160 /*------------------------------------------------.
161 | Report that the YYRULE is going to be reduced. |
162 `------------------------------------------------*/
165 yy_reduce_print (pTHX_ int yyrule)
168 const unsigned int yylineno = yyrline[yyrule];
169 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
170 yyrule - 1, yylineno);
171 /* Print the symbols being reduced, and their result. */
172 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
173 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
174 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
177 # define YY_REDUCE_PRINT(Rule) \
180 yy_reduce_print (aTHX_ Rule); \
183 #else /* !DEBUGGING */
184 # define YYDPRINTF(Args)
185 # define YYDSYMPRINTF(Title, Token, Value)
186 # define YY_STACK_PRINT(parser)
187 # define YY_REDUCE_PRINT(Rule)
188 #endif /* !DEBUGGING */
190 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
191 * parse stack, thus avoiding leaks if we die */
194 S_clear_yystack(pTHX_ const yy_parser *parser)
196 yy_stack_frame *ps = parser->ps;
202 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
204 for (i=0; i< parser->yylen; i++) {
205 SvREFCNT_dec(ps[-i].compcv);
209 /* now free whole the stack, including the just-reduced ops */
211 while (ps > parser->stack) {
212 LEAVE_SCOPE(ps->savestack_ix);
213 if (yy_type_tab[yystos[ps->state]] == toketype_opval
216 if (ps->compcv != PL_compcv) {
217 PL_compcv = ps->compcv;
218 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
219 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
221 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
222 op_free(ps->val.opval);
224 SvREFCNT_dec(ps->compcv);
228 Safefree(parser->stack);
237 Perl_yyparse (pTHX_ int gramtype)
243 /* Lookahead token as an internal (translated) token number. */
246 yy_parser *parser; /* the parser object */
247 yy_stack_frame *ps; /* current parser stack frame */
249 #define YYPOPSTACK parser->ps = --ps
250 #define YYPUSHSTACK parser->ps = ++ps
252 /* The variable used to return semantic value and location from the
253 action routines: ie $$. */
256 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
260 ENTER; /* force parser state cleanup/restoration before we return */
261 SAVEPPTR(parser->yylval.pval);
262 SAVEINT(parser->yychar);
263 SAVEINT(parser->yyerrstatus);
264 SAVEINT(parser->stack_size);
265 SAVEINT(parser->yylen);
266 SAVEVPTR(parser->stack);
267 SAVEVPTR(parser->ps);
269 /* initialise state for this parse */
270 parser->yychar = gramtype;
271 parser->yyerrstatus = 0;
272 parser->stack_size = YYINITDEPTH;
274 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
275 ps = parser->ps = parser->stack;
277 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
279 /*------------------------------------------------------------.
280 | yynewstate -- Push a new state, which is found in yystate. |
281 `------------------------------------------------------------*/
286 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
291 size_t size = ps - parser->stack + 1;
293 /* grow the stack? We always leave 1 spare slot,
294 * in case of a '' -> 'foo' reduction */
296 if (size >= (size_t)parser->stack_size - 1) {
297 /* this will croak on insufficient memory */
298 parser->stack_size *= 2;
299 Renew(parser->stack, parser->stack_size, yy_stack_frame);
300 ps = parser->ps = parser->stack + size -1;
302 YYDPRINTF((Perl_debug_log,
303 "parser stack size increased to %lu frames\n",
304 (unsigned long int)parser->stack_size));
308 /* Do appropriate processing given the current state. */
309 /* Read a lookahead token if we need one and don't already have one. */
311 /* First try to decide what to do without reference to lookahead token. */
313 yyn = yypact[yystate];
314 if (yyn == YYPACT_NINF)
317 /* Not known => get a lookahead token if don't already have one. */
319 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
320 if (parser->yychar == YYEMPTY) {
321 YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
322 parser->yychar = yylex();
325 if (parser->yychar <= YYEOF) {
326 parser->yychar = yytoken = YYEOF;
327 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
330 /* perly.tab is shipped based on an ASCII system, so need to index it
331 * with characters translated to ASCII. Although it's not designed for
332 * this purpose, we can use NATIVE_TO_UNI here. It returns its
333 * argument on ASCII platforms, and on EBCDIC translates native to
334 * ascii in the 0-255 range, leaving everything else unchanged. This
335 * jibes with yylex() returning some bare characters in that range, but
336 * all tokens it returns are either 0, or above 255. There could be a
337 * problem if NULs weren't 0, or were ever returned as raw chars by
339 yytoken = YYTRANSLATE (NATIVE_TO_UNI(parser->yychar));
340 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
343 /* If the proper action on seeing token YYTOKEN is to reduce or to
344 detect an error, take that action. */
346 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
350 if (yyn == 0 || yyn == YYTABLE_NINF)
359 /* Shift the lookahead token. */
360 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
362 /* Discard the token being shifted unless it is eof. */
363 if (parser->yychar != YYEOF)
364 parser->yychar = YYEMPTY;
368 ps->val = parser->yylval;
369 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
370 ps->savestack_ix = PL_savestack_ix;
372 ps->name = (const char *)(yytname[yytoken]);
375 /* Count tokens shifted since error; after three, turn off error
377 if (parser->yyerrstatus)
378 parser->yyerrstatus--;
383 /*-----------------------------------------------------------.
384 | yydefault -- do the default action for the current state. |
385 `-----------------------------------------------------------*/
387 yyn = yydefact[yystate];
393 /*-----------------------------.
394 | yyreduce -- Do a reduction. |
395 `-----------------------------*/
397 /* yyn is the number of a rule to reduce with. */
398 parser->yylen = yyr2[yyn];
400 /* If YYLEN is nonzero, implement the default value of the action:
403 Otherwise, the following line sets YYVAL to garbage.
404 This behavior is undocumented and Bison
405 users should not rely upon it. Assigning to YYVAL
406 unconditionally makes the parser a bit smaller, and it avoids a
407 GCC warning that YYVAL may be used uninitialized. */
408 yyval = ps[1-parser->yylen].val;
410 YY_STACK_PRINT(parser);
411 YY_REDUCE_PRINT (yyn);
415 /* contains all the rule actions; auto-generated from perly.y */
422 for (i=0; i< parser->yylen; i++) {
423 SvREFCNT_dec(ps[-i].compcv);
427 parser->ps = ps -= (parser->yylen-1);
429 /* Now shift the result of the reduction. Determine what state
430 that goes to, based on the state we popped back to and the rule
431 number reduced by. */
434 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
435 ps->savestack_ix = PL_savestack_ix;
437 ps->name = (const char *)(yytname [yyr1[yyn]]);
442 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
443 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
444 yystate = yytable[yystate];
446 yystate = yydefgoto[yyn - YYNTOKENS];
452 /*------------------------------------.
453 | yyerrlab -- here on detecting error |
454 `------------------------------------*/
456 /* If not already recovering from an error, report this error. */
457 if (!parser->yyerrstatus) {
458 yyerror ("syntax error");
462 if (parser->yyerrstatus == 3) {
463 /* If just tried and failed to reuse lookahead token after an
464 error, discard it. */
466 /* Return failure if at end of input. */
467 if (parser->yychar == YYEOF) {
468 /* Pop the error token. */
469 SvREFCNT_dec(ps->compcv);
471 /* Pop the rest of the stack. */
472 while (ps > parser->stack) {
473 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
474 LEAVE_SCOPE(ps->savestack_ix);
475 if (yy_type_tab[yystos[ps->state]] == toketype_opval
478 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
479 if (ps->compcv != PL_compcv) {
480 PL_compcv = ps->compcv;
481 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
483 op_free(ps->val.opval);
485 SvREFCNT_dec(ps->compcv);
491 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
492 parser->yychar = YYEMPTY;
496 /* Else will try to reuse lookahead token after shifting the error
501 /*----------------------------------------------------.
502 | yyerrlab1 -- error raised explicitly by an action. |
503 `----------------------------------------------------*/
505 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
508 yyn = yypact[yystate];
509 if (yyn != YYPACT_NINF) {
511 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
518 /* Pop the current state because it cannot handle the error token. */
519 if (ps == parser->stack)
522 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
523 LEAVE_SCOPE(ps->savestack_ix);
524 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
525 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
526 if (ps->compcv != PL_compcv) {
527 PL_compcv = ps->compcv;
528 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
530 op_free(ps->val.opval);
532 SvREFCNT_dec(ps->compcv);
536 YY_STACK_PRINT(parser);
542 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
546 ps->val = parser->yylval;
547 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
548 ps->savestack_ix = PL_savestack_ix;
556 /*-------------------------------------.
557 | yyacceptlab -- YYACCEPT comes here. |
558 `-------------------------------------*/
561 for (ps=parser->ps; ps > parser->stack; ps--) {
562 SvREFCNT_dec(ps->compcv);
564 parser->ps = parser->stack; /* disable cleanup */
567 /*-----------------------------------.
568 | yyabortlab -- YYABORT comes here. |
569 `-----------------------------------*/
575 LEAVE; /* force parser stack cleanup before we return */
580 * ex: set ts=8 sts=4 sw=4 et: