This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Various updates and fixes to some of the SysV IPC ops and their tests
[perl5.git] / perly.c
CommitLineData
0de566d7
DM
1/* perly.c
2 *
2eee27d7
SS
3 * Copyright (c) 2004, 2005, 2006, 2007, 2008,
4 * 2009, 2010, 2011 by Larry Wall and others
0de566d7
DM
5 *
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8 *
9 * Note that this file was originally generated as an output from
10 * GNU bison version 1.875, but now the code is statically maintained
f05e27e5
DM
11 * and edited; the bits that are dependent on perly.y are now
12 * #included from the files perly.tab and perly.act.
0de566d7
DM
13 *
14 * Here is an important copyright statement from the original, generated
15 * file:
16 *
17 * As a special exception, when this file is copied by Bison into a
18 * Bison output file, you may use that output file without
19 * restriction. This special exception was added by the Free
20 * Software Foundation in version 1.24 of Bison.
bc463c31 21 *
0de566d7
DM
22 */
23
79072805 24#include "EXTERN.h"
864dbfa3 25#define PERL_IN_PERLY_C
79072805 26#include "perl.h"
30d9c59b 27#include "feature.h"
d3d9da4a 28#include "keywords.h"
09bef843 29
3797f23d
DM
30typedef unsigned char yytype_uint8;
31typedef signed char yytype_int8;
32typedef unsigned short int yytype_uint16;
33typedef short int yytype_int16;
0de566d7
DM
34typedef signed char yysigned_char;
35
28ac2b49
Z
36/* YYINITDEPTH -- initial size of the parser's stacks. */
37#define YYINITDEPTH 200
38
599f1ac6
FC
39#ifdef YYDEBUG
40# undef YYDEBUG
41#endif
42#ifdef DEBUGGING
43# define YYDEBUG 1
44#else
45# define YYDEBUG 0
46#endif
47
b3045d9c
FC
48#ifndef YY_NULL
49# define YY_NULL 0
93a17b20 50#endif
09bef843 51
f39ff1f3
DM
52#ifndef YY_NULLPTR
53# define YY_NULLPTR NULL
54#endif
55
a9d4ef0f
DIM
56#ifndef YY_CAST
57# ifdef __cplusplus
58# define YY_CAST(Type, Val) static_cast<Type> (Val)
59# define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast<Type> (Val)
60# else
61# define YY_CAST(Type, Val) ((Type) (Val))
62# define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val))
63# endif
64#endif
65
66#ifndef YY_ATTRIBUTE_UNUSED
67# if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
68# define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__))
69# else
70# define YY_ATTRIBUTE_UNUSED
71# endif
72#endif
73
f05e27e5
DM
74/* contains all the parser state tables; auto-generated from perly.y */
75#include "perly.tab"
0de566d7
DM
76
77# define YYSIZE_T size_t
78
0de566d7 79#define YYEOF 0
07a06489 80#define YYTERROR 1
0de566d7
DM
81
82#define YYACCEPT goto yyacceptlab
83#define YYABORT goto yyabortlab
84#define YYERROR goto yyerrlab1
85
0de566d7 86/* Enable debugging if requested. */
9388183f 87#ifdef DEBUGGING
0de566d7
DM
88
89# define yydebug (DEBUG_p_TEST)
90
91# define YYFPRINTF PerlIO_printf
92
93# define YYDPRINTF(Args) \
94do { \
95 if (yydebug) \
96 YYFPRINTF Args; \
97} while (0)
98
9388183f 99# define YYDSYMPRINTF(Title, Token, Value) \
0de566d7
DM
100do { \
101 if (yydebug) { \
102 YYFPRINTF (Perl_debug_log, "%s ", Title); \
356f4fed 103 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
0de566d7
DM
104 YYFPRINTF (Perl_debug_log, "\n"); \
105 } \
106} while (0)
107
108/*--------------------------------.
109| Print this symbol on YYOUTPUT. |
110`--------------------------------*/
111
112static void
356f4fed 113yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
0de566d7 114{
dc3bf405 115 PERL_UNUSED_CONTEXT;
0de566d7
DM
116 if (yytype < YYNTOKENS) {
117 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
118# ifdef YYPRINT
119 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
9388183f 120# else
147e3846 121 YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival);
0de566d7
DM
122# endif
123 }
124 else
125 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
126
0de566d7
DM
127 YYFPRINTF (yyoutput, ")");
128}
129
130
9388183f 131/* yy_stack_print()
1654d593
DM
132 * print the top 8 items on the parse stack.
133 */
0de566d7
DM
134
135static void
1654d593 136yy_stack_print (pTHX_ const yy_parser *parser)
0de566d7 137{
1654d593 138 const yy_stack_frame *ps, *min;
9388183f 139
2d29f438 140 min = parser->ps - 8 + 1;
22735491
DM
141 if (min <= parser->stack)
142 min = parser->stack + 1;
9388183f
CB
143
144 PerlIO_printf(Perl_debug_log, "\nindex:");
1654d593 145 for (ps = min; ps <= parser->ps; ps++)
00c0e1ee 146 PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
1654d593 147
9388183f 148 PerlIO_printf(Perl_debug_log, "\nstate:");
1654d593
DM
149 for (ps = min; ps <= parser->ps; ps++)
150 PerlIO_printf(Perl_debug_log, " %8d", ps->state);
151
9388183f 152 PerlIO_printf(Perl_debug_log, "\ntoken:");
1654d593
DM
153 for (ps = min; ps <= parser->ps; ps++)
154 PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
155
9388183f 156 PerlIO_printf(Perl_debug_log, "\nvalue:");
1654d593
DM
157 for (ps = min; ps <= parser->ps; ps++) {
158 switch (yy_type_tab[yystos[ps->state]]) {
d5c6462e 159 case toketype_opval:
21612876 160 PerlIO_printf(Perl_debug_log, " %8.8s",
1654d593
DM
161 ps->val.opval
162 ? PL_op_name[ps->val.opval->op_type]
670f3923 163 : "(Nullop)"
21612876 164 );
d5c6462e 165 break;
d5c6462e 166 case toketype_ival:
147e3846 167 PerlIO_printf(Perl_debug_log, " %8" IVdf, (IV)ps->val.ival);
d5c6462e
DM
168 break;
169 default:
147e3846 170 PerlIO_printf(Perl_debug_log, " %8" UVxf, (UV)ps->val.ival);
d5c6462e 171 }
21612876 172 }
9388183f 173 PerlIO_printf(Perl_debug_log, "\n\n");
0de566d7
DM
174}
175
1654d593
DM
176# define YY_STACK_PRINT(parser) \
177do { \
178 if (yydebug && DEBUG_v_TEST) \
179 yy_stack_print (aTHX_ parser); \
0de566d7
DM
180} while (0)
181
09bef843 182
0de566d7
DM
183/*------------------------------------------------.
184| Report that the YYRULE is going to be reduced. |
185`------------------------------------------------*/
186
187static void
188yy_reduce_print (pTHX_ int yyrule)
189{
190 int yyi;
df35152e 191 const unsigned int yylineno = yyrline[yyrule];
0de566d7
DM
192 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
193 yyrule - 1, yylineno);
194 /* Print the symbols being reduced, and their result. */
f39ff1f3
DM
195#if PERL_BISON_VERSION >= 30000 /* 3.0+ */
196 for (yyi = 0; yyi < yyr2[yyrule]; yyi++)
197 YYFPRINTF (Perl_debug_log, "%s ",
198 yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]);
199#else
0de566d7
DM
200 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
201 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
f39ff1f3 202#endif
0de566d7
DM
203 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
204}
205
206# define YY_REDUCE_PRINT(Rule) \
207do { \
208 if (yydebug) \
209 yy_reduce_print (aTHX_ Rule); \
210} while (0)
211
212#else /* !DEBUGGING */
213# define YYDPRINTF(Args)
9388183f 214# define YYDSYMPRINTF(Title, Token, Value)
1654d593 215# define YY_STACK_PRINT(parser)
0de566d7
DM
216# define YY_REDUCE_PRINT(Rule)
217#endif /* !DEBUGGING */
218
718a7425
DM
219/* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
220 * parse stack, thus avoiding leaks if we die */
221
222static void
22735491 223S_clear_yystack(pTHX_ const yy_parser *parser)
718a7425 224{
1654d593 225 yy_stack_frame *ps = parser->ps;
0934c9d9 226 int i = 0;
718a7425 227
28ac2b49 228 if (!parser->stack)
718a7425 229 return;
1654d593 230
718a7425 231 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
670f3923 232
8c63ea58
GG
233 for (i=0; i< parser->yylen; i++) {
234 SvREFCNT_dec(ps[-i].compcv);
235 }
0aded6e1 236 ps -= parser->yylen;
670f3923
DM
237
238 /* now free whole the stack, including the just-reduced ops */
239
22735491 240 while (ps > parser->stack) {
503de470 241 LEAVE_SCOPE(ps->savestack_ix);
1654d593
DM
242 if (yy_type_tab[yystos[ps->state]] == toketype_opval
243 && ps->val.opval)
670f3923 244 {
a293d0fd 245 if (ps->compcv && (ps->compcv != PL_compcv)) {
8c63ea58
GG
246 PL_compcv = ps->compcv;
247 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
325e1816 248 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
718a7425
DM
249 }
250 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
571a568a 251 op_free(ps->val.opval);
718a7425 252 }
8c63ea58 253 SvREFCNT_dec(ps->compcv);
1654d593 254 ps--;
718a7425 255 }
28ac2b49
Z
256
257 Safefree(parser->stack);
718a7425
DM
258}
259
718a7425 260
0de566d7
DM
261/*----------.
262| yyparse. |
263`----------*/
264
79072805 265int
28ac2b49 266Perl_yyparse (pTHX_ int gramtype)
79072805 267{
eb578fdb
KW
268 int yystate;
269 int yyn;
0de566d7
DM
270 int yyresult;
271
0de566d7 272 /* Lookahead token as an internal (translated) token number. */
714c8e96 273 int yytoken = 0;
0de566d7 274
eb578fdb
KW
275 yy_parser *parser; /* the parser object */
276 yy_stack_frame *ps; /* current parser stack frame */
a0d0e21e 277
1654d593
DM
278#define YYPOPSTACK parser->ps = --ps
279#define YYPUSHSTACK parser->ps = ++ps
0de566d7 280
acdf0a21 281 /* The variable used to return semantic value and location from the
5912531f 282 action routines: ie $$. */
0de566d7
DM
283 YYSTYPE yyval;
284
0de566d7
DM
285 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
286
acdf0a21 287 parser = PL_parser;
1654d593 288
28ac2b49
Z
289 ENTER; /* force parser state cleanup/restoration before we return */
290 SAVEPPTR(parser->yylval.pval);
291 SAVEINT(parser->yychar);
292 SAVEINT(parser->yyerrstatus);
28ac2b49
Z
293 SAVEINT(parser->yylen);
294 SAVEVPTR(parser->stack);
df13534a 295 SAVEVPTR(parser->stack_max1);
28ac2b49
Z
296 SAVEVPTR(parser->ps);
297
298 /* initialise state for this parse */
299 parser->yychar = gramtype;
0f8490d1
DM
300 yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
301
28ac2b49 302 parser->yyerrstatus = 0;
28ac2b49
Z
303 parser->yylen = 0;
304 Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
df13534a 305 parser->stack_max1 = parser->stack + YYINITDEPTH - 1;
28ac2b49
Z
306 ps = parser->ps = parser->stack;
307 ps->state = 0;
e3abe207 308 SAVEDESTRUCTOR_X(S_clear_yystack, parser);
0de566d7 309
fbe80aaa
DM
310 while (1) {
311 /* main loop: shift some tokens, then reduce when possible */
5019c3ae 312
ddbfb8f6
DM
313 while (1) {
314 /* shift a token, or quit when it's possible to reduce */
5019c3ae 315
ddbfb8f6 316 yystate = ps->state;
5019c3ae 317
ddbfb8f6 318 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
3c217e57 319
ddbfb8f6 320 parser->yylen = 0;
3c217e57 321
df13534a
DM
322 /* Grow the stack? We always leave 1 spare slot, in case of a
323 * '' -> 'foo' reduction.
324 * Note that stack_max1 points to the (top-1)th allocated stack
325 * element to make this check faster */
326
327 if (ps >= parser->stack_max1) {
328 Size_t pos = ps - parser->stack;
329 Size_t newsize = 2 * (parser->stack_max1 + 2 - parser->stack);
330 /* this will croak on insufficient memory */
331 Renew(parser->stack, newsize, yy_stack_frame);
332 ps = parser->ps = parser->stack + pos;
333 parser->stack_max1 = parser->stack + newsize - 1;
334
335 YYDPRINTF((Perl_debug_log,
336 "parser stack size increased to %lu frames\n",
337 (unsigned long int)newsize));
338 }
339
0f8490d1
DM
340 /* Do appropriate processing given the current state. Read a
341 * lookahead token if we need one and don't already have one.
342 * */
3c217e57 343
0f8490d1
DM
344 /* First try to decide what to do without reference to
345 * lookahead token. */
3c217e57 346
ddbfb8f6
DM
347 yyn = yypact[yystate];
348 if (yyn == YYPACT_NINF)
349 goto yydefault;
3c217e57 350
0f8490d1
DM
351 /* Not known => get a lookahead token if don't already have
352 * one. YYCHAR is either YYEMPTY or YYEOF or a valid
353 * lookahead symbol. */
3c217e57 354
ddbfb8f6
DM
355 if (parser->yychar == YYEMPTY) {
356 YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
357 parser->yychar = yylex();
0f8490d1 358 assert(parser->yychar >= 0);
6d17784b 359 if (parser->yychar == YYEOF) {
0f8490d1 360 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
6d17784b 361 }
0f8490d1
DM
362 /* perly.tab is shipped based on an ASCII system, so need
363 * to index it with characters translated to ASCII.
364 * Although it's not designed for this purpose, we can use
365 * NATIVE_TO_UNI here. It returns its argument on ASCII
366 * platforms, and on EBCDIC translates native to ascii in
46235561
KW
367 * the 0-255 range, leaving every other possible input
368 * unchanged. This jibes with yylex() returning some bare
369 * characters in that range, but all tokens it returns are
370 * either 0, or above 255. There could be a problem if NULs
371 * weren't 0, or were ever returned as raw chars by yylex() */
0f8490d1 372 yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
ddbfb8f6 373 }
3c217e57 374
968f7b32 375 /* make sure no-one's changed yychar since the last call to yylex */
0f8490d1
DM
376 assert(yytoken == YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)));
377 YYDSYMPRINTF("lookahead token is", yytoken, &parser->yylval);
378
3c217e57 379
ddbfb8f6
DM
380 /* If the proper action on seeing token YYTOKEN is to reduce or to
381 * detect an error, take that action.
382 * Casting yyn to unsigned allows a >=0 test to be included as
383 * part of the <=YYLAST test for speed */
384 yyn += yytoken;
385 if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) {
386 yydefault:
387 /* do the default action for the current state. */
388 yyn = yydefact[yystate];
389 if (yyn == 0)
390 goto yyerrlab;
391 break; /* time to reduce */
392 }
3c217e57 393
ddbfb8f6
DM
394 yyn = yytable[yyn];
395 if (yyn <= 0) {
396 if (yyn == 0 || yyn == YYTABLE_NINF)
397 goto yyerrlab;
398 yyn = -yyn;
399 break; /* time to reduce */
400 }
3c217e57 401
ddbfb8f6
DM
402 if (yyn == YYFINAL)
403 YYACCEPT;
3c217e57 404
ddbfb8f6
DM
405 /* Shift the lookahead token. */
406 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
3c217e57 407
ddbfb8f6
DM
408 /* Discard the token being shifted unless it is eof. */
409 if (parser->yychar != YYEOF)
410 parser->yychar = YYEMPTY;
3c217e57 411
ddbfb8f6
DM
412 YYPUSHSTACK;
413 ps->state = yyn;
414 ps->val = parser->yylval;
415 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
416 ps->savestack_ix = PL_savestack_ix;
9388183f 417#ifdef DEBUGGING
ddbfb8f6 418 ps->name = (const char *)(yytname[yytoken]);
9388183f 419#endif
0de566d7 420
ddbfb8f6
DM
421 /* Count tokens shifted since error; after three, turn off error
422 status. */
423 if (parser->yyerrstatus)
424 parser->yyerrstatus--;
0de566d7 425
ddbfb8f6 426 }
0de566d7 427
ddbfb8f6 428 /* Do a reduction */
0de566d7 429
ddbfb8f6
DM
430 /* yyn is the number of a rule to reduce with. */
431 parser->yylen = yyr2[yyn];
0de566d7 432
ddbfb8f6
DM
433 /* If YYLEN is nonzero, implement the default value of the action:
434 "$$ = $1".
0de566d7 435
ddbfb8f6
DM
436 Otherwise, the following line sets YYVAL to garbage.
437 This behavior is undocumented and Bison
438 users should not rely upon it. Assigning to YYVAL
439 unconditionally makes the parser a bit smaller, and it avoids a
440 GCC warning that YYVAL may be used uninitialized. */
441 yyval = ps[1-parser->yylen].val;
0de566d7 442
ddbfb8f6
DM
443 YY_STACK_PRINT(parser);
444 YY_REDUCE_PRINT (yyn);
718a7425 445
ddbfb8f6 446 switch (yyn) {
0de566d7 447
ddbfb8f6 448 /* contains all the rule actions; auto-generated from perly.y */
f05e27e5
DM
449#include "perly.act"
450
ddbfb8f6 451 }
0de566d7 452
ddbfb8f6
DM
453 {
454 int i;
455 for (i=0; i< parser->yylen; i++) {
456 SvREFCNT_dec(ps[-i].compcv);
457 }
458 }
670f3923 459
ddbfb8f6 460 parser->ps = ps -= (parser->yylen-1);
0de566d7 461
ddbfb8f6
DM
462 /* Now shift the result of the reduction. Determine what state
463 that goes to, based on the state we popped back to and the rule
464 number reduced by. */
05a03161 465
ddbfb8f6
DM
466 ps->val = yyval;
467 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
468 ps->savestack_ix = PL_savestack_ix;
9388183f 469#ifdef DEBUGGING
ddbfb8f6 470 ps->name = (const char *)(yytname [yyr1[yyn]]);
9388183f 471#endif
0de566d7 472
ddbfb8f6 473 yyn = yyr1[yyn];
05a03161 474
ddbfb8f6
DM
475 yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
476 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
477 yystate = yytable[yystate];
478 else
479 yystate = yydefgoto[yyn - YYNTOKENS];
480 ps->state = yystate;
0de566d7 481
ddbfb8f6 482 continue;
0de566d7 483
0de566d7 484
ddbfb8f6
DM
485 /*------------------------------------.
486 | yyerrlab -- here on detecting error |
487 `------------------------------------*/
488 yyerrlab:
489 /* If not already recovering from an error, report this error. */
490 if (!parser->yyerrstatus) {
491 yyerror ("syntax error");
492 }
0de566d7 493
0de566d7 494
ddbfb8f6
DM
495 if (parser->yyerrstatus == 3) {
496 /* If just tried and failed to reuse lookahead token after an
497 error, discard it. */
498
499 /* Return failure if at end of input. */
500 if (parser->yychar == YYEOF) {
501 /* Pop the error token. */
502 SvREFCNT_dec(ps->compcv);
503 YYPOPSTACK;
504 /* Pop the rest of the stack. */
505 while (ps > parser->stack) {
506 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
507 LEAVE_SCOPE(ps->savestack_ix);
508 if (yy_type_tab[yystos[ps->state]] == toketype_opval
509 && ps->val.opval)
510 {
511 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
512 if (ps->compcv != PL_compcv) {
513 PL_compcv = ps->compcv;
514 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
515 }
516 op_free(ps->val.opval);
517 }
518 SvREFCNT_dec(ps->compcv);
519 YYPOPSTACK;
520 }
521 YYABORT;
522 }
0de566d7 523
ddbfb8f6
DM
524 YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
525 parser->yychar = YYEMPTY;
0de566d7 526
ddbfb8f6 527 }
0de566d7 528
ddbfb8f6
DM
529 /* Else will try to reuse lookahead token after shifting the error
530 token. */
531 goto yyerrlab1;
532
533
534 /*----------------------------------------------------.
535 | yyerrlab1 -- error raised explicitly by an action. |
536 `----------------------------------------------------*/
537 yyerrlab1:
538 parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
539
540 for (;;) {
541 yyn = yypact[yystate];
542 if (yyn != YYPACT_NINF) {
543 yyn += YYTERROR;
544 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
545 yyn = yytable[yyn];
546 if (0 < yyn)
547 break;
548 }
549 }
0de566d7 550
ddbfb8f6
DM
551 /* Pop the current state because it cannot handle the error token. */
552 if (ps == parser->stack)
553 YYABORT;
554
555 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
556 LEAVE_SCOPE(ps->savestack_ix);
557 if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
558 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
559 if (ps->compcv != PL_compcv) {
560 PL_compcv = ps->compcv;
561 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
562 }
563 op_free(ps->val.opval);
564 }
565 SvREFCNT_dec(ps->compcv);
566 YYPOPSTACK;
567 yystate = ps->state;
0de566d7 568
ddbfb8f6
DM
569 YY_STACK_PRINT(parser);
570 }
0de566d7 571
ddbfb8f6
DM
572 if (yyn == YYFINAL)
573 YYACCEPT;
0de566d7 574
ddbfb8f6 575 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
0de566d7 576
ddbfb8f6
DM
577 YYPUSHSTACK;
578 ps->state = yyn;
579 ps->val = parser->yylval;
580 ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
581 ps->savestack_ix = PL_savestack_ix;
9388183f 582#ifdef DEBUGGING
ddbfb8f6 583 ps->name ="<err>";
9388183f 584#endif
0de566d7 585
fbe80aaa 586 } /* main loop */
0de566d7
DM
587
588
589 /*-------------------------------------.
590 | yyacceptlab -- YYACCEPT comes here. |
591 `-------------------------------------*/
592 yyacceptlab:
593 yyresult = 0;
8c63ea58
GG
594 for (ps=parser->ps; ps > parser->stack; ps--) {
595 SvREFCNT_dec(ps->compcv);
596 }
22735491 597 parser->ps = parser->stack; /* disable cleanup */
0de566d7
DM
598 goto yyreturn;
599
600 /*-----------------------------------.
601 | yyabortlab -- YYABORT comes here. |
602 `-----------------------------------*/
603 yyabortlab:
604 yyresult = 1;
605 goto yyreturn;
606
0de566d7 607 yyreturn:
e3abe207 608 LEAVE; /* force parser stack cleanup before we return */
0de566d7 609 return yyresult;
e1f15930 610}
66610fdd
RGS
611
612/*
14d04a33 613 * ex: set ts=8 sts=4 sw=4 et:
37442d52 614 */