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