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