This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump several file copyright dates
[perl5.git] / perly.c
CommitLineData
0de566d7
DM
1/* perly.c
2 *
2eee27d7
SS
3 * Copyright (c) 2004, 2005, 2006, 2007, 2008,
4 * 2009, 2010, 2011 by Larry Wall and others
0de566d7
DM
5 *
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.
8 *
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
f05e27e5
DM
11 * and edited; the bits that are dependent on perly.y are now
12 * #included from the files perly.tab and perly.act.
0de566d7
DM
13 *
14 * Here is an important copyright statement from the original, generated
15 * file:
16 *
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.
bc463c31
DM
21 *
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,
f05e27e5
DM
24 * but which includes extra code for dumping the parse tree.
25 * This is controlled by the PERL_IN_MADLY_C define.
0de566d7
DM
26 */
27
79072805 28#include "EXTERN.h"
864dbfa3 29#define PERL_IN_PERLY_C
79072805 30#include "perl.h"
09bef843 31
3797f23d
DM
32typedef unsigned char yytype_uint8;
33typedef signed char yytype_int8;
34typedef unsigned short int yytype_uint16;
35typedef short int yytype_int16;
0de566d7
DM
36typedef signed char yysigned_char;
37
28ac2b49
Z
38/* YYINITDEPTH -- initial size of the parser's stacks. */
39#define YYINITDEPTH 200
40
0de566d7
DM
41#ifdef DEBUGGING
42# define YYDEBUG 1
93a17b20 43#else
0de566d7 44# define YYDEBUG 0
93a17b20 45#endif
09bef843 46
f05e27e5
DM
47/* contains all the parser state tables; auto-generated from perly.y */
48#include "perly.tab"
0de566d7
DM
49
50# define YYSIZE_T size_t
51
0de566d7 52#define YYEOF 0
07a06489 53#define YYTERROR 1
0de566d7
DM
54
55#define YYACCEPT goto yyacceptlab
56#define YYABORT goto yyabortlab
57#define YYERROR goto yyerrlab1
58
0de566d7 59/* Enable debugging if requested. */
9388183f 60#ifdef DEBUGGING
0de566d7
DM
61
62# define yydebug (DEBUG_p_TEST)
63
64# define YYFPRINTF PerlIO_printf
65
66# define YYDPRINTF(Args) \
67do { \
68 if (yydebug) \
69 YYFPRINTF Args; \
70} while (0)
71
9388183f 72# define YYDSYMPRINTF(Title, Token, Value) \
0de566d7
DM
73do { \
74 if (yydebug) { \
75 YYFPRINTF (Perl_debug_log, "%s ", Title); \
356f4fed 76 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
0de566d7
DM
77 YYFPRINTF (Perl_debug_log, "\n"); \
78 } \
79} while (0)
80
81/*--------------------------------.
82| Print this symbol on YYOUTPUT. |
83`--------------------------------*/
84
85static void
356f4fed 86yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
0de566d7 87{
0de566d7
DM
88 if (yytype < YYNTOKENS) {
89 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
90# ifdef YYPRINT
91 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
9388183f 92# else
e4584336 93 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
0de566d7
DM
94# endif
95 }
96 else
97 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
98
0de566d7
DM
99 YYFPRINTF (yyoutput, ")");
100}
101
102
9388183f 103/* yy_stack_print()
1654d593
DM
104 * print the top 8 items on the parse stack.
105 */
0de566d7
DM
106
107static void
1654d593 108yy_stack_print (pTHX_ const yy_parser *parser)
0de566d7 109{
1654d593 110 const yy_stack_frame *ps, *min;
9388183f 111
2d29f438 112 min = parser->ps - 8 + 1;
22735491
DM
113 if (min <= parser->stack)
114 min = parser->stack + 1;
9388183f
CB
115
116 PerlIO_printf(Perl_debug_log, "\nindex:");
1654d593 117 for (ps = min; ps <= parser->ps; ps++)
00c0e1ee 118 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
1654d593 119
9388183f 120 PerlIO_printf(Perl_debug_log, "\nstate:");
1654d593
DM
121 for (ps = min; ps <= parser->ps; ps++)
122 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
123
9388183f 124 PerlIO_printf(Perl_debug_log, "\ntoken:");
1654d593
DM
125 for (ps = min; ps <= parser->ps; ps++)
126 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
127
9388183f 128 PerlIO_printf(Perl_debug_log, "\nvalue:");
1654d593
DM
129 for (ps = min; ps <= parser->ps; ps++) {
130 switch (yy_type_tab[yystos[ps->state]]) {
d5c6462e 131 case toketype_opval:
21612876 132 PerlIO_printf(Perl_debug_log, " %8.8s",
1654d593
DM
133 ps->val.opval
134 ? PL_op_name[ps->val.opval->op_type]
670f3923 135 : "(Nullop)"
21612876 136 );
d5c6462e
DM
137 break;
138#ifndef PERL_IN_MADLY_C
139 case toketype_p_tkval:
140 PerlIO_printf(Perl_debug_log, " %8.8s",
1654d593 141 ps->val.pval ? ps->val.pval : "(NULL)");
d5c6462e
DM
142 break;
143
144 case toketype_i_tkval:
145#endif
146 case toketype_ival:
1654d593 147 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
d5c6462e
DM
148 break;
149 default:
1654d593 150 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
d5c6462e 151 }
21612876 152 }
9388183f 153 PerlIO_printf(Perl_debug_log, "\n\n");
0de566d7
DM
154}
155
1654d593
DM
156# define YY_STACK_PRINT(parser) \
157do { \
158 if (yydebug && DEBUG_v_TEST) \
159 yy_stack_print (aTHX_ parser); \
0de566d7
DM
160} while (0)
161
09bef843 162
0de566d7
DM
163/*------------------------------------------------.
164| Report that the YYRULE is going to be reduced. |
165`------------------------------------------------*/
166
167static void
168yy_reduce_print (pTHX_ int yyrule)
169{
170 int yyi;
df35152e 171 const unsigned int yylineno = yyrline[yyrule];
0de566d7
DM
172 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
173 yyrule - 1, yylineno);
174 /* Print the symbols being reduced, and their result. */
175 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
176 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
177 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
178}
179
180# define YY_REDUCE_PRINT(Rule) \
181do { \
182 if (yydebug) \
183 yy_reduce_print (aTHX_ Rule); \
184} while (0)
185
186#else /* !DEBUGGING */
187# define YYDPRINTF(Args)
9388183f 188# define YYDSYMPRINTF(Title, Token, Value)
1654d593 189# define YY_STACK_PRINT(parser)
0de566d7
DM
190# define YY_REDUCE_PRINT(Rule)
191#endif /* !DEBUGGING */
192
718a7425
DM
193/* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
194 * parse stack, thus avoiding leaks if we die */
195
196static void
22735491 197S_clear_yystack(pTHX_ const yy_parser *parser)
718a7425 198{
1654d593 199 yy_stack_frame *ps = parser->ps;
0934c9d9 200 int i = 0;
718a7425 201
28ac2b49 202 if (!parser->stack)
718a7425 203 return;
1654d593 204
718a7425 205 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
670f3923 206
7e5d8ed2
DM
207 /* Freeing ops on the stack, and the op_latefree / op_latefreed /
208 * op_attached flags:
670f3923
DM
209 *
210 * When we pop tokens off the stack during error recovery, or when
211 * we pop all the tokens off the stack after a die during a shift or
7e5d8ed2
DM
212 * reduce (i.e. Perl_croak somewhere in yylex() or in one of the
213 * newFOO() functions), then it's possible that some of these tokens are
670f3923
DM
214 * of type opval, pointing to an OP. All these ops are orphans; each is
215 * its own miniature subtree that has not yet been attached to a
7e5d8ed2
DM
216 * larger tree. In this case, we should clearly free the op (making
217 * sure, for each op we free that we have PL_comppad pointing to the
670f3923
DM
218 * right place for freeing any SVs attached to the op in threaded
219 * builds.
220 *
7e5d8ed2 221 * However, there is a particular problem if we die in newFOO() called
670f3923
DM
222 * by a reducing action; e.g.
223 *
224 * foo : bar baz boz
225 * { $$ = newFOO($1,$2,$3) }
226 *
227 * where
7e5d8ed2 228 * OP *newFOO { ....; if (...) croak; .... }
670f3923
DM
229 *
230 * In this case, when we come to clean bar baz and boz off the stack,
231 * we don't know whether newFOO() has already:
232 * * freed them
7e5d8ed2 233 * * left them as is
670f3923 234 * * attached them to part of a larger tree
7e5d8ed2
DM
235 * * attached them to PL_compcv
236 * * attached them to PL_compcv then freed it (as in BEGIN {die } )
670f3923
DM
237 *
238 * To get round this problem, we set the flag op_latefree on every op
239 * that gets pushed onto the parser stack. If op_free() sees this
240 * flag, it clears the op and frees any children,, but *doesn't* free
241 * the op itself; instead it sets the op_latefreed flag. This means
242 * that we can safely call op_free() multiple times on each stack op.
243 * So, when clearing the stack, we first, for each op that was being
244 * reduced, call op_free with op_latefree=1. This ensures that all ops
486ec47a 245 * hanging off these op are freed, but the reducing ops themselves are
670f3923 246 * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
7e5d8ed2
DM
247 * and free them. A little thought should convince you that this
248 * two-part approach to the reducing ops should handle the first three
249 * cases above safely.
250 *
251 * In the case of attaching to PL_compcv (currently just newATTRSUB
252 * does this), then we set the op_attached flag on the op that has
253 * been so attached, then avoid doing the final op_free during
254 * cleanup, on the assumption that it will happen (or has already
255 * happened) when PL_compcv is freed.
256 *
257 * Note this is fairly fragile mechanism. A more robust approach
258 * would be to use two of these flag bits as 2-bit reference count
259 * field for each op, indicating whether it is pointed to from:
260 * * a parent op
261 * * the parser stack
262 * * a CV
263 * but this would involve reworking all code (core and external) that
264 * manipulate op trees.
0aded6e1
DM
265 *
266 * XXX DAPM 17/1/07 I've decided its too fragile for now, and so have
267 * disabled it */
268
269#define DISABLE_STACK_FREE
670f3923 270
0aded6e1
DM
271
272#ifdef DISABLE_STACK_FREE
8c63ea58
GG
273 for (i=0; i< parser->yylen; i++) {
274 SvREFCNT_dec(ps[-i].compcv);
275 }
0aded6e1 276 ps -= parser->yylen;
0aded6e1 277#else
7e5d8ed2 278 /* clear any reducing ops (1st pass) */
670f3923 279
5912531f 280 for (i=0; i< parser->yylen; i++) {
503de470 281 LEAVE_SCOPE(ps[-i].savestack_ix);
1654d593
DM
282 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
283 && ps[-i].val.opval) {
7e5d8ed2
DM
284 if ( ! (ps[-i].val.opval->op_attached
285 && !ps[-i].val.opval->op_latefreed))
286 {
8c63ea58
GG
287 if (ps[-i].compcv != PL_compcv) {
288 PL_compcv = ps[-i].compcv;
289 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
7e5d8ed2
DM
290 }
291 op_free(ps[-i].val.opval);
670f3923 292 }
670f3923
DM
293 }
294 }
0aded6e1 295#endif
670f3923
DM
296
297 /* now free whole the stack, including the just-reduced ops */
298
22735491 299 while (ps > parser->stack) {
503de470 300 LEAVE_SCOPE(ps->savestack_ix);
1654d593
DM
301 if (yy_type_tab[yystos[ps->state]] == toketype_opval
302 && ps->val.opval)
670f3923 303 {
8c63ea58
GG
304 if (ps->compcv != PL_compcv) {
305 PL_compcv = ps->compcv;
306 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
718a7425
DM
307 }
308 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
0aded6e1 309#ifndef DISABLE_STACK_FREE
1654d593 310 ps->val.opval->op_latefree = 0;
7e5d8ed2 311 if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
0aded6e1 312#endif
7e5d8ed2 313 op_free(ps->val.opval);
718a7425 314 }
8c63ea58 315 SvREFCNT_dec(ps->compcv);
1654d593 316 ps--;
718a7425 317 }
28ac2b49
Z
318
319 Safefree(parser->stack);
718a7425
DM
320}
321
718a7425 322
0de566d7
DM
323/*----------.
324| yyparse. |
325`----------*/
326
79072805 327int
bc463c31 328#ifdef PERL_IN_MADLY_C
28ac2b49 329Perl_madparse (pTHX_ int gramtype)
bc463c31 330#else
28ac2b49 331Perl_yyparse (pTHX_ int gramtype)
bc463c31 332#endif
79072805 333{
97aff369 334 dVAR;
0de566d7
DM
335 register int yystate;
336 register int yyn;
337 int yyresult;
338
0de566d7 339 /* Lookahead token as an internal (translated) token number. */
714c8e96 340 int yytoken = 0;
0de566d7 341
5912531f 342 register yy_parser *parser; /* the parser object */
1654d593 343 register yy_stack_frame *ps; /* current parser stack frame */
a0d0e21e 344
1654d593
DM
345#define YYPOPSTACK parser->ps = --ps
346#define YYPUSHSTACK parser->ps = ++ps
0de566d7 347
acdf0a21 348 /* The variable used to return semantic value and location from the
5912531f 349 action routines: ie $$. */
0de566d7
DM
350 YYSTYPE yyval;
351
bc463c31
DM
352#ifndef PERL_IN_MADLY_C
353# ifdef PERL_MAD
00e74f14 354 if (PL_madskills)
28ac2b49 355 return madparse(gramtype);
bc463c31 356# endif
81d86705
NC
357#endif
358
0de566d7
DM
359 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
360
acdf0a21 361 parser = PL_parser;
1654d593 362
28ac2b49
Z
363 ENTER; /* force parser state cleanup/restoration before we return */
364 SAVEPPTR(parser->yylval.pval);
365 SAVEINT(parser->yychar);
366 SAVEINT(parser->yyerrstatus);
367 SAVEINT(parser->stack_size);
368 SAVEINT(parser->yylen);
369 SAVEVPTR(parser->stack);
370 SAVEVPTR(parser->ps);
371
372 /* initialise state for this parse */
373 parser->yychar = gramtype;
374 parser->yyerrstatus = 0;
375 parser->stack_size = YYINITDEPTH;
376 parser->yylen = 0;
377 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
378 ps = parser->ps = parser->stack;
379 ps->state = 0;
e3abe207 380 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
0de566d7 381
0de566d7
DM
382/*------------------------------------------------------------.
383| yynewstate -- Push a new state, which is found in yystate. |
384`------------------------------------------------------------*/
385 yynewstate:
0de566d7 386
1654d593 387 yystate = ps->state;
05a03161 388
670f3923 389 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7 390
0aded6e1 391#ifndef DISABLE_STACK_FREE
1654d593
DM
392 if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
393 ps->val.opval->op_latefree = 1;
394 ps->val.opval->op_latefreed = 0;
670f3923 395 }
0aded6e1 396#endif
670f3923 397
5912531f 398 parser->yylen = 0;
0de566d7 399
1654d593 400 {
22735491 401 size_t size = ps - parser->stack + 1;
0de566d7 402
1654d593
DM
403 /* grow the stack? We always leave 1 spare slot,
404 * in case of a '' -> 'foo' reduction */
0de566d7 405
85c508c3 406 if (size >= (size_t)parser->stack_size - 1) {
1654d593
DM
407 /* this will croak on insufficient memory */
408 parser->stack_size *= 2;
22735491
DM
409 Renew(parser->stack, parser->stack_size, yy_stack_frame);
410 ps = parser->ps = parser->stack + size -1;
670f3923 411
1654d593
DM
412 YYDPRINTF((Perl_debug_log,
413 "parser stack size increased to %lu frames\n",
414 (unsigned long int)parser->stack_size));
415 }
93a17b20 416 }
0de566d7 417
0de566d7
DM
418/* Do appropriate processing given the current state. */
419/* Read a lookahead token if we need one and don't already have one. */
0de566d7
DM
420
421 /* First try to decide what to do without reference to lookahead token. */
422
423 yyn = yypact[yystate];
424 if (yyn == YYPACT_NINF)
425 goto yydefault;
426
427 /* Not known => get a lookahead token if don't already have one. */
428
429 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
5912531f 430 if (parser->yychar == YYEMPTY) {
0de566d7 431 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 432#ifdef PERL_IN_MADLY_C
5912531f 433 parser->yychar = PL_madskills ? madlex() : yylex();
f05e27e5 434#else
5912531f 435 parser->yychar = yylex();
81d86705 436#endif
bc463c31 437
12fbd33b 438# ifdef EBCDIC
5912531f
DM
439 if (parser->yychar >= 0 && parser->yychar < 255) {
440 parser->yychar = NATIVE_TO_ASCII(parser->yychar);
12fbd33b
DM
441 }
442# endif
0de566d7
DM
443 }
444
5912531f
DM
445 if (parser->yychar <= YYEOF) {
446 parser->yychar = yytoken = YYEOF;
0de566d7 447 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 448 }
0de566d7 449 else {
5912531f
DM
450 yytoken = YYTRANSLATE (parser->yychar);
451 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
93a17b20 452 }
771df094 453
0de566d7
DM
454 /* If the proper action on seeing token YYTOKEN is to reduce or to
455 detect an error, take that action. */
456 yyn += yytoken;
457 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
458 goto yydefault;
459 yyn = yytable[yyn];
460 if (yyn <= 0) {
461 if (yyn == 0 || yyn == YYTABLE_NINF)
462 goto yyerrlab;
463 yyn = -yyn;
464 goto yyreduce;
465 }
7b57b0ea 466
0de566d7
DM
467 if (yyn == YYFINAL)
468 YYACCEPT;
771df094 469
0de566d7
DM
470 /* Shift the lookahead token. */
471 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
472
473 /* Discard the token being shifted unless it is eof. */
5912531f
DM
474 if (parser->yychar != YYEOF)
475 parser->yychar = YYEMPTY;
0de566d7 476
1654d593
DM
477 YYPUSHSTACK;
478 ps->state = yyn;
5912531f 479 ps->val = parser->yylval;
ec8ec19f 480 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
503de470 481 ps->savestack_ix = PL_savestack_ix;
9388183f 482#ifdef DEBUGGING
1654d593 483 ps->name = (const char *)(yytname[yytoken]);
9388183f 484#endif
0de566d7 485
0de566d7
DM
486 /* Count tokens shifted since error; after three, turn off error
487 status. */
5912531f
DM
488 if (parser->yyerrstatus)
489 parser->yyerrstatus--;
0de566d7 490
0de566d7
DM
491 goto yynewstate;
492
493
494 /*-----------------------------------------------------------.
495 | yydefault -- do the default action for the current state. |
496 `-----------------------------------------------------------*/
497 yydefault:
498 yyn = yydefact[yystate];
499 if (yyn == 0)
500 goto yyerrlab;
501 goto yyreduce;
502
503
504 /*-----------------------------.
505 | yyreduce -- Do a reduction. |
506 `-----------------------------*/
507 yyreduce:
508 /* yyn is the number of a rule to reduce with. */
5912531f 509 parser->yylen = yyr2[yyn];
0de566d7
DM
510
511 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 512 "$$ = $1".
0de566d7
DM
513
514 Otherwise, the following line sets YYVAL to garbage.
515 This behavior is undocumented and Bison
516 users should not rely upon it. Assigning to YYVAL
517 unconditionally makes the parser a bit smaller, and it avoids a
518 GCC warning that YYVAL may be used uninitialized. */
5912531f 519 yyval = ps[1-parser->yylen].val;
0de566d7 520
1654d593 521 YY_STACK_PRINT(parser);
0de566d7 522 YY_REDUCE_PRINT (yyn);
718a7425 523
0de566d7
DM
524 switch (yyn) {
525
0de566d7
DM
526
527#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 528
bc463c31 529#ifdef PERL_IN_MADLY_C
f05e27e5
DM
530# define IVAL(i) (i)->tk_lval.ival
531# define PVAL(p) (p)->tk_lval.pval
532# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
533# define TOKEN_FREE(a) token_free(a)
534# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
535# define IF_MAD(a,b) (a)
536# define DO_MAD(a) a
537# define MAD
bc463c31 538#else
f05e27e5
DM
539# define IVAL(i) (i)
540# define PVAL(p) (p)
541# define TOKEN_GETMAD(a,b,c)
542# define TOKEN_FREE(a)
543# define OP_GETMAD(a,b,c)
544# define IF_MAD(a,b) (b)
545# define DO_MAD(a)
546# undef MAD
bc463c31 547#endif
7b57b0ea 548
f05e27e5
DM
549/* contains all the rule actions; auto-generated from perly.y */
550#include "perly.act"
551
93a17b20 552 }
0de566d7 553
670f3923
DM
554 /* any just-reduced ops with the op_latefreed flag cleared need to be
555 * freed; the rest need the flag resetting */
556 {
557 int i;
5912531f 558 for (i=0; i< parser->yylen; i++) {
8c63ea58 559#ifndef DISABLE_STACK_FREE
1654d593
DM
560 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
561 && ps[-i].val.opval)
670f3923 562 {
1654d593
DM
563 ps[-i].val.opval->op_latefree = 0;
564 if (ps[-i].val.opval->op_latefreed)
565 op_free(ps[-i].val.opval);
670f3923 566 }
8c63ea58
GG
567#endif
568 SvREFCNT_dec(ps[-i].compcv);
670f3923
DM
569 }
570 }
571
5912531f 572 parser->ps = ps -= (parser->yylen-1);
0de566d7 573
05a03161
DM
574 /* Now shift the result of the reduction. Determine what state
575 that goes to, based on the state we popped back to and the rule
576 number reduced by. */
577
1654d593 578 ps->val = yyval;
ec8ec19f 579 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
503de470 580 ps->savestack_ix = PL_savestack_ix;
9388183f 581#ifdef DEBUGGING
1654d593 582 ps->name = (const char *)(yytname [yyr1[yyn]]);
9388183f 583#endif
0de566d7
DM
584
585 yyn = yyr1[yyn];
586
1654d593
DM
587 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
588 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
0de566d7 589 yystate = yytable[yystate];
93a17b20 590 else
0de566d7 591 yystate = yydefgoto[yyn - YYNTOKENS];
1654d593 592 ps->state = yystate;
05a03161 593
0de566d7
DM
594 goto yynewstate;
595
596
597 /*------------------------------------.
598 | yyerrlab -- here on detecting error |
599 `------------------------------------*/
600 yyerrlab:
601 /* If not already recovering from an error, report this error. */
5912531f 602 if (!parser->yyerrstatus) {
07a06489 603 yyerror ("syntax error");
93a17b20 604 }
0de566d7
DM
605
606
5912531f 607 if (parser->yyerrstatus == 3) {
0de566d7
DM
608 /* If just tried and failed to reuse lookahead token after an
609 error, discard it. */
610
611 /* Return failure if at end of input. */
5912531f 612 if (parser->yychar == YYEOF) {
0de566d7 613 /* Pop the error token. */
8c63ea58 614 SvREFCNT_dec(ps->compcv);
0de566d7
DM
615 YYPOPSTACK;
616 /* Pop the rest of the stack. */
22735491 617 while (ps > parser->stack) {
1654d593 618 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
503de470 619 LEAVE_SCOPE(ps->savestack_ix);
1654d593
DM
620 if (yy_type_tab[yystos[ps->state]] == toketype_opval
621 && ps->val.opval)
670f3923 622 {
0539ab63 623 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
8c63ea58
GG
624 if (ps->compcv != PL_compcv) {
625 PL_compcv = ps->compcv;
626 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
718a7425 627 }
1654d593
DM
628 ps->val.opval->op_latefree = 0;
629 op_free(ps->val.opval);
0539ab63 630 }
8c63ea58 631 SvREFCNT_dec(ps->compcv);
0de566d7
DM
632 YYPOPSTACK;
633 }
634 YYABORT;
635 }
636
5912531f 637 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
0e38ac78
GG
638 if (yy_type_tab[yytoken] == toketype_opval)
639 op_free(parser->yylval.opval);
5912531f 640 parser->yychar = YYEMPTY;
0de566d7 641
93a17b20 642 }
0de566d7
DM
643
644 /* Else will try to reuse lookahead token after shifting the error
645 token. */
646 goto yyerrlab1;
647
648
649 /*----------------------------------------------------.
650 | yyerrlab1 -- error raised explicitly by an action. |
651 `----------------------------------------------------*/
652 yyerrlab1:
5912531f 653 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
0de566d7
DM
654
655 for (;;) {
656 yyn = yypact[yystate];
657 if (yyn != YYPACT_NINF) {
658 yyn += YYTERROR;
659 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
660 yyn = yytable[yyn];
661 if (0 < yyn)
662 break;
663 }
664 }
665
666 /* Pop the current state because it cannot handle the error token. */
22735491 667 if (ps == parser->stack)
0de566d7
DM
668 YYABORT;
669
1654d593 670 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
503de470 671 LEAVE_SCOPE(ps->savestack_ix);
1654d593 672 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
0539ab63 673 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
8c63ea58
GG
674 if (ps->compcv != PL_compcv) {
675 PL_compcv = ps->compcv;
676 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
718a7425 677 }
1654d593
DM
678 ps->val.opval->op_latefree = 0;
679 op_free(ps->val.opval);
0539ab63 680 }
8c63ea58 681 SvREFCNT_dec(ps->compcv);
1654d593
DM
682 YYPOPSTACK;
683 yystate = ps->state;
0de566d7 684
1654d593 685 YY_STACK_PRINT(parser);
93a17b20 686 }
0de566d7
DM
687
688 if (yyn == YYFINAL)
689 YYACCEPT;
690
691 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
692
1654d593
DM
693 YYPUSHSTACK;
694 ps->state = yyn;
5912531f 695 ps->val = parser->yylval;
ec8ec19f 696 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
503de470 697 ps->savestack_ix = PL_savestack_ix;
9388183f 698#ifdef DEBUGGING
1654d593 699 ps->name ="<err>";
9388183f 700#endif
0de566d7 701
0de566d7
DM
702 goto yynewstate;
703
704
705 /*-------------------------------------.
706 | yyacceptlab -- YYACCEPT comes here. |
707 `-------------------------------------*/
708 yyacceptlab:
709 yyresult = 0;
8c63ea58
GG
710 for (ps=parser->ps; ps > parser->stack; ps--) {
711 SvREFCNT_dec(ps->compcv);
712 }
22735491 713 parser->ps = parser->stack; /* disable cleanup */
0de566d7
DM
714 goto yyreturn;
715
716 /*-----------------------------------.
717 | yyabortlab -- YYABORT comes here. |
718 `-----------------------------------*/
719 yyabortlab:
720 yyresult = 1;
721 goto yyreturn;
722
0de566d7 723 yyreturn:
e3abe207 724 LEAVE; /* force parser stack cleanup before we return */
0de566d7 725 return yyresult;
e1f15930 726}
66610fdd
RGS
727
728/*
729 * Local variables:
730 * c-indentation-style: bsd
731 * c-basic-offset: 4
732 * indent-tabs-mode: t
733 * End:
734 *
37442d52
RGS
735 * ex: set ts=8 sts=4 sw=4 noet:
736 */