3 * Copyright (c) 2004, 2005, 2006 Larry Wall and others
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
8 * Note that this file was originally generated as an output from
9 * GNU bison version 1.875, but now the code is statically maintained
10 * and edited; the bits that are dependent on perly.y are now
11 * #included from the files perly.tab and perly.act.
13 * Here is an important copyright statement from the original, generated
16 * As a special exception, when this file is copied by Bison into a
17 * Bison output file, you may use that output file without
18 * restriction. This special exception was added by the Free
19 * Software Foundation in version 1.24 of Bison.
21 * Note that this file is also #included in madly.c, to allow compilation
22 * of a second parser, Perl_madparse, that is identical to Perl_yyparse,
23 * but which includes extra code for dumping the parse tree.
24 * This is controlled by the PERL_IN_MADLY_C define.
28 #define PERL_IN_PERLY_C
31 typedef unsigned char yytype_uint8;
32 typedef signed char yytype_int8;
33 typedef unsigned short int yytype_uint16;
34 typedef short int yytype_int16;
35 typedef signed char yysigned_char;
43 /* contains all the parser state tables; auto-generated from perly.y */
46 # define YYSIZE_T size_t
52 #define YYACCEPT goto yyacceptlab
53 #define YYABORT goto yyabortlab
54 #define YYERROR goto yyerrlab1
56 /* Enable debugging if requested. */
59 # define yydebug (DEBUG_p_TEST)
61 # define YYFPRINTF PerlIO_printf
63 # define YYDPRINTF(Args) \
69 # define YYDSYMPRINTF(Title, Token, Value) \
72 YYFPRINTF (Perl_debug_log, "%s ", Title); \
73 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
74 YYFPRINTF (Perl_debug_log, "\n"); \
78 /*--------------------------------.
79 | Print this symbol on YYOUTPUT. |
80 `--------------------------------*/
83 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
85 if (yytype < YYNTOKENS) {
86 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
88 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
90 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
94 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
96 YYFPRINTF (yyoutput, ")");
101 * print the top 8 items on the parse stack.
105 yy_stack_print (pTHX_ const yy_parser *parser)
107 const yy_stack_frame *ps, *min;
109 min = parser->ps - 8 + 1;
110 if (min <= &parser->stack[0])
111 min = &parser->stack[0] + 1;
113 PerlIO_printf(Perl_debug_log, "\nindex:");
114 for (ps = min; ps <= parser->ps; ps++)
115 PerlIO_printf(Perl_debug_log, " %8d", ps - &parser->stack[0]);
117 PerlIO_printf(Perl_debug_log, "\nstate:");
118 for (ps = min; ps <= parser->ps; ps++)
119 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
121 PerlIO_printf(Perl_debug_log, "\ntoken:");
122 for (ps = min; ps <= parser->ps; ps++)
123 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
125 PerlIO_printf(Perl_debug_log, "\nvalue:");
126 for (ps = min; ps <= parser->ps; ps++) {
127 switch (yy_type_tab[yystos[ps->state]]) {
129 PerlIO_printf(Perl_debug_log, " %8.8s",
131 ? PL_op_name[ps->val.opval->op_type]
135 #ifndef PERL_IN_MADLY_C
136 case toketype_p_tkval:
137 PerlIO_printf(Perl_debug_log, " %8.8s",
138 ps->val.pval ? ps->val.pval : "(NULL)");
141 case toketype_i_tkval:
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 */
191 /* YYINITDEPTH -- initial size of the parser's stacks. */
192 #define YYINITDEPTH 200
194 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
195 * parse stack, thus avoiding leaks if we die */
198 S_clear_yystack(pTHX_ const void *p)
200 yy_parser *parser = (yy_parser*) SvPVX((SV*)p);
201 yy_stack_frame *ps = parser->ps;
204 if (ps == &parser->stack[0])
207 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
209 /* Freeing ops on the stack, and the op_latefree / op_latefreed /
212 * When we pop tokens off the stack during error recovery, or when
213 * we pop all the tokens off the stack after a die during a shift or
214 * reduce (i.e. Perl_croak somewhere in yylex() or in one of the
215 * newFOO() functions), then it's possible that some of these tokens are
216 * of type opval, pointing to an OP. All these ops are orphans; each is
217 * its own miniature subtree that has not yet been attached to a
218 * larger tree. In this case, we should clearly free the op (making
219 * sure, for each op we free that we have PL_comppad pointing to the
220 * right place for freeing any SVs attached to the op in threaded
223 * However, there is a particular problem if we die in newFOO() called
224 * by a reducing action; e.g.
227 * { $$ = newFOO($1,$2,$3) }
230 * OP *newFOO { ....; if (...) croak; .... }
232 * In this case, when we come to clean bar baz and boz off the stack,
233 * we don't know whether newFOO() has already:
236 * * attached them to part of a larger tree
237 * * attached them to PL_compcv
238 * * attached them to PL_compcv then freed it (as in BEGIN {die } )
240 * To get round this problem, we set the flag op_latefree on every op
241 * that gets pushed onto the parser stack. If op_free() sees this
242 * flag, it clears the op and frees any children,, but *doesn't* free
243 * the op itself; instead it sets the op_latefreed flag. This means
244 * that we can safely call op_free() multiple times on each stack op.
245 * So, when clearing the stack, we first, for each op that was being
246 * reduced, call op_free with op_latefree=1. This ensures that all ops
247 * hanging off these op are freed, but the reducing ops themselces are
248 * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
249 * and free them. A little thought should convince you that this
250 * two-part approach to the reducing ops should handle the first three
251 * cases above safely.
253 * In the case of attaching to PL_compcv (currently just newATTRSUB
254 * does this), then we set the op_attached flag on the op that has
255 * been so attached, then avoid doing the final op_free during
256 * cleanup, on the assumption that it will happen (or has already
257 * happened) when PL_compcv is freed.
259 * Note this is fairly fragile mechanism. A more robust approach
260 * would be to use two of these flag bits as 2-bit reference count
261 * field for each op, indicating whether it is pointed to from:
265 * but this would involve reworking all code (core and external) that
266 * manipulate op trees.
269 /* clear any reducing ops (1st pass) */
271 for (i=0; i< parser->yylen; i++) {
272 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
273 && ps[-i].val.opval) {
274 if ( ! (ps[-i].val.opval->op_attached
275 && !ps[-i].val.opval->op_latefreed))
277 if (ps[-i].comppad != PL_comppad) {
278 PAD_RESTORE_LOCAL(ps[-i].comppad);
280 op_free(ps[-i].val.opval);
285 /* now free whole the stack, including the just-reduced ops */
287 while (ps > &parser->stack[0]) {
288 if (yy_type_tab[yystos[ps->state]] == toketype_opval
291 if (ps->comppad != PL_comppad) {
292 PAD_RESTORE_LOCAL(ps->comppad);
294 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
295 ps->val.opval->op_latefree = 0;
296 if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
297 op_free(ps->val.opval);
310 #ifdef PERL_IN_MADLY_C
317 register int yystate;
321 /* Lookahead token as an internal (translated) token number. */
324 SV *parser_sv; /* SV whose PVX holds the parser object */
325 register yy_parser *parser; /* the parser object */
326 register yy_stack_frame *ps; /* current parser stack frame */
328 #define YYPOPSTACK parser->ps = --ps
329 #define YYPUSHSTACK parser->ps = ++ps
331 /* The variables used to return semantic value and location from the
332 action routines: ie $$. */
335 #ifndef PERL_IN_MADLY_C
342 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
344 ENTER; /* force stack free before we return */
347 parser_sv = newSV(sizeof(yy_parser)
348 + (YYINITDEPTH-1) * sizeof(yy_stack_frame));
349 SAVEFREESV(parser_sv);
350 PL_parser = parser = (yy_parser*) SvPVX(parser_sv);
351 ps = (yy_stack_frame*) &parser->stack[0];
354 parser->stack_size = YYINITDEPTH;
356 /* cleanup the parse stack on premature exit */
357 SAVEDESTRUCTOR_X(S_clear_yystack, (void*) parser_sv);
361 parser->yyerrstatus = 0;
362 parser->yychar = YYEMPTY; /* Cause a token to be read. */
364 /*------------------------------------------------------------.
365 | yynewstate -- Push a new state, which is found in yystate. |
366 `------------------------------------------------------------*/
371 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
373 if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
374 ps->val.opval->op_latefree = 1;
375 ps->val.opval->op_latefreed = 0;
381 size_t size = ps - &parser->stack[0] + 1;
383 /* grow the stack? We always leave 1 spare slot,
384 * in case of a '' -> 'foo' reduction */
386 if (size >= parser->stack_size - 1) {
387 /* this will croak on insufficient memory */
388 parser->stack_size *= 2;
390 (yy_parser*) SvGROW(parser_sv, sizeof(yy_parser)
391 + (parser->stack_size-1) * sizeof(yy_stack_frame));
393 /* readdress any pointers into realloced parser object */
394 ps = parser->ps = &parser->stack[0] + size -1;
396 YYDPRINTF((Perl_debug_log,
397 "parser stack size increased to %lu frames\n",
398 (unsigned long int)parser->stack_size));
402 /* Do appropriate processing given the current state. */
403 /* Read a lookahead token if we need one and don't already have one. */
405 /* First try to decide what to do without reference to lookahead token. */
407 yyn = yypact[yystate];
408 if (yyn == YYPACT_NINF)
411 /* Not known => get a lookahead token if don't already have one. */
413 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
414 if (parser->yychar == YYEMPTY) {
415 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
416 #ifdef PERL_IN_MADLY_C
417 parser->yychar = PL_madskills ? madlex() : yylex();
419 parser->yychar = yylex();
423 if (parser->yychar >= 0 && parser->yychar < 255) {
424 parser->yychar = NATIVE_TO_ASCII(parser->yychar);
429 if (parser->yychar <= YYEOF) {
430 parser->yychar = yytoken = YYEOF;
431 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
434 yytoken = YYTRANSLATE (parser->yychar);
435 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
438 /* If the proper action on seeing token YYTOKEN is to reduce or to
439 detect an error, take that action. */
441 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
445 if (yyn == 0 || yyn == YYTABLE_NINF)
454 /* Shift the lookahead token. */
455 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
457 /* Discard the token being shifted unless it is eof. */
458 if (parser->yychar != YYEOF)
459 parser->yychar = YYEMPTY;
463 ps->val = parser->yylval;
464 ps->comppad = PL_comppad;
466 ps->name = (const char *)(yytname[yytoken]);
469 /* Count tokens shifted since error; after three, turn off error
471 if (parser->yyerrstatus)
472 parser->yyerrstatus--;
477 /*-----------------------------------------------------------.
478 | yydefault -- do the default action for the current state. |
479 `-----------------------------------------------------------*/
481 yyn = yydefact[yystate];
487 /*-----------------------------.
488 | yyreduce -- Do a reduction. |
489 `-----------------------------*/
491 /* yyn is the number of a rule to reduce with. */
492 parser->yylen = yyr2[yyn];
494 /* If YYLEN is nonzero, implement the default value of the action:
497 Otherwise, the following line sets YYVAL to garbage.
498 This behavior is undocumented and Bison
499 users should not rely upon it. Assigning to YYVAL
500 unconditionally makes the parser a bit smaller, and it avoids a
501 GCC warning that YYVAL may be used uninitialized. */
502 yyval = ps[1-parser->yylen].val;
504 YY_STACK_PRINT(parser);
505 YY_REDUCE_PRINT (yyn);
510 #define dep() deprecate("\"do\" to call subroutines")
512 #ifdef PERL_IN_MADLY_C
513 # define IVAL(i) (i)->tk_lval.ival
514 # define PVAL(p) (p)->tk_lval.pval
515 # define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
516 # define TOKEN_FREE(a) token_free(a)
517 # define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
518 # define IF_MAD(a,b) (a)
524 # define TOKEN_GETMAD(a,b,c)
525 # define TOKEN_FREE(a)
526 # define OP_GETMAD(a,b,c)
527 # define IF_MAD(a,b) (b)
532 /* contains all the rule actions; auto-generated from perly.y */
537 /* any just-reduced ops with the op_latefreed flag cleared need to be
538 * freed; the rest need the flag resetting */
541 for (i=0; i< parser->yylen; i++) {
542 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
545 ps[-i].val.opval->op_latefree = 0;
546 if (ps[-i].val.opval->op_latefreed)
547 op_free(ps[-i].val.opval);
552 parser->ps = ps -= (parser->yylen-1);
554 /* Now shift the result of the reduction. Determine what state
555 that goes to, based on the state we popped back to and the rule
556 number reduced by. */
559 ps->comppad = PL_comppad;
561 ps->name = (const char *)(yytname [yyr1[yyn]]);
566 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
567 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
568 yystate = yytable[yystate];
570 yystate = yydefgoto[yyn - YYNTOKENS];
576 /*------------------------------------.
577 | yyerrlab -- here on detecting error |
578 `------------------------------------*/
580 /* If not already recovering from an error, report this error. */
581 if (!parser->yyerrstatus) {
582 yyerror ("syntax error");
586 if (parser->yyerrstatus == 3) {
587 /* If just tried and failed to reuse lookahead token after an
588 error, discard it. */
590 /* Return failure if at end of input. */
591 if (parser->yychar == YYEOF) {
592 /* Pop the error token. */
594 /* Pop the rest of the stack. */
595 while (ps > &parser->stack[0]) {
596 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
597 if (yy_type_tab[yystos[ps->state]] == toketype_opval
600 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
601 if (ps->comppad != PL_comppad) {
602 PAD_RESTORE_LOCAL(ps->comppad);
604 ps->val.opval->op_latefree = 0;
605 op_free(ps->val.opval);
612 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
613 parser->yychar = YYEMPTY;
617 /* Else will try to reuse lookahead token after shifting the error
622 /*----------------------------------------------------.
623 | yyerrlab1 -- error raised explicitly by an action. |
624 `----------------------------------------------------*/
626 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
629 yyn = yypact[yystate];
630 if (yyn != YYPACT_NINF) {
632 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
639 /* Pop the current state because it cannot handle the error token. */
640 if (ps == &parser->stack[0])
643 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
644 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
645 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
646 if (ps->comppad != PL_comppad) {
647 PAD_RESTORE_LOCAL(ps->comppad);
649 ps->val.opval->op_latefree = 0;
650 op_free(ps->val.opval);
655 YY_STACK_PRINT(parser);
661 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
665 ps->val = parser->yylval;
666 ps->comppad = PL_comppad;
674 /*-------------------------------------.
675 | yyacceptlab -- YYACCEPT comes here. |
676 `-------------------------------------*/
679 parser->ps = &parser->stack[0]; /* disable cleanup */
682 /*-----------------------------------.
683 | yyabortlab -- YYABORT comes here. |
684 `-----------------------------------*/
690 LEAVE; /* force stack free before we return */
696 * c-indentation-style: bsd
698 * indent-tabs-mode: t
701 * ex: set ts=8 sts=4 sw=4 noet: