This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
smoke signs suppression
[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 208
7e5d8ed2
DM
209 /* Freeing ops on the stack, and the op_latefree / op_latefreed /
210 * op_attached flags:
670f3923
DM
211 *
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
7e5d8ed2
DM
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
670f3923
DM
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
7e5d8ed2
DM
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
670f3923
DM
220 * right place for freeing any SVs attached to the op in threaded
221 * builds.
222 *
7e5d8ed2 223 * However, there is a particular problem if we die in newFOO() called
670f3923
DM
224 * by a reducing action; e.g.
225 *
226 * foo : bar baz boz
227 * { $$ = newFOO($1,$2,$3) }
228 *
229 * where
7e5d8ed2 230 * OP *newFOO { ....; if (...) croak; .... }
670f3923
DM
231 *
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:
234 * * freed them
7e5d8ed2 235 * * left them as is
670f3923 236 * * attached them to part of a larger tree
7e5d8ed2
DM
237 * * attached them to PL_compcv
238 * * attached them to PL_compcv then freed it (as in BEGIN {die } )
670f3923
DM
239 *
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
7e5d8ed2
DM
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.
252 *
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.
258 *
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:
262 * * a parent op
263 * * the parser stack
264 * * a CV
265 * but this would involve reworking all code (core and external) that
266 * manipulate op trees.
670f3923
DM
267 */
268
7e5d8ed2 269 /* clear any reducing ops (1st pass) */
670f3923 270
5912531f 271 for (i=0; i< parser->yylen; i++) {
1654d593
DM
272 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
273 && ps[-i].val.opval) {
7e5d8ed2
DM
274 if ( ! (ps[-i].val.opval->op_attached
275 && !ps[-i].val.opval->op_latefreed))
276 {
277 if (ps[-i].comppad != PL_comppad) {
278 PAD_RESTORE_LOCAL(ps[-i].comppad);
279 }
280 op_free(ps[-i].val.opval);
670f3923 281 }
670f3923
DM
282 }
283 }
284
285 /* now free whole the stack, including the just-reduced ops */
286
1654d593
DM
287 while (ps > &parser->stack[0]) {
288 if (yy_type_tab[yystos[ps->state]] == toketype_opval
289 && ps->val.opval)
670f3923 290 {
1654d593
DM
291 if (ps->comppad != PL_comppad) {
292 PAD_RESTORE_LOCAL(ps->comppad);
718a7425
DM
293 }
294 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
1654d593 295 ps->val.opval->op_latefree = 0;
7e5d8ed2
DM
296 if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
297 op_free(ps->val.opval);
718a7425 298 }
1654d593 299 ps--;
718a7425
DM
300 }
301}
302
303
304
0de566d7
DM
305/*----------.
306| yyparse. |
307`----------*/
308
79072805 309int
bc463c31
DM
310#ifdef PERL_IN_MADLY_C
311Perl_madparse (pTHX)
312#else
0de566d7 313Perl_yyparse (pTHX)
bc463c31 314#endif
79072805 315{
97aff369 316 dVAR;
0de566d7
DM
317 register int yystate;
318 register int yyn;
319 int yyresult;
320
0de566d7 321 /* Lookahead token as an internal (translated) token number. */
714c8e96 322 int yytoken = 0;
0de566d7 323
1654d593 324 SV *parser_sv; /* SV whose PVX holds the parser object */
5912531f 325 register yy_parser *parser; /* the parser object */
1654d593 326 register yy_stack_frame *ps; /* current parser stack frame */
a0d0e21e 327
1654d593
DM
328#define YYPOPSTACK parser->ps = --ps
329#define YYPUSHSTACK parser->ps = ++ps
0de566d7
DM
330
331 /* The variables used to return semantic value and location from the
5912531f 332 action routines: ie $$. */
0de566d7
DM
333 YYSTYPE yyval;
334
bc463c31
DM
335#ifndef PERL_IN_MADLY_C
336# ifdef PERL_MAD
00e74f14
NC
337 if (PL_madskills)
338 return madparse();
bc463c31 339# endif
81d86705
NC
340#endif
341
0de566d7
DM
342 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
343
0de566d7 344 ENTER; /* force stack free before we return */
5912531f 345 SAVEVPTR(PL_parser);
12fbd33b 346
1654d593
DM
347 parser_sv = newSV(sizeof(yy_parser)
348 + (YYINITDEPTH-1) * sizeof(yy_stack_frame));
349 SAVEFREESV(parser_sv);
5912531f 350 PL_parser = parser = (yy_parser*) SvPVX(parser_sv);
1654d593
DM
351 ps = (yy_stack_frame*) &parser->stack[0];
352 parser->ps = ps;
353
354 parser->stack_size = YYINITDEPTH;
355
718a7425 356 /* cleanup the parse stack on premature exit */
1654d593 357 SAVEDESTRUCTOR_X(S_clear_yystack, (void*) parser_sv);
718a7425 358
79072805 359
1654d593 360 ps->state = 0;
5912531f
DM
361 parser->yyerrstatus = 0;
362 parser->yychar = YYEMPTY; /* Cause a token to be read. */
0de566d7 363
0de566d7
DM
364/*------------------------------------------------------------.
365| yynewstate -- Push a new state, which is found in yystate. |
366`------------------------------------------------------------*/
367 yynewstate:
0de566d7 368
1654d593 369 yystate = ps->state;
05a03161 370
670f3923 371 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7 372
1654d593
DM
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;
670f3923
DM
376 }
377
5912531f 378 parser->yylen = 0;
0de566d7 379
1654d593
DM
380 {
381 size_t size = ps - &parser->stack[0] + 1;
0de566d7 382
1654d593
DM
383 /* grow the stack? We always leave 1 spare slot,
384 * in case of a '' -> 'foo' reduction */
0de566d7 385
1654d593
DM
386 if (size >= parser->stack_size - 1) {
387 /* this will croak on insufficient memory */
388 parser->stack_size *= 2;
5912531f
DM
389 PL_parser = parser =
390 (yy_parser*) SvGROW(parser_sv, sizeof(yy_parser)
1654d593 391 + (parser->stack_size-1) * sizeof(yy_stack_frame));
0de566d7 392
1654d593
DM
393 /* readdress any pointers into realloced parser object */
394 ps = parser->ps = &parser->stack[0] + size -1;
670f3923 395
1654d593
DM
396 YYDPRINTF((Perl_debug_log,
397 "parser stack size increased to %lu frames\n",
398 (unsigned long int)parser->stack_size));
399 }
93a17b20 400 }
0de566d7 401
0de566d7
DM
402/* Do appropriate processing given the current state. */
403/* Read a lookahead token if we need one and don't already have one. */
0de566d7
DM
404
405 /* First try to decide what to do without reference to lookahead token. */
406
407 yyn = yypact[yystate];
408 if (yyn == YYPACT_NINF)
409 goto yydefault;
410
411 /* Not known => get a lookahead token if don't already have one. */
412
413 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
5912531f 414 if (parser->yychar == YYEMPTY) {
0de566d7 415 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 416#ifdef PERL_IN_MADLY_C
5912531f 417 parser->yychar = PL_madskills ? madlex() : yylex();
f05e27e5 418#else
5912531f 419 parser->yychar = yylex();
81d86705 420#endif
bc463c31 421
12fbd33b 422# ifdef EBCDIC
5912531f
DM
423 if (parser->yychar >= 0 && parser->yychar < 255) {
424 parser->yychar = NATIVE_TO_ASCII(parser->yychar);
12fbd33b
DM
425 }
426# endif
0de566d7
DM
427 }
428
5912531f
DM
429 if (parser->yychar <= YYEOF) {
430 parser->yychar = yytoken = YYEOF;
0de566d7 431 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 432 }
0de566d7 433 else {
5912531f
DM
434 yytoken = YYTRANSLATE (parser->yychar);
435 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
93a17b20 436 }
771df094 437
0de566d7
DM
438 /* If the proper action on seeing token YYTOKEN is to reduce or to
439 detect an error, take that action. */
440 yyn += yytoken;
441 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
442 goto yydefault;
443 yyn = yytable[yyn];
444 if (yyn <= 0) {
445 if (yyn == 0 || yyn == YYTABLE_NINF)
446 goto yyerrlab;
447 yyn = -yyn;
448 goto yyreduce;
449 }
7b57b0ea 450
0de566d7
DM
451 if (yyn == YYFINAL)
452 YYACCEPT;
771df094 453
0de566d7
DM
454 /* Shift the lookahead token. */
455 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
456
457 /* Discard the token being shifted unless it is eof. */
5912531f
DM
458 if (parser->yychar != YYEOF)
459 parser->yychar = YYEMPTY;
0de566d7 460
1654d593
DM
461 YYPUSHSTACK;
462 ps->state = yyn;
5912531f 463 ps->val = parser->yylval;
1654d593 464 ps->comppad = PL_comppad;
9388183f 465#ifdef DEBUGGING
1654d593 466 ps->name = (const char *)(yytname[yytoken]);
9388183f 467#endif
0de566d7 468
0de566d7
DM
469 /* Count tokens shifted since error; after three, turn off error
470 status. */
5912531f
DM
471 if (parser->yyerrstatus)
472 parser->yyerrstatus--;
0de566d7 473
0de566d7
DM
474 goto yynewstate;
475
476
477 /*-----------------------------------------------------------.
478 | yydefault -- do the default action for the current state. |
479 `-----------------------------------------------------------*/
480 yydefault:
481 yyn = yydefact[yystate];
482 if (yyn == 0)
483 goto yyerrlab;
484 goto yyreduce;
485
486
487 /*-----------------------------.
488 | yyreduce -- Do a reduction. |
489 `-----------------------------*/
490 yyreduce:
491 /* yyn is the number of a rule to reduce with. */
5912531f 492 parser->yylen = yyr2[yyn];
0de566d7
DM
493
494 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 495 "$$ = $1".
0de566d7
DM
496
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. */
5912531f 502 yyval = ps[1-parser->yylen].val;
0de566d7 503
1654d593 504 YY_STACK_PRINT(parser);
0de566d7 505 YY_REDUCE_PRINT (yyn);
718a7425 506
0de566d7
DM
507 switch (yyn) {
508
0de566d7
DM
509
510#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 511
bc463c31 512#ifdef PERL_IN_MADLY_C
f05e27e5
DM
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)
519# define DO_MAD(a) a
520# define MAD
bc463c31 521#else
f05e27e5
DM
522# define IVAL(i) (i)
523# define PVAL(p) (p)
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)
528# define DO_MAD(a)
529# undef MAD
bc463c31 530#endif
7b57b0ea 531
f05e27e5
DM
532/* contains all the rule actions; auto-generated from perly.y */
533#include "perly.act"
534
93a17b20 535 }
0de566d7 536
670f3923
DM
537 /* any just-reduced ops with the op_latefreed flag cleared need to be
538 * freed; the rest need the flag resetting */
539 {
540 int i;
5912531f 541 for (i=0; i< parser->yylen; i++) {
1654d593
DM
542 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
543 && ps[-i].val.opval)
670f3923 544 {
1654d593
DM
545 ps[-i].val.opval->op_latefree = 0;
546 if (ps[-i].val.opval->op_latefreed)
547 op_free(ps[-i].val.opval);
670f3923
DM
548 }
549 }
550 }
551
5912531f 552 parser->ps = ps -= (parser->yylen-1);
0de566d7 553
05a03161
DM
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. */
557
1654d593
DM
558 ps->val = yyval;
559 ps->comppad = PL_comppad;
9388183f 560#ifdef DEBUGGING
1654d593 561 ps->name = (const char *)(yytname [yyr1[yyn]]);
9388183f 562#endif
0de566d7
DM
563
564 yyn = yyr1[yyn];
565
1654d593
DM
566 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
567 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
0de566d7 568 yystate = yytable[yystate];
93a17b20 569 else
0de566d7 570 yystate = yydefgoto[yyn - YYNTOKENS];
1654d593 571 ps->state = yystate;
05a03161 572
0de566d7
DM
573 goto yynewstate;
574
575
576 /*------------------------------------.
577 | yyerrlab -- here on detecting error |
578 `------------------------------------*/
579 yyerrlab:
580 /* If not already recovering from an error, report this error. */
5912531f 581 if (!parser->yyerrstatus) {
07a06489 582 yyerror ("syntax error");
93a17b20 583 }
0de566d7
DM
584
585
5912531f 586 if (parser->yyerrstatus == 3) {
0de566d7
DM
587 /* If just tried and failed to reuse lookahead token after an
588 error, discard it. */
589
590 /* Return failure if at end of input. */
5912531f 591 if (parser->yychar == YYEOF) {
0de566d7
DM
592 /* Pop the error token. */
593 YYPOPSTACK;
594 /* Pop the rest of the stack. */
1654d593
DM
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
598 && ps->val.opval)
670f3923 599 {
0539ab63 600 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
1654d593
DM
601 if (ps->comppad != PL_comppad) {
602 PAD_RESTORE_LOCAL(ps->comppad);
718a7425 603 }
1654d593
DM
604 ps->val.opval->op_latefree = 0;
605 op_free(ps->val.opval);
0539ab63 606 }
0de566d7
DM
607 YYPOPSTACK;
608 }
609 YYABORT;
610 }
611
5912531f
DM
612 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
613 parser->yychar = YYEMPTY;
0de566d7 614
93a17b20 615 }
0de566d7
DM
616
617 /* Else will try to reuse lookahead token after shifting the error
618 token. */
619 goto yyerrlab1;
620
621
622 /*----------------------------------------------------.
623 | yyerrlab1 -- error raised explicitly by an action. |
624 `----------------------------------------------------*/
625 yyerrlab1:
5912531f 626 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
0de566d7
DM
627
628 for (;;) {
629 yyn = yypact[yystate];
630 if (yyn != YYPACT_NINF) {
631 yyn += YYTERROR;
632 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
633 yyn = yytable[yyn];
634 if (0 < yyn)
635 break;
636 }
637 }
638
639 /* Pop the current state because it cannot handle the error token. */
1654d593 640 if (ps == &parser->stack[0])
0de566d7
DM
641 YYABORT;
642
1654d593
DM
643 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
644 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
0539ab63 645 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
1654d593
DM
646 if (ps->comppad != PL_comppad) {
647 PAD_RESTORE_LOCAL(ps->comppad);
718a7425 648 }
1654d593
DM
649 ps->val.opval->op_latefree = 0;
650 op_free(ps->val.opval);
0539ab63 651 }
1654d593
DM
652 YYPOPSTACK;
653 yystate = ps->state;
0de566d7 654
1654d593 655 YY_STACK_PRINT(parser);
93a17b20 656 }
0de566d7
DM
657
658 if (yyn == YYFINAL)
659 YYACCEPT;
660
661 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
662
1654d593
DM
663 YYPUSHSTACK;
664 ps->state = yyn;
5912531f 665 ps->val = parser->yylval;
1654d593 666 ps->comppad = PL_comppad;
9388183f 667#ifdef DEBUGGING
1654d593 668 ps->name ="<err>";
9388183f 669#endif
0de566d7 670
0de566d7
DM
671 goto yynewstate;
672
673
674 /*-------------------------------------.
675 | yyacceptlab -- YYACCEPT comes here. |
676 `-------------------------------------*/
677 yyacceptlab:
678 yyresult = 0;
1654d593 679 parser->ps = &parser->stack[0]; /* disable cleanup */
0de566d7
DM
680 goto yyreturn;
681
682 /*-----------------------------------.
683 | yyabortlab -- YYABORT comes here. |
684 `-----------------------------------*/
685 yyabortlab:
686 yyresult = 1;
687 goto yyreturn;
688
0de566d7 689 yyreturn:
c86b7e91 690 LEAVE; /* force stack free before we return */
0de566d7 691 return yyresult;
e1f15930 692}
66610fdd
RGS
693
694/*
695 * Local variables:
696 * c-indentation-style: bsd
697 * c-basic-offset: 4
698 * indent-tabs-mode: t
699 * End:
700 *
37442d52
RGS
701 * ex: set ts=8 sts=4 sw=4 noet:
702 */