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