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