This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fe9acc8bcf7ed843b2abf8f5e11f69bbf53a105d
[perl5.git] / perly.c
1 /*    perly.c
2  *
3  *    Copyright (c) 2004, 2005, 2006 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
28
29 /* allow stack size to grow effectively without limit */
30 #define YYMAXDEPTH 10000000
31
32 #include "EXTERN.h"
33 #define PERL_IN_PERLY_C
34 #include "perl.h"
35
36 typedef unsigned char yytype_uint8;
37 typedef signed char yytype_int8;
38 typedef unsigned short int yytype_uint16;
39 typedef short int yytype_int16;
40 typedef signed char yysigned_char;
41
42 #ifdef DEBUGGING
43 #  define YYDEBUG 1
44 #else
45 #  define YYDEBUG 0
46 #endif
47
48 /* contains all the parser state tables; auto-generated from perly.y */
49 #include "perly.tab"
50
51 # define YYSIZE_T size_t
52
53 #define yyerrok         (yyerrstatus = 0)
54 #define yyclearin       (yychar = YYEMPTY)
55 #define YYEMPTY         (-2)
56 #define YYEOF           0
57
58 #define YYACCEPT        goto yyacceptlab
59 #define YYABORT         goto yyabortlab
60 #define YYERROR         goto yyerrlab1
61
62
63 /* Like YYERROR except do call yyerror.  This remains here temporarily
64    to ease the transition to the new meaning of YYERROR, for GCC.
65    Once GCC version 2 has supplanted version 1, this can go.  */
66
67 #define YYFAIL          goto yyerrlab
68
69 #define YYRECOVERING()  (!!yyerrstatus)
70
71 #define YYBACKUP(Token, Value)                                  \
72 do                                                              \
73     if (yychar == YYEMPTY && yylen == 1) {                      \
74         yychar = (Token);                                       \
75         yylval = (Value);                                       \
76         yytoken = YYTRANSLATE (yychar);                         \
77         YYPOPSTACK;                                             \
78         goto yybackup;                                          \
79     }                                                           \
80     else {                                                      \
81         yyerror ("syntax error: cannot back up");               \
82         YYERROR;                                                \
83     }                                                           \
84 while (0)
85
86 #define YYTERROR        1
87 #define YYERRCODE       256
88
89 /* Enable debugging if requested.  */
90 #ifdef DEBUGGING
91
92 #  define yydebug (DEBUG_p_TEST)
93
94 #  define YYFPRINTF PerlIO_printf
95
96 #  define YYDPRINTF(Args)                       \
97 do {                                            \
98     if (yydebug)                                \
99         YYFPRINTF Args;                         \
100 } while (0)
101
102 #  define YYDSYMPRINTF(Title, Token, Value)                     \
103 do {                                                            \
104     if (yydebug) {                                              \
105         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
106         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
107         YYFPRINTF (Perl_debug_log, "\n");                       \
108     }                                                           \
109 } while (0)
110
111 /*--------------------------------.
112 | Print this symbol on YYOUTPUT.  |
113 `--------------------------------*/
114
115 static void
116 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
117 {
118     if (yytype < YYNTOKENS) {
119         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
120 #   ifdef YYPRINT
121         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
122 #   else
123         YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
124 #   endif
125     }
126     else
127         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
128
129     YYFPRINTF (yyoutput, ")");
130 }
131
132
133 /*  yy_stack_print()
134  *  print the top 8 items on the parse stack.  The args have the same
135  *  meanings as the local vars in yyparse() of the same name */
136
137 static void
138 yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
139 {
140     int i;
141     int start = 1;
142     int count = (int)(yyssp - yyss);
143
144     if (count > 8) {
145         start = count - 8 + 1;
146         count = 8;
147     }
148
149     PerlIO_printf(Perl_debug_log, "\nindex:");
150     for (i=0; i < count; i++)
151         PerlIO_printf(Perl_debug_log, " %8d", start+i);
152     PerlIO_printf(Perl_debug_log, "\nstate:");
153     for (i=0; i < count; i++)
154         PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
155     PerlIO_printf(Perl_debug_log, "\ntoken:");
156     for (i=0; i < count; i++)
157         PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
158     PerlIO_printf(Perl_debug_log, "\nvalue:");
159     for (i=0; i < count; i++) {
160         switch (yy_type_tab[yystos[yyss[start+i]]]) {
161         case toketype_opval:
162             PerlIO_printf(Perl_debug_log, " %8.8s",
163                   yyvs[start+i].opval
164                     ? PL_op_name[yyvs[start+i].opval->op_type]
165                     : "(NULL)"
166             );
167             break;
168 #ifndef PERL_IN_MADLY_C
169         case toketype_p_tkval:
170             PerlIO_printf(Perl_debug_log, " %8.8s",
171                   yyvs[start+i].pval ? yyvs[start+i].pval : "(NULL)");
172             break;
173
174         case toketype_i_tkval:
175 #endif
176         case toketype_ival:
177             PerlIO_printf(Perl_debug_log, " %8"IVdf, yyvs[start+i].ival);
178             break;
179         default:
180             PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
181         }
182     }
183     PerlIO_printf(Perl_debug_log, "\n\n");
184 }
185
186 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)               \
187 do {                                                            \
188     if (yydebug && DEBUG_v_TEST)                                \
189         yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
190 } while (0)
191
192
193 /*------------------------------------------------.
194 | Report that the YYRULE is going to be reduced.  |
195 `------------------------------------------------*/
196
197 static void
198 yy_reduce_print (pTHX_ int yyrule)
199 {
200     int yyi;
201     const unsigned int yylineno = yyrline[yyrule];
202     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
203                           yyrule - 1, yylineno);
204     /* Print the symbols being reduced, and their result.  */
205     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
206         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
207     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
208 }
209
210 #  define YY_REDUCE_PRINT(Rule)         \
211 do {                                    \
212     if (yydebug)                        \
213         yy_reduce_print (aTHX_ Rule);           \
214 } while (0)
215
216 #else /* !DEBUGGING */
217 #  define YYDPRINTF(Args)
218 #  define YYDSYMPRINTF(Title, Token, Value)
219 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
220 #  define YY_REDUCE_PRINT(Rule)
221 #endif /* !DEBUGGING */
222
223
224 /* YYINITDEPTH -- initial size of the parser's stacks.  */
225 #ifndef YYINITDEPTH
226 # define YYINITDEPTH 200
227 #endif
228
229
230 #if YYERROR_VERBOSE
231 #  ifndef yystrlen
232 #    if defined (__GLIBC__) && defined (_STRING_H)
233 #      define yystrlen strlen
234 #    else
235 /* Return the length of YYSTR.  */
236 static YYSIZE_T
237 yystrlen (const char *yystr)
238 {
239     register const char *yys = yystr;
240
241     while (*yys++ != '\0')
242         continue;
243
244     return yys - yystr - 1;
245 }
246 #    endif
247 #  endif
248
249 #  ifndef yystpcpy
250 #    if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
251 #      define yystpcpy stpcpy
252 #    else
253 /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
254    YYDEST.  */
255 static char *
256 yystpcpy (pTHX_ char *yydest, const char *yysrc)
257 {
258     register char *yyd = yydest;
259     register const char *yys = yysrc;
260
261     while ((*yyd++ = *yys++) != '\0')
262         continue;
263
264     return yyd - 1;
265 }
266 #    endif
267 #  endif
268
269 #endif /* !YYERROR_VERBOSE */
270
271 /*----------.
272 | yyparse.  |
273 `----------*/
274
275 int
276 #ifdef PERL_IN_MADLY_C
277 Perl_madparse (pTHX)
278 #else
279 Perl_yyparse (pTHX)
280 #endif
281 {
282     dVAR;
283     int yychar; /* The lookahead symbol.  */
284     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
285     int yynerrs; /* Number of syntax errors so far.  */
286     register int yystate;
287     register int yyn;
288     int yyresult;
289
290     /* Number of tokens to shift before error messages enabled.  */
291     int yyerrstatus;
292     /* Lookahead token as an internal (translated) token number.  */
293     int yytoken = 0;
294
295     /* two stacks and their tools:
296           yyss: related to states,
297           yyvs: related to semantic values,
298
299           Refer to the stacks thru separate pointers, to allow yyoverflow
300           to reallocate them elsewhere.  */
301
302     /* The state stack.  */
303     short *yyss;
304     register short *yyssp;
305
306     /* The semantic value stack.  */
307     YYSTYPE *yyvs;
308     register YYSTYPE *yyvsp;
309
310     /* for ease of re-allocation and automatic freeing, have two SVs whose
311       * SvPVX points to the stacks */
312     SV *yyss_sv, *yyvs_sv;
313
314 #ifdef DEBUGGING
315     /* maintain also a stack of token/rule names for debugging with -Dpv */
316     const char **yyns, **yynsp;
317     SV *yyns_sv;
318 #  define YYPOPSTACK   (yyvsp--, yyssp--, yynsp--)
319 #else
320 #  define YYPOPSTACK   (yyvsp--, yyssp--)
321 #endif
322
323
324     YYSIZE_T yystacksize = YYINITDEPTH;
325
326     /* The variables used to return semantic value and location from the
327           action routines.  */
328     YYSTYPE yyval;
329
330
331     /* When reducing, the number of symbols on the RHS of the reduced
332           rule.  */
333     int yylen;
334
335     /* keep track of which pad ops are currently using */
336     AV* comppad = PL_comppad;
337
338 #ifndef PERL_IN_MADLY_C
339 #  ifdef PERL_MAD
340     if (PL_madskills)
341         return madparse();
342 #  endif
343 #endif
344
345     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
346
347     ENTER;                      /* force stack free before we return */
348     SAVEVPTR(PL_yycharp);
349     SAVEVPTR(PL_yylvalp);
350     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
351     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
352
353     yyss_sv = newSV(YYINITDEPTH * sizeof(short));
354     yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
355     SAVEFREESV(yyss_sv);
356     SAVEFREESV(yyvs_sv);
357     yyss = (short *) SvPVX(yyss_sv);
358     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
359     /* note that elements zero of yyvs and yyns are not used */
360     yyssp = yyss;
361     yyvsp = yyvs;
362 #ifdef DEBUGGING
363     yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
364     SAVEFREESV(yyns_sv);
365     /* XXX This seems strange to cast char * to char ** */
366     yyns = (const char **) SvPVX(yyns_sv);
367     yynsp = yyns;
368 #endif
369
370     yystate = 0;
371     yyerrstatus = 0;
372     yynerrs = 0;
373     yychar = YYEMPTY;           /* Cause a token to be read.  */
374
375     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
376
377     goto yysetstate;
378
379 /*------------------------------------------------------------.
380 | yynewstate -- Push a new state, which is found in yystate.  |
381 `------------------------------------------------------------*/
382   yynewstate:
383     /* In all cases, when you get here, the value and location stacks
384           have just been pushed. so pushing a state here evens the stacks.
385           */
386     yyssp++;
387
388   yysetstate:
389     *yyssp = yystate;
390
391     if (yyss + yystacksize - 1 <= yyssp) {
392          /* Get the current used size of the three stacks, in elements.  */
393          const YYSIZE_T yysize = yyssp - yyss + 1;
394
395          /* Extend the stack our own way.  */
396          if (YYMAXDEPTH <= yystacksize)
397                goto yyoverflowlab;
398          yystacksize *= 2;
399          if (YYMAXDEPTH < yystacksize)
400                yystacksize = YYMAXDEPTH;
401
402          SvGROW(yyss_sv, yystacksize * sizeof(short));
403          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
404          yyss = (short *) SvPVX(yyss_sv);
405          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
406 #ifdef DEBUGGING
407          SvGROW(yyns_sv, yystacksize * sizeof(char *));
408          /* XXX This seems strange to cast char * to char ** */
409          yyns = (const char **) SvPVX(yyns_sv);
410          if (! yyns)
411                goto yyoverflowlab;
412          yynsp = yyns + yysize - 1;
413 #endif
414          if (!yyss || ! yyvs)
415                goto yyoverflowlab;
416
417          yyssp = yyss + yysize - 1;
418          yyvsp = yyvs + yysize - 1;
419
420
421          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
422                                    (unsigned long int) yystacksize));
423
424          if (yyss + yystacksize - 1 <= yyssp)
425                YYABORT;
426     }
427
428     goto yybackup;
429
430   /*-----------.
431   | yybackup.  |
432   `-----------*/
433   yybackup:
434
435 /* Do appropriate processing given the current state.  */
436 /* Read a lookahead token if we need one and don't already have one.  */
437 /* yyresume: */
438
439     /* First try to decide what to do without reference to lookahead token.  */
440
441     yyn = yypact[yystate];
442     if (yyn == YYPACT_NINF)
443         goto yydefault;
444
445     /* Not known => get a lookahead token if don't already have one.  */
446
447     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
448     if (yychar == YYEMPTY) {
449         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
450 #ifdef PERL_IN_MADLY_C
451         yychar = PL_madskills ? madlex() : yylex();
452 #else
453         yychar = yylex();
454 #endif
455
456 #  ifdef EBCDIC
457         if (yychar >= 0 && yychar < 255) {
458             yychar = NATIVE_TO_ASCII(yychar);
459         }
460 #  endif
461     }
462
463     if (yychar <= YYEOF) {
464         yychar = yytoken = YYEOF;
465         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
466     }
467     else {
468         yytoken = YYTRANSLATE (yychar);
469         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
470     }
471
472     /* If the proper action on seeing token YYTOKEN is to reduce or to
473           detect an error, take that action.  */
474     yyn += yytoken;
475     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
476         goto yydefault;
477     yyn = yytable[yyn];
478     if (yyn <= 0) {
479         if (yyn == 0 || yyn == YYTABLE_NINF)
480             goto yyerrlab;
481         yyn = -yyn;
482         goto yyreduce;
483     }
484
485     if (yyn == YYFINAL)
486         YYACCEPT;
487
488     /* Shift the lookahead token.  */
489     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
490
491     /* Discard the token being shifted unless it is eof.  */
492     if (yychar != YYEOF)
493         yychar = YYEMPTY;
494
495     *++yyvsp = yylval;
496 #ifdef DEBUGGING
497     *++yynsp = (const char *)(yytname[yytoken]);
498 #endif
499
500
501     /* Count tokens shifted since error; after three, turn off error
502           status.  */
503     if (yyerrstatus)
504         yyerrstatus--;
505
506     yystate = yyn;
507     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
508
509     goto yynewstate;
510
511
512   /*-----------------------------------------------------------.
513   | yydefault -- do the default action for the current state.  |
514   `-----------------------------------------------------------*/
515   yydefault:
516     yyn = yydefact[yystate];
517     if (yyn == 0)
518         goto yyerrlab;
519     goto yyreduce;
520
521
522   /*-----------------------------.
523   | yyreduce -- Do a reduction.  |
524   `-----------------------------*/
525   yyreduce:
526     /* yyn is the number of a rule to reduce with.  */
527     yylen = yyr2[yyn];
528
529     /* If YYLEN is nonzero, implement the default value of the action:
530       "$$ = $1".
531
532       Otherwise, the following line sets YYVAL to garbage.
533       This behavior is undocumented and Bison
534       users should not rely upon it.  Assigning to YYVAL
535       unconditionally makes the parser a bit smaller, and it avoids a
536       GCC warning that YYVAL may be used uninitialized.  */
537     yyval = yyvsp[1-yylen];
538
539
540     YY_REDUCE_PRINT (yyn);
541     switch (yyn) {
542
543
544 #define dep() deprecate("\"do\" to call subroutines")
545
546 #ifdef PERL_IN_MADLY_C
547 #  define IVAL(i) (i)->tk_lval.ival
548 #  define PVAL(p) (p)->tk_lval.pval
549 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
550 #  define TOKEN_FREE(a) token_free(a)
551 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
552 #  define IF_MAD(a,b) (a)
553 #  define DO_MAD(a) a
554 #  define MAD
555 #else
556 #  define IVAL(i) (i)
557 #  define PVAL(p) (p)
558 #  define TOKEN_GETMAD(a,b,c)
559 #  define TOKEN_FREE(a)
560 #  define OP_GETMAD(a,b,c)
561 #  define IF_MAD(a,b) (b)
562 #  define DO_MAD(a)
563 #  undef MAD
564 #endif
565
566 /* contains all the rule actions; auto-generated from perly.y */
567 #include "perly.act"
568
569     }
570
571     yyvsp -= yylen;
572     yyssp -= yylen;
573 #ifdef DEBUGGING
574     yynsp -= yylen;
575 #endif
576
577
578     *++yyvsp = yyval;
579     comppad = PL_comppad;
580
581 #ifdef DEBUGGING
582     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
583 #endif
584
585     /* Now shift the result of the reduction.  Determine what state
586           that goes to, based on the state we popped back to and the rule
587           number reduced by.  */
588
589     yyn = yyr1[yyn];
590
591     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
592     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
593         yystate = yytable[yystate];
594     else
595         yystate = yydefgoto[yyn - YYNTOKENS];
596
597     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
598
599 #ifdef DEBUGGING
600     /* tmp push yystate for stack print; this is normally pushed later in
601      * yynewstate */
602     yyssp++;
603     *yyssp = yystate;
604     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
605     yyssp--;
606 #endif
607
608     goto yynewstate;
609
610
611   /*------------------------------------.
612   | yyerrlab -- here on detecting error |
613   `------------------------------------*/
614   yyerrlab:
615     /* If not already recovering from an error, report this error.  */
616     if (!yyerrstatus) {
617         ++yynerrs;
618 #if YYERROR_VERBOSE
619         yyn = yypact[yystate];
620
621         if (YYPACT_NINF < yyn && yyn < YYLAST) {
622             YYSIZE_T yysize = 0;
623             const int yytype = YYTRANSLATE (yychar);
624             char *yymsg;
625             int yyx, yycount;
626
627             yycount = 0;
628             /* Start YYX at -YYN if negative to avoid negative indexes in
629                   YYCHECK.  */
630             for (yyx = yyn < 0 ? -yyn : 0;
631                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
632                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
633                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
634             yysize += yystrlen ("syntax error, unexpected ") + 1;
635             yysize += yystrlen (yytname[yytype]);
636             Newx(yymsg, yysize, char *);
637             if (yymsg != 0) {
638                 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
639                 yyp = yystpcpy (yyp, yytname[yytype]);
640
641                 if (yycount < 5) {
642                     yycount = 0;
643                     for (yyx = yyn < 0 ? -yyn : 0;
644                               yyx < (int) (sizeof (yytname) / sizeof (char *));
645                               yyx++)
646                     {
647                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
648                             const char *yyq = ! yycount ?
649                                                     ", expecting " : " or ";
650                             yyp = yystpcpy (yyp, yyq);
651                             yyp = yystpcpy (yyp, yytname[yyx]);
652                             yycount++;
653                         }
654                     }
655                 }
656                 yyerror (yymsg);
657                 YYSTACK_FREE (yymsg);
658             }
659             else
660                 yyerror ("syntax error; also virtual memory exhausted");
661         }
662         else
663 #endif /* YYERROR_VERBOSE */
664             yyerror ("syntax error");
665     }
666
667
668     if (yyerrstatus == 3) {
669         /* If just tried and failed to reuse lookahead token after an
670               error, discard it.  */
671
672         /* Return failure if at end of input.  */
673         if (yychar == YYEOF) {
674             /* Pop the error token.  */
675             YYPOPSTACK;
676             /* Pop the rest of the stack.  */
677             PAD_RESTORE_LOCAL(comppad);
678             while (yyss < yyssp) {
679                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
680                 if (yy_type_tab[yystos[*yyssp]] == toketype_padval) {
681                     comppad = yyvsp->padval;
682                     PAD_RESTORE_LOCAL(comppad);
683                 }
684                 else if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
685                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
686                     op_free(yyvsp->opval);
687                 }
688                 YYPOPSTACK;
689             }
690             YYABORT;
691         }
692
693         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
694         yychar = YYEMPTY;
695
696     }
697
698     /* Else will try to reuse lookahead token after shifting the error
699           token.  */
700     goto yyerrlab1;
701
702
703   /*----------------------------------------------------.
704   | yyerrlab1 -- error raised explicitly by an action.  |
705   `----------------------------------------------------*/
706   yyerrlab1:
707     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
708
709     PAD_RESTORE_LOCAL(comppad);
710     for (;;) {
711         yyn = yypact[yystate];
712         if (yyn != YYPACT_NINF) {
713             yyn += YYTERROR;
714             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
715                 yyn = yytable[yyn];
716                 if (0 < yyn)
717                     break;
718             }
719         }
720
721         /* Pop the current state because it cannot handle the error token.  */
722         if (yyssp == yyss)
723             YYABORT;
724
725         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
726         if (yy_type_tab[yystos[*yyssp]] == toketype_padval) {
727             comppad = yyvsp->padval;
728             PAD_RESTORE_LOCAL(comppad);
729         }
730         else if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
731             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
732             op_free(yyvsp->opval);
733         }
734         yyvsp--;
735 #ifdef DEBUGGING
736         yynsp--;
737 #endif
738         yystate = *--yyssp;
739
740         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
741     }
742
743     if (yyn == YYFINAL)
744         YYACCEPT;
745
746     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
747
748     *++yyvsp = yylval;
749 #ifdef DEBUGGING
750     *++yynsp ="<err>";
751 #endif
752
753     yystate = yyn;
754     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
755
756     goto yynewstate;
757
758
759   /*-------------------------------------.
760   | yyacceptlab -- YYACCEPT comes here.  |
761   `-------------------------------------*/
762   yyacceptlab:
763     yyresult = 0;
764     goto yyreturn;
765
766   /*-----------------------------------.
767   | yyabortlab -- YYABORT comes here.  |
768   `-----------------------------------*/
769   yyabortlab:
770     yyresult = 1;
771     goto yyreturn;
772
773   /*----------------------------------------------.
774   | yyoverflowlab -- parser overflow comes here.  |
775   `----------------------------------------------*/
776   yyoverflowlab:
777     yyerror ("parser stack overflow");
778     yyresult = 2;
779     /* Fall through.  */
780
781   yyreturn:
782
783     LEAVE;                      /* force stack free before we return */
784
785     return yyresult;
786 }
787
788 /*
789  * Local variables:
790  * c-indentation-style: bsd
791  * c-basic-offset: 4
792  * indent-tabs-mode: t
793  * End:
794  *
795  * ex: set ts=8 sts=4 sw=4 noet:
796  */