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