In Carp, if B is loaded use it to get the name of the bad caller override.
[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 #ifdef DEBUGGING
38 #  define YYDEBUG 1
39 #else
40 #  define YYDEBUG 0
41 #endif
42
43 /* contains all the parser state tables; auto-generated from perly.y */
44 #include "perly.tab"
45
46 # define YYSIZE_T size_t
47
48 #define YYEOF           0
49 #define YYTERROR        1
50
51 #define YYACCEPT        goto yyacceptlab
52 #define YYABORT         goto yyabortlab
53 #define YYERROR         goto yyerrlab1
54
55 /* Enable debugging if requested.  */
56 #ifdef DEBUGGING
57
58 #  define yydebug (DEBUG_p_TEST)
59
60 #  define YYFPRINTF PerlIO_printf
61
62 #  define YYDPRINTF(Args)                       \
63 do {                                            \
64     if (yydebug)                                \
65         YYFPRINTF Args;                         \
66 } while (0)
67
68 #  define YYDSYMPRINTF(Title, Token, Value)                     \
69 do {                                                            \
70     if (yydebug) {                                              \
71         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
72         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
73         YYFPRINTF (Perl_debug_log, "\n");                       \
74     }                                                           \
75 } while (0)
76
77 /*--------------------------------.
78 | Print this symbol on YYOUTPUT.  |
79 `--------------------------------*/
80
81 static void
82 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
83 {
84     if (yytype < YYNTOKENS) {
85         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
86 #   ifdef YYPRINT
87         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
88 #   else
89         YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
90 #   endif
91     }
92     else
93         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
94
95     YYFPRINTF (yyoutput, ")");
96 }
97
98
99 /*  yy_stack_print()
100  *  print the top 8 items on the parse stack.
101  */
102
103 static void
104 yy_stack_print (pTHX_ const yy_parser *parser)
105 {
106     const yy_stack_frame *ps, *min;
107
108     min = parser->ps - 8 + 1;
109     if (min <= parser->stack)
110         min = parser->stack + 1;
111
112     PerlIO_printf(Perl_debug_log, "\nindex:");
113     for (ps = min; ps <= parser->ps; ps++)
114         PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
115
116     PerlIO_printf(Perl_debug_log, "\nstate:");
117     for (ps = min; ps <= parser->ps; ps++)
118         PerlIO_printf(Perl_debug_log, " %8d", ps->state);
119
120     PerlIO_printf(Perl_debug_log, "\ntoken:");
121     for (ps = min; ps <= parser->ps; ps++)
122         PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
123
124     PerlIO_printf(Perl_debug_log, "\nvalue:");
125     for (ps = min; ps <= parser->ps; ps++) {
126         switch (yy_type_tab[yystos[ps->state]]) {
127         case toketype_opval:
128             PerlIO_printf(Perl_debug_log, " %8.8s",
129                   ps->val.opval
130                     ? PL_op_name[ps->val.opval->op_type]
131                     : "(Nullop)"
132             );
133             break;
134 #ifndef PERL_IN_MADLY_C
135         case toketype_p_tkval:
136             PerlIO_printf(Perl_debug_log, " %8.8s",
137                   ps->val.pval ? ps->val.pval : "(NULL)");
138             break;
139
140         case toketype_i_tkval:
141 #endif
142         case toketype_ival:
143             PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
144             break;
145         default:
146             PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
147         }
148     }
149     PerlIO_printf(Perl_debug_log, "\n\n");
150 }
151
152 #  define YY_STACK_PRINT(parser)        \
153 do {                                    \
154     if (yydebug && DEBUG_v_TEST)        \
155         yy_stack_print (aTHX_ parser);  \
156 } while (0)
157
158
159 /*------------------------------------------------.
160 | Report that the YYRULE is going to be reduced.  |
161 `------------------------------------------------*/
162
163 static void
164 yy_reduce_print (pTHX_ int yyrule)
165 {
166     int yyi;
167     const unsigned int yylineno = yyrline[yyrule];
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)         \
177 do {                                    \
178     if (yydebug)                        \
179         yy_reduce_print (aTHX_ Rule);           \
180 } while (0)
181
182 #else /* !DEBUGGING */
183 #  define YYDPRINTF(Args)
184 #  define YYDSYMPRINTF(Title, Token, Value)
185 #  define YY_STACK_PRINT(parser)
186 #  define YY_REDUCE_PRINT(Rule)
187 #endif /* !DEBUGGING */
188
189 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
190  * parse stack, thus avoiding leaks if we die  */
191
192 static void
193 S_clear_yystack(pTHX_  const yy_parser *parser)
194 {
195     yy_stack_frame *ps     = parser->ps;
196     int i = 0;
197
198     if (!parser->stack || ps == parser->stack)
199         return;
200
201     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
202
203     /* Freeing ops on the stack, and the op_latefree / op_latefreed /
204      * op_attached flags:
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
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
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
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
214      * right place for freeing any SVs attached to the op in threaded
215      * builds.
216      *
217      * However, there is a particular problem if we die in newFOO() called
218      * by a reducing action; e.g.
219      *
220      *    foo : bar baz boz
221      *        { $$ = newFOO($1,$2,$3) }
222      *
223      * where
224      *  OP *newFOO { ....; if (...) croak; .... }
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
229      *    * left them as is
230      *    * attached them to part of a larger tree
231      *    * attached them to PL_compcv
232      *    * attached them to PL_compcv then freed it (as in BEGIN {die } )
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
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.
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
266
267
268 #ifdef DISABLE_STACK_FREE
269     for (i=0; i< parser->yylen; i++) {
270         SvREFCNT_dec(ps[-i].compcv);
271     }
272     ps -= parser->yylen;
273 #else
274     /* clear any reducing ops (1st pass) */
275
276     for (i=0; i< parser->yylen; i++) {
277         LEAVE_SCOPE(ps[-i].savestack_ix);
278         if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
279             && ps[-i].val.opval) {
280             if ( ! (ps[-i].val.opval->op_attached
281                     && !ps[-i].val.opval->op_latefreed))
282             {
283                 if (ps[-i].compcv != PL_compcv) {
284                     PL_compcv = ps[-i].compcv;
285                     PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
286                 }
287                 op_free(ps[-i].val.opval);
288             }
289         }
290     }
291 #endif
292
293     /* now free whole the stack, including the just-reduced ops */
294
295     while (ps > parser->stack) {
296         LEAVE_SCOPE(ps->savestack_ix);
297         if (yy_type_tab[yystos[ps->state]] == toketype_opval
298             && ps->val.opval)
299         {
300             if (ps->compcv != PL_compcv) {
301                 PL_compcv = ps->compcv;
302                 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
303             }
304             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
305 #ifndef DISABLE_STACK_FREE
306             ps->val.opval->op_latefree  = 0;
307             if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
308 #endif
309                 op_free(ps->val.opval);
310         }
311         SvREFCNT_dec(ps->compcv);
312         ps--;
313     }
314 }
315
316
317 /*----------.
318 | yyparse.  |
319 `----------*/
320
321 int
322 #ifdef PERL_IN_MADLY_C
323 Perl_madparse (pTHX)
324 #else
325 Perl_yyparse (pTHX)
326 #endif
327 {
328     dVAR;
329     register int yystate;
330     register int yyn;
331     int yyresult;
332
333     /* Lookahead token as an internal (translated) token number.  */
334     int yytoken = 0;
335
336     register yy_parser *parser;     /* the parser object */
337     register yy_stack_frame  *ps;   /* current parser stack frame */
338
339 #define YYPOPSTACK   parser->ps = --ps
340 #define YYPUSHSTACK  parser->ps = ++ps
341
342     /* The variable used to return semantic value and location from the
343           action routines: ie $$.  */
344     YYSTYPE yyval;
345
346 #ifndef PERL_IN_MADLY_C
347 #  ifdef PERL_MAD
348     if (PL_madskills)
349         return madparse();
350 #  endif
351 #endif
352
353     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
354
355     parser = PL_parser;
356     ps = parser->ps;
357
358     ENTER;  /* force parser stack cleanup before we return */
359     SAVEDESTRUCTOR_X(S_clear_yystack, parser);
360
361 /*------------------------------------------------------------.
362 | yynewstate -- Push a new state, which is found in yystate.  |
363 `------------------------------------------------------------*/
364   yynewstate:
365
366     yystate = ps->state;
367
368     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
369
370 #ifndef DISABLE_STACK_FREE
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;
374     }
375 #endif
376
377     parser->yylen = 0;
378
379     {
380         size_t size = ps - parser->stack + 1;
381
382         /* grow the stack? We always leave 1 spare slot,
383          * in case of a '' -> 'foo' reduction */
384
385         if (size >= (size_t)parser->stack_size - 1) {
386             /* this will croak on insufficient memory */
387             parser->stack_size *= 2;
388             Renew(parser->stack, parser->stack_size, yy_stack_frame);
389             ps = parser->ps = parser->stack + size -1;
390
391             YYDPRINTF((Perl_debug_log,
392                             "parser stack size increased to %lu frames\n",
393                             (unsigned long int)parser->stack_size));
394         }
395     }
396
397 /* Do appropriate processing given the current state.  */
398 /* Read a lookahead token if we need one and don't already have one.  */
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.  */
409     if (parser->yychar == YYEMPTY) {
410         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
411 #ifdef PERL_IN_MADLY_C
412         parser->yychar = PL_madskills ? madlex() : yylex();
413 #else
414         parser->yychar = yylex();
415 #endif
416
417 #  ifdef EBCDIC
418         if (parser->yychar >= 0 && parser->yychar < 255) {
419             parser->yychar = NATIVE_TO_ASCII(parser->yychar);
420         }
421 #  endif
422     }
423
424     if (parser->yychar <= YYEOF) {
425         parser->yychar = yytoken = YYEOF;
426         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
427     }
428     else {
429         yytoken = YYTRANSLATE (parser->yychar);
430         YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
431     }
432
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     }
445
446     if (yyn == YYFINAL)
447         YYACCEPT;
448
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.  */
453     if (parser->yychar != YYEOF)
454         parser->yychar = YYEMPTY;
455
456     YYPUSHSTACK;
457     ps->state   = yyn;
458     ps->val     = parser->yylval;
459     ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
460     ps->savestack_ix = PL_savestack_ix;
461 #ifdef DEBUGGING
462     ps->name    = (const char *)(yytname[yytoken]);
463 #endif
464
465     /* Count tokens shifted since error; after three, turn off error
466           status.  */
467     if (parser->yyerrstatus)
468         parser->yyerrstatus--;
469
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.  */
488     parser->yylen = yyr2[yyn];
489
490     /* If YYLEN is nonzero, implement the default value of the action:
491       "$$ = $1".
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.  */
498     yyval = ps[1-parser->yylen].val;
499
500     YY_STACK_PRINT(parser);
501     YY_REDUCE_PRINT (yyn);
502
503     switch (yyn) {
504
505
506 #define dep() deprecate("\"do\" to call subroutines")
507
508 #ifdef PERL_IN_MADLY_C
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
517 #else
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
526 #endif
527
528 /* contains all the rule actions; auto-generated from perly.y */
529 #include "perly.act"
530
531     }
532
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;
537         for (i=0; i< parser->yylen; i++) {
538 #ifndef DISABLE_STACK_FREE
539             if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
540                 && ps[-i].val.opval)
541             {
542                 ps[-i].val.opval->op_latefree = 0;
543                 if (ps[-i].val.opval->op_latefreed)
544                     op_free(ps[-i].val.opval);
545             }
546 #endif
547             SvREFCNT_dec(ps[-i].compcv);
548         }
549     }
550
551     parser->ps = ps -= (parser->yylen-1);
552
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
557     ps->val     = yyval;
558     ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
559     ps->savestack_ix = PL_savestack_ix;
560 #ifdef DEBUGGING
561     ps->name    = (const char *)(yytname [yyr1[yyn]]);
562 #endif
563
564     yyn = yyr1[yyn];
565
566     yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
567     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
568         yystate = yytable[yystate];
569     else
570         yystate = yydefgoto[yyn - YYNTOKENS];
571     ps->state = yystate;
572
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.  */
581     if (!parser->yyerrstatus) {
582         yyerror ("syntax error");
583     }
584
585
586     if (parser->yyerrstatus == 3) {
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.  */
591         if (parser->yychar == YYEOF) {
592             /* Pop the error token.  */
593             SvREFCNT_dec(ps->compcv);
594             YYPOPSTACK;
595             /* Pop the rest of the stack.  */
596             while (ps > parser->stack) {
597                 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
598                 LEAVE_SCOPE(ps->savestack_ix);
599                 if (yy_type_tab[yystos[ps->state]] == toketype_opval
600                         && ps->val.opval)
601                 {
602                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
603                     if (ps->compcv != PL_compcv) {
604                         PL_compcv = ps->compcv;
605                         PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
606                     }
607                     ps->val.opval->op_latefree  = 0;
608                     op_free(ps->val.opval);
609                 }
610                 SvREFCNT_dec(ps->compcv);
611                 YYPOPSTACK;
612             }
613             YYABORT;
614         }
615
616         YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
617         if (yy_type_tab[yytoken] == toketype_opval)
618             op_free(parser->yylval.opval);
619         parser->yychar = YYEMPTY;
620
621     }
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:
632     parser->yyerrstatus = 3;    /* Each real token shifted decrements this.  */
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.  */
646         if (ps == parser->stack)
647             YYABORT;
648
649         YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
650         LEAVE_SCOPE(ps->savestack_ix);
651         if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
652             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
653             if (ps->compcv != PL_compcv) {
654                 PL_compcv = ps->compcv;
655                 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
656             }
657             ps->val.opval->op_latefree  = 0;
658             op_free(ps->val.opval);
659         }
660         SvREFCNT_dec(ps->compcv);
661         YYPOPSTACK;
662         yystate = ps->state;
663
664         YY_STACK_PRINT(parser);
665     }
666
667     if (yyn == YYFINAL)
668         YYACCEPT;
669
670     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
671
672     YYPUSHSTACK;
673     ps->state   = yyn;
674     ps->val     = parser->yylval;
675     ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
676     ps->savestack_ix = PL_savestack_ix;
677 #ifdef DEBUGGING
678     ps->name    ="<err>";
679 #endif
680
681     goto yynewstate;
682
683
684   /*-------------------------------------.
685   | yyacceptlab -- YYACCEPT comes here.  |
686   `-------------------------------------*/
687   yyacceptlab:
688     yyresult = 0;
689     for (ps=parser->ps; ps > parser->stack; ps--) {
690         SvREFCNT_dec(ps->compcv);
691     }
692     parser->ps = parser->stack; /* disable cleanup */
693     goto yyreturn;
694
695   /*-----------------------------------.
696   | yyabortlab -- YYABORT comes here.  |
697   `-----------------------------------*/
698   yyabortlab:
699     yyresult = 1;
700     goto yyreturn;
701
702   yyreturn:
703     LEAVE;      /* force parser stack cleanup before we return */
704     return yyresult;
705 }
706
707 /*
708  * Local variables:
709  * c-indentation-style: bsd
710  * c-basic-offset: 4
711  * indent-tabs-mode: t
712  * End:
713  *
714  * ex: set ts=8 sts=4 sw=4 noet:
715  */