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
52 # define YY_NULLPTR NULL
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)
97 if (yytype < YYNTOKENS) {
98 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
100 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
102 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
106 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
108 YYFPRINTF (yyoutput, ")");
113 * print the top 8 items on the parse stack.
117 yy_stack_print (pTHX_ const yy_parser *parser)
119 const yy_stack_frame *ps, *min;
121 min = parser->ps - 8 + 1;
122 if (min <= parser->stack)
123 min = parser->stack + 1;
125 PerlIO_printf(Perl_debug_log, "\nindex:");
126 for (ps = min; ps <= parser->ps; ps++)
127 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
129 PerlIO_printf(Perl_debug_log, "\nstate:");
130 for (ps = min; ps <= parser->ps; ps++)
131 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
133 PerlIO_printf(Perl_debug_log, "\ntoken:");
134 for (ps = min; ps <= parser->ps; ps++)
135 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
137 PerlIO_printf(Perl_debug_log, "\nvalue:");
138 for (ps = min; ps <= parser->ps; ps++) {
139 switch (yy_type_tab[yystos[ps->state]]) {
141 PerlIO_printf(Perl_debug_log, " %8.8s",
143 ? PL_op_name[ps->val.opval->op_type]
148 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
151 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
154 PerlIO_printf(Perl_debug_log, "\n\n");
157 # define YY_STACK_PRINT(parser) \
159 if (yydebug && DEBUG_v_TEST) \
160 yy_stack_print (aTHX_ parser); \
164 /*------------------------------------------------.
165 | Report that the YYRULE is going to be reduced. |
166 `------------------------------------------------*/
169 yy_reduce_print (pTHX_ int yyrule)
172 const unsigned int yylineno = yyrline[yyrule];
173 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
174 yyrule - 1, yylineno);
175 /* Print the symbols being reduced, and their result. */
176 #if PERL_BISON_VERSION >= 30000 /* 3.0+ */
177 for (yyi = 0; yyi < yyr2[yyrule]; yyi++)
178 YYFPRINTF (Perl_debug_log, "%s ",
179 yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]);
181 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
182 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
184 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
187 # define YY_REDUCE_PRINT(Rule) \
190 yy_reduce_print (aTHX_ Rule); \
193 #else /* !DEBUGGING */
194 # define YYDPRINTF(Args)
195 # define YYDSYMPRINTF(Title, Token, Value)
196 # define YY_STACK_PRINT(parser)
197 # define YY_REDUCE_PRINT(Rule)
198 #endif /* !DEBUGGING */
200 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
201 * parse stack, thus avoiding leaks if we die */
204 S_clear_yystack(pTHX_ const yy_parser *parser)
206 yy_stack_frame *ps = parser->ps;
212 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
214 for (i=0; i< parser->yylen; i++) {
215 SvREFCNT_dec(ps[-i].compcv);
219 /* now free whole the stack, including the just-reduced ops */
221 while (ps > parser->stack) {
222 LEAVE_SCOPE(ps->savestack_ix);
223 if (yy_type_tab[yystos[ps->state]] == toketype_opval
226 if (ps->compcv && (ps->compcv != PL_compcv)) {
227 PL_compcv = ps->compcv;
228 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
229 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
231 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
232 op_free(ps->val.opval);
234 SvREFCNT_dec(ps->compcv);
238 Safefree(parser->stack);
247 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 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
270 ENTER; /* force parser state cleanup/restoration before we return */
271 SAVEPPTR(parser->yylval.pval);
272 SAVEINT(parser->yychar);
273 SAVEINT(parser->yyerrstatus);
274 SAVEINT(parser->stack_size);
275 SAVEINT(parser->yylen);
276 SAVEVPTR(parser->stack);
277 SAVEVPTR(parser->ps);
279 /* initialise state for this parse */
280 parser->yychar = gramtype;
281 parser->yyerrstatus = 0;
282 parser->stack_size = YYINITDEPTH;
284 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
285 ps = parser->ps = parser->stack;
287 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
289 /*------------------------------------------------------------.
290 | yynewstate -- Push a new state, which is found in yystate. |
291 `------------------------------------------------------------*/
296 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
301 size_t size = ps - parser->stack + 1;
303 /* grow the stack? We always leave 1 spare slot,
304 * in case of a '' -> 'foo' reduction */
306 if (size >= (size_t)parser->stack_size - 1) {
307 /* this will croak on insufficient memory */
308 parser->stack_size *= 2;
309 Renew(parser->stack, parser->stack_size, yy_stack_frame);
310 ps = parser->ps = parser->stack + size -1;
312 YYDPRINTF((Perl_debug_log,
313 "parser stack size increased to %lu frames\n",
314 (unsigned long int)parser->stack_size));
318 /* Do appropriate processing given the current state. */
319 /* Read a lookahead token if we need one and don't already have one. */
321 /* First try to decide what to do without reference to lookahead token. */
323 yyn = yypact[yystate];
324 if (yyn == YYPACT_NINF)
327 /* Not known => get a lookahead token if don't already have one. */
329 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
330 if (parser->yychar == YYEMPTY) {
331 YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
332 parser->yychar = yylex();
335 if (parser->yychar <= YYEOF) {
336 parser->yychar = yytoken = YYEOF;
337 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
340 /* perly.tab is shipped based on an ASCII system, so need to index it
341 * with characters translated to ASCII. Although it's not designed for
342 * this purpose, we can use NATIVE_TO_UNI here. It returns its
343 * argument on ASCII platforms, and on EBCDIC translates native to
344 * ascii in the 0-255 range, leaving everything else unchanged. This
345 * jibes with yylex() returning some bare characters in that range, but
346 * all tokens it returns are either 0, or above 255. There could be a
347 * problem if NULs weren't 0, or were ever returned as raw chars by
349 yytoken = YYTRANSLATE (NATIVE_TO_UNI(parser->yychar));
350 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
353 /* If the proper action on seeing token YYTOKEN is to reduce or to
354 detect an error, take that action. */
356 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
360 if (yyn == 0 || yyn == YYTABLE_NINF)
369 /* Shift the lookahead token. */
370 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
372 /* Discard the token being shifted unless it is eof. */
373 if (parser->yychar != YYEOF)
374 parser->yychar = YYEMPTY;
378 ps->val = parser->yylval;
379 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
380 ps->savestack_ix = PL_savestack_ix;
382 ps->name = (const char *)(yytname[yytoken]);
385 /* Count tokens shifted since error; after three, turn off error
387 if (parser->yyerrstatus)
388 parser->yyerrstatus--;
393 /*-----------------------------------------------------------.
394 | yydefault -- do the default action for the current state. |
395 `-----------------------------------------------------------*/
397 yyn = yydefact[yystate];
403 /*-----------------------------.
404 | yyreduce -- Do a reduction. |
405 `-----------------------------*/
407 /* yyn is the number of a rule to reduce with. */
408 parser->yylen = yyr2[yyn];
410 /* If YYLEN is nonzero, implement the default value of the action:
413 Otherwise, the following line sets YYVAL to garbage.
414 This behavior is undocumented and Bison
415 users should not rely upon it. Assigning to YYVAL
416 unconditionally makes the parser a bit smaller, and it avoids a
417 GCC warning that YYVAL may be used uninitialized. */
418 yyval = ps[1-parser->yylen].val;
420 YY_STACK_PRINT(parser);
421 YY_REDUCE_PRINT (yyn);
425 /* contains all the rule actions; auto-generated from perly.y */
432 for (i=0; i< parser->yylen; i++) {
433 SvREFCNT_dec(ps[-i].compcv);
437 parser->ps = ps -= (parser->yylen-1);
439 /* Now shift the result of the reduction. Determine what state
440 that goes to, based on the state we popped back to and the rule
441 number reduced by. */
444 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
445 ps->savestack_ix = PL_savestack_ix;
447 ps->name = (const char *)(yytname [yyr1[yyn]]);
452 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
453 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
454 yystate = yytable[yystate];
456 yystate = yydefgoto[yyn - YYNTOKENS];
462 /*------------------------------------.
463 | yyerrlab -- here on detecting error |
464 `------------------------------------*/
466 /* If not already recovering from an error, report this error. */
467 if (!parser->yyerrstatus) {
468 yyerror ("syntax error");
472 if (parser->yyerrstatus == 3) {
473 /* If just tried and failed to reuse lookahead token after an
474 error, discard it. */
476 /* Return failure if at end of input. */
477 if (parser->yychar == YYEOF) {
478 /* Pop the error token. */
479 SvREFCNT_dec(ps->compcv);
481 /* Pop the rest of the stack. */
482 while (ps > parser->stack) {
483 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
484 LEAVE_SCOPE(ps->savestack_ix);
485 if (yy_type_tab[yystos[ps->state]] == toketype_opval
488 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
489 if (ps->compcv != PL_compcv) {
490 PL_compcv = ps->compcv;
491 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
493 op_free(ps->val.opval);
495 SvREFCNT_dec(ps->compcv);
501 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
502 parser->yychar = YYEMPTY;
506 /* Else will try to reuse lookahead token after shifting the error
511 /*----------------------------------------------------.
512 | yyerrlab1 -- error raised explicitly by an action. |
513 `----------------------------------------------------*/
515 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
518 yyn = yypact[yystate];
519 if (yyn != YYPACT_NINF) {
521 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
528 /* Pop the current state because it cannot handle the error token. */
529 if (ps == parser->stack)
532 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
533 LEAVE_SCOPE(ps->savestack_ix);
534 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
535 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
536 if (ps->compcv != PL_compcv) {
537 PL_compcv = ps->compcv;
538 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
540 op_free(ps->val.opval);
542 SvREFCNT_dec(ps->compcv);
546 YY_STACK_PRINT(parser);
552 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
556 ps->val = parser->yylval;
557 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
558 ps->savestack_ix = PL_savestack_ix;
566 /*-------------------------------------.
567 | yyacceptlab -- YYACCEPT comes here. |
568 `-------------------------------------*/
571 for (ps=parser->ps; ps > parser->stack; ps--) {
572 SvREFCNT_dec(ps->compcv);
574 parser->ps = parser->stack; /* disable cleanup */
577 /*-----------------------------------.
578 | yyabortlab -- YYABORT comes here. |
579 `-----------------------------------*/
585 LEAVE; /* force parser stack cleanup before we return */
590 * ex: set ts=8 sts=4 sw=4 et: