This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Test-Simple-0.97_01
[perl5.git] / perly.c
CommitLineData
0de566d7
DM
1/* perly.c
2 *
1129b882 3 * Copyright (c) 2004, 2005, 2006, 2007, 2008 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++)
00c0e1ee 114 PerlIO_printf(Perl_debug_log, " %8d", (int)(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;
0934c9d9 196 int i = 0;
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.
0aded6e1
DM
261 *
262 * XXX DAPM 17/1/07 I've decided its too fragile for now, and so have
263 * disabled it */
264
265#define DISABLE_STACK_FREE
670f3923 266
0aded6e1
DM
267
268#ifdef DISABLE_STACK_FREE
8c63ea58
GG
269 for (i=0; i< parser->yylen; i++) {
270 SvREFCNT_dec(ps[-i].compcv);
271 }
0aded6e1 272 ps -= parser->yylen;
0aded6e1 273#else
7e5d8ed2 274 /* clear any reducing ops (1st pass) */
670f3923 275
5912531f 276 for (i=0; i< parser->yylen; i++) {
503de470 277 LEAVE_SCOPE(ps[-i].savestack_ix);
1654d593
DM
278 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
279 && ps[-i].val.opval) {
7e5d8ed2
DM
280 if ( ! (ps[-i].val.opval->op_attached
281 && !ps[-i].val.opval->op_latefreed))
282 {
8c63ea58
GG
283 if (ps[-i].compcv != PL_compcv) {
284 PL_compcv = ps[-i].compcv;
285 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
7e5d8ed2
DM
286 }
287 op_free(ps[-i].val.opval);
670f3923 288 }
670f3923
DM
289 }
290 }
0aded6e1 291#endif
670f3923
DM
292
293 /* now free whole the stack, including the just-reduced ops */
294
22735491 295 while (ps > parser->stack) {
503de470 296 LEAVE_SCOPE(ps->savestack_ix);
1654d593
DM
297 if (yy_type_tab[yystos[ps->state]] == toketype_opval
298 && ps->val.opval)
670f3923 299 {
8c63ea58
GG
300 if (ps->compcv != PL_compcv) {
301 PL_compcv = ps->compcv;
302 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
718a7425
DM
303 }
304 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
0aded6e1 305#ifndef DISABLE_STACK_FREE
1654d593 306 ps->val.opval->op_latefree = 0;
7e5d8ed2 307 if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
0aded6e1 308#endif
7e5d8ed2 309 op_free(ps->val.opval);
718a7425 310 }
8c63ea58 311 SvREFCNT_dec(ps->compcv);
1654d593 312 ps--;
718a7425
DM
313 }
314}
315
718a7425 316
0de566d7
DM
317/*----------.
318| yyparse. |
319`----------*/
320
79072805 321int
bc463c31
DM
322#ifdef PERL_IN_MADLY_C
323Perl_madparse (pTHX)
324#else
0de566d7 325Perl_yyparse (pTHX)
bc463c31 326#endif
79072805 327{
97aff369 328 dVAR;
0de566d7
DM
329 register int yystate;
330 register int yyn;
331 int yyresult;
332
0de566d7 333 /* Lookahead token as an internal (translated) token number. */
714c8e96 334 int yytoken = 0;
0de566d7 335
5912531f 336 register yy_parser *parser; /* the parser object */
1654d593 337 register yy_stack_frame *ps; /* current parser stack frame */
a0d0e21e 338
1654d593
DM
339#define YYPOPSTACK parser->ps = --ps
340#define YYPUSHSTACK parser->ps = ++ps
0de566d7 341
acdf0a21 342 /* The variable used to return semantic value and location from the
5912531f 343 action routines: ie $$. */
0de566d7
DM
344 YYSTYPE yyval;
345
bc463c31
DM
346#ifndef PERL_IN_MADLY_C
347# ifdef PERL_MAD
00e74f14
NC
348 if (PL_madskills)
349 return madparse();
bc463c31 350# endif
81d86705
NC
351#endif
352
0de566d7
DM
353 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
354
acdf0a21
DM
355 parser = PL_parser;
356 ps = parser->ps;
1654d593 357
e3abe207
DM
358 ENTER; /* force parser stack cleanup before we return */
359 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
0de566d7 360
0de566d7
DM
361/*------------------------------------------------------------.
362| yynewstate -- Push a new state, which is found in yystate. |
363`------------------------------------------------------------*/
364 yynewstate:
0de566d7 365
1654d593 366 yystate = ps->state;
05a03161 367
670f3923 368 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7 369
0aded6e1 370#ifndef DISABLE_STACK_FREE
1654d593
DM
371 if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
372 ps->val.opval->op_latefree = 1;
373 ps->val.opval->op_latefreed = 0;
670f3923 374 }
0aded6e1 375#endif
670f3923 376
5912531f 377 parser->yylen = 0;
0de566d7 378
1654d593 379 {
22735491 380 size_t size = ps - parser->stack + 1;
0de566d7 381
1654d593
DM
382 /* grow the stack? We always leave 1 spare slot,
383 * in case of a '' -> 'foo' reduction */
0de566d7 384
85c508c3 385 if (size >= (size_t)parser->stack_size - 1) {
1654d593
DM
386 /* this will croak on insufficient memory */
387 parser->stack_size *= 2;
22735491
DM
388 Renew(parser->stack, parser->stack_size, yy_stack_frame);
389 ps = parser->ps = parser->stack + size -1;
670f3923 390
1654d593
DM
391 YYDPRINTF((Perl_debug_log,
392 "parser stack size increased to %lu frames\n",
393 (unsigned long int)parser->stack_size));
394 }
93a17b20 395 }
0de566d7 396
0de566d7
DM
397/* Do appropriate processing given the current state. */
398/* Read a lookahead token if we need one and don't already have one. */
0de566d7
DM
399
400 /* First try to decide what to do without reference to lookahead token. */
401
402 yyn = yypact[yystate];
403 if (yyn == YYPACT_NINF)
404 goto yydefault;
405
406 /* Not known => get a lookahead token if don't already have one. */
407
408 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
5912531f 409 if (parser->yychar == YYEMPTY) {
0de566d7 410 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 411#ifdef PERL_IN_MADLY_C
5912531f 412 parser->yychar = PL_madskills ? madlex() : yylex();
f05e27e5 413#else
5912531f 414 parser->yychar = yylex();
81d86705 415#endif
bc463c31 416
12fbd33b 417# ifdef EBCDIC
5912531f
DM
418 if (parser->yychar >= 0 && parser->yychar < 255) {
419 parser->yychar = NATIVE_TO_ASCII(parser->yychar);
12fbd33b
DM
420 }
421# endif
0de566d7
DM
422 }
423
5912531f
DM
424 if (parser->yychar <= YYEOF) {
425 parser->yychar = yytoken = YYEOF;
0de566d7 426 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 427 }
0de566d7 428 else {
5912531f
DM
429 yytoken = YYTRANSLATE (parser->yychar);
430 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
93a17b20 431 }
771df094 432
0de566d7
DM
433 /* If the proper action on seeing token YYTOKEN is to reduce or to
434 detect an error, take that action. */
435 yyn += yytoken;
436 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
437 goto yydefault;
438 yyn = yytable[yyn];
439 if (yyn <= 0) {
440 if (yyn == 0 || yyn == YYTABLE_NINF)
441 goto yyerrlab;
442 yyn = -yyn;
443 goto yyreduce;
444 }
7b57b0ea 445
0de566d7
DM
446 if (yyn == YYFINAL)
447 YYACCEPT;
771df094 448
0de566d7
DM
449 /* Shift the lookahead token. */
450 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
451
452 /* Discard the token being shifted unless it is eof. */
5912531f
DM
453 if (parser->yychar != YYEOF)
454 parser->yychar = YYEMPTY;
0de566d7 455
1654d593
DM
456 YYPUSHSTACK;
457 ps->state = yyn;
5912531f 458 ps->val = parser->yylval;
ec8ec19f 459 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
503de470 460 ps->savestack_ix = PL_savestack_ix;
9388183f 461#ifdef DEBUGGING
1654d593 462 ps->name = (const char *)(yytname[yytoken]);
9388183f 463#endif
0de566d7 464
0de566d7
DM
465 /* Count tokens shifted since error; after three, turn off error
466 status. */
5912531f
DM
467 if (parser->yyerrstatus)
468 parser->yyerrstatus--;
0de566d7 469
0de566d7
DM
470 goto yynewstate;
471
472
473 /*-----------------------------------------------------------.
474 | yydefault -- do the default action for the current state. |
475 `-----------------------------------------------------------*/
476 yydefault:
477 yyn = yydefact[yystate];
478 if (yyn == 0)
479 goto yyerrlab;
480 goto yyreduce;
481
482
483 /*-----------------------------.
484 | yyreduce -- Do a reduction. |
485 `-----------------------------*/
486 yyreduce:
487 /* yyn is the number of a rule to reduce with. */
5912531f 488 parser->yylen = yyr2[yyn];
0de566d7
DM
489
490 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 491 "$$ = $1".
0de566d7
DM
492
493 Otherwise, the following line sets YYVAL to garbage.
494 This behavior is undocumented and Bison
495 users should not rely upon it. Assigning to YYVAL
496 unconditionally makes the parser a bit smaller, and it avoids a
497 GCC warning that YYVAL may be used uninitialized. */
5912531f 498 yyval = ps[1-parser->yylen].val;
0de566d7 499
1654d593 500 YY_STACK_PRINT(parser);
0de566d7 501 YY_REDUCE_PRINT (yyn);
718a7425 502
0de566d7
DM
503 switch (yyn) {
504
0de566d7
DM
505
506#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 507
bc463c31 508#ifdef PERL_IN_MADLY_C
f05e27e5
DM
509# define IVAL(i) (i)->tk_lval.ival
510# define PVAL(p) (p)->tk_lval.pval
511# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
512# define TOKEN_FREE(a) token_free(a)
513# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
514# define IF_MAD(a,b) (a)
515# define DO_MAD(a) a
516# define MAD
bc463c31 517#else
f05e27e5
DM
518# define IVAL(i) (i)
519# define PVAL(p) (p)
520# define TOKEN_GETMAD(a,b,c)
521# define TOKEN_FREE(a)
522# define OP_GETMAD(a,b,c)
523# define IF_MAD(a,b) (b)
524# define DO_MAD(a)
525# undef MAD
bc463c31 526#endif
7b57b0ea 527
f05e27e5
DM
528/* contains all the rule actions; auto-generated from perly.y */
529#include "perly.act"
530
93a17b20 531 }
0de566d7 532
670f3923
DM
533 /* any just-reduced ops with the op_latefreed flag cleared need to be
534 * freed; the rest need the flag resetting */
535 {
536 int i;
5912531f 537 for (i=0; i< parser->yylen; i++) {
8c63ea58 538#ifndef DISABLE_STACK_FREE
1654d593
DM
539 if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
540 && ps[-i].val.opval)
670f3923 541 {
1654d593
DM
542 ps[-i].val.opval->op_latefree = 0;
543 if (ps[-i].val.opval->op_latefreed)
544 op_free(ps[-i].val.opval);
670f3923 545 }
8c63ea58
GG
546#endif
547 SvREFCNT_dec(ps[-i].compcv);
670f3923
DM
548 }
549 }
550
5912531f 551 parser->ps = ps -= (parser->yylen-1);
0de566d7 552
05a03161
DM
553 /* Now shift the result of the reduction. Determine what state
554 that goes to, based on the state we popped back to and the rule
555 number reduced by. */
556
1654d593 557 ps->val = yyval;
ec8ec19f 558 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
503de470 559 ps->savestack_ix = PL_savestack_ix;
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 592 /* Pop the error token. */
8c63ea58 593 SvREFCNT_dec(ps->compcv);
0de566d7
DM
594 YYPOPSTACK;
595 /* Pop the rest of the stack. */
22735491 596 while (ps > parser->stack) {
1654d593 597 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
503de470 598 LEAVE_SCOPE(ps->savestack_ix);
1654d593
DM
599 if (yy_type_tab[yystos[ps->state]] == toketype_opval
600 && ps->val.opval)
670f3923 601 {
0539ab63 602 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
8c63ea58
GG
603 if (ps->compcv != PL_compcv) {
604 PL_compcv = ps->compcv;
605 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
718a7425 606 }
1654d593
DM
607 ps->val.opval->op_latefree = 0;
608 op_free(ps->val.opval);
0539ab63 609 }
8c63ea58 610 SvREFCNT_dec(ps->compcv);
0de566d7
DM
611 YYPOPSTACK;
612 }
613 YYABORT;
614 }
615
5912531f 616 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
0e38ac78
GG
617 if (yy_type_tab[yytoken] == toketype_opval)
618 op_free(parser->yylval.opval);
5912531f 619 parser->yychar = YYEMPTY;
0de566d7 620
93a17b20 621 }
0de566d7
DM
622
623 /* Else will try to reuse lookahead token after shifting the error
624 token. */
625 goto yyerrlab1;
626
627
628 /*----------------------------------------------------.
629 | yyerrlab1 -- error raised explicitly by an action. |
630 `----------------------------------------------------*/
631 yyerrlab1:
5912531f 632 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
0de566d7
DM
633
634 for (;;) {
635 yyn = yypact[yystate];
636 if (yyn != YYPACT_NINF) {
637 yyn += YYTERROR;
638 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
639 yyn = yytable[yyn];
640 if (0 < yyn)
641 break;
642 }
643 }
644
645 /* Pop the current state because it cannot handle the error token. */
22735491 646 if (ps == parser->stack)
0de566d7
DM
647 YYABORT;
648
1654d593 649 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
503de470 650 LEAVE_SCOPE(ps->savestack_ix);
1654d593 651 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
0539ab63 652 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
8c63ea58
GG
653 if (ps->compcv != PL_compcv) {
654 PL_compcv = ps->compcv;
655 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
718a7425 656 }
1654d593
DM
657 ps->val.opval->op_latefree = 0;
658 op_free(ps->val.opval);
0539ab63 659 }
8c63ea58 660 SvREFCNT_dec(ps->compcv);
1654d593
DM
661 YYPOPSTACK;
662 yystate = ps->state;
0de566d7 663
1654d593 664 YY_STACK_PRINT(parser);
93a17b20 665 }
0de566d7
DM
666
667 if (yyn == YYFINAL)
668 YYACCEPT;
669
670 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
671
1654d593
DM
672 YYPUSHSTACK;
673 ps->state = yyn;
5912531f 674 ps->val = parser->yylval;
ec8ec19f 675 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
503de470 676 ps->savestack_ix = PL_savestack_ix;
9388183f 677#ifdef DEBUGGING
1654d593 678 ps->name ="<err>";
9388183f 679#endif
0de566d7 680
0de566d7
DM
681 goto yynewstate;
682
683
684 /*-------------------------------------.
685 | yyacceptlab -- YYACCEPT comes here. |
686 `-------------------------------------*/
687 yyacceptlab:
688 yyresult = 0;
8c63ea58
GG
689 for (ps=parser->ps; ps > parser->stack; ps--) {
690 SvREFCNT_dec(ps->compcv);
691 }
22735491 692 parser->ps = parser->stack; /* disable cleanup */
0de566d7
DM
693 goto yyreturn;
694
695 /*-----------------------------------.
696 | yyabortlab -- YYABORT comes here. |
697 `-----------------------------------*/
698 yyabortlab:
699 yyresult = 1;
700 goto yyreturn;
701
0de566d7 702 yyreturn:
e3abe207 703 LEAVE; /* force parser stack cleanup before we return */
0de566d7 704 return yyresult;
e1f15930 705}
66610fdd
RGS
706
707/*
708 * Local variables:
709 * c-indentation-style: bsd
710 * c-basic-offset: 4
711 * indent-tabs-mode: t
712 * End:
713 *
37442d52
RGS
714 * ex: set ts=8 sts=4 sw=4 noet:
715 */