This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix eval qw(BEGIN{die}) style leaks (second attempt).
[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 /* a snapshot of the current stack position variables for use by
273  * S_clear_yystack */
274
275 typedef struct {
276     short *yyss;
277     short *yyssp;
278     YYSTYPE *yyvsp;
279     AV **yypsp;
280     int yylen;
281 } yystack_positions;
282
283 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
284  * parse stack, thus avoiding leaks if we die  */
285
286 static void
287 S_clear_yystack(pTHX_ const void *p)
288 {
289     yystack_positions *y = (yystack_positions*) p;
290
291     if (!y->yyss)
292         return;
293     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
294     y->yyvsp -= y->yylen; /* ignore the tokens that have just been reduced */
295     y->yyssp -= y->yylen;
296     y->yypsp -= y->yylen;
297     while (y->yyssp > y->yyss) {
298         if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval) {
299             if (*y->yypsp != PL_comppad) {
300                 PAD_RESTORE_LOCAL(*y->yypsp);
301             }
302             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
303             op_free(y->yyvsp->opval);
304         }
305         y->yyvsp--;
306         y->yyssp--;
307         y->yypsp--;
308     }
309 }
310
311
312
313 /*----------.
314 | yyparse.  |
315 `----------*/
316
317 int
318 #ifdef PERL_IN_MADLY_C
319 Perl_madparse (pTHX)
320 #else
321 Perl_yyparse (pTHX)
322 #endif
323 {
324     dVAR;
325     int yychar; /* The lookahead symbol.  */
326     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
327     int yynerrs; /* Number of syntax errors so far.  */
328     register int yystate;
329     register int yyn;
330     int yyresult;
331
332     /* Number of tokens to shift before error messages enabled.  */
333     int yyerrstatus;
334     /* Lookahead token as an internal (translated) token number.  */
335     int yytoken = 0;
336
337     /* three stacks and their tools:
338           yyss: related to states,
339           yyvs: related to semantic values,
340           yyps: current value of PL_comppad for each state
341           
342
343           Refer to the stacks thru separate pointers, to allow yyoverflow
344           to reallocate them elsewhere.  */
345
346     /* The state stack.  */
347     short *yyss;
348     register short *yyssp;
349
350     /* The semantic value stack.  */
351     YYSTYPE *yyvs;
352     register YYSTYPE *yyvsp;
353
354     AV **yyps;
355     AV **yypsp;
356
357     /* for ease of re-allocation and automatic freeing, have three SVs whose
358       * SvPVX points to the stacks */
359     SV *yyss_sv, *yyvs_sv, *yyps_sv;
360     SV *ss_save_sv;
361     yystack_positions *ss_save;
362
363
364 #ifdef DEBUGGING
365     /* maintain also a stack of token/rule names for debugging with -Dpv */
366     const char **yyns, **yynsp;
367     SV *yyns_sv;
368 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--, yynsp--)
369 #else
370 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--)
371 #endif
372
373
374     YYSIZE_T yystacksize = YYINITDEPTH;
375
376     /* The variables used to return semantic value and location from the
377           action routines.  */
378     YYSTYPE yyval;
379
380
381     /* When reducing, the number of symbols on the RHS of the reduced
382           rule.  */
383     int yylen;
384
385 #ifndef PERL_IN_MADLY_C
386 #  ifdef PERL_MAD
387     if (PL_madskills)
388         return madparse();
389 #  endif
390 #endif
391
392     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
393
394     ENTER;                      /* force stack free before we return */
395     SAVEVPTR(PL_yycharp);
396     SAVEVPTR(PL_yylvalp);
397     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
398     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
399
400     yyss_sv = newSV(YYINITDEPTH * sizeof(short));
401     yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
402     yyps_sv = newSV(YYINITDEPTH * sizeof(AV*));
403     ss_save_sv = newSV(sizeof(yystack_positions));
404     SAVEFREESV(yyss_sv);
405     SAVEFREESV(yyvs_sv);
406     SAVEFREESV(yyps_sv);
407     SAVEFREESV(ss_save_sv);
408     yyss = (short *) SvPVX(yyss_sv);
409     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
410     yyps = (AV **) SvPVX(yyps_sv);
411     ss_save = (yystack_positions *) SvPVX(ss_save_sv);
412
413     ss_save->yyss = NULL; /* disarm stack cleanup */
414     /* cleanup the parse stack on premature exit */
415     SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
416
417     /* note that elements zero of yyvs and yyns are not used */
418     yyssp = yyss;
419     yyvsp = yyvs;
420     yypsp = yyps;
421 #ifdef DEBUGGING
422     yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
423     SAVEFREESV(yyns_sv);
424     /* XXX This seems strange to cast char * to char ** */
425     yyns = (const char **) SvPVX(yyns_sv);
426     yynsp = yyns;
427 #endif
428
429     yystate = 0;
430     yyerrstatus = 0;
431     yynerrs = 0;
432     yychar = YYEMPTY;           /* Cause a token to be read.  */
433
434     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
435
436     goto yysetstate;
437
438 /*------------------------------------------------------------.
439 | yynewstate -- Push a new state, which is found in yystate.  |
440 `------------------------------------------------------------*/
441   yynewstate:
442     /* In all cases, when you get here, the value and location stacks
443           have just been pushed. so pushing a state here evens the stacks.
444           */
445     yyssp++;
446
447   yysetstate:
448     *yyssp = yystate;
449
450     if (yyss + yystacksize - 1 <= yyssp) {
451          /* Get the current used size of the three stacks, in elements.  */
452          const YYSIZE_T yysize = yyssp - yyss + 1;
453
454          /* Extend the stack our own way.  */
455          if (YYMAXDEPTH <= yystacksize)
456                goto yyoverflowlab;
457          yystacksize *= 2;
458          if (YYMAXDEPTH < yystacksize)
459                yystacksize = YYMAXDEPTH;
460
461          SvGROW(yyss_sv, yystacksize * sizeof(short));
462          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
463          SvGROW(yyps_sv, yystacksize * sizeof(AV*));
464          yyss = (short *) SvPVX(yyss_sv);
465          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
466          yyps = (AV **) SvPVX(yyps_sv);
467 #ifdef DEBUGGING
468          SvGROW(yyns_sv, yystacksize * sizeof(char *));
469          /* XXX This seems strange to cast char * to char ** */
470          yyns = (const char **) SvPVX(yyns_sv);
471          if (! yyns)
472                goto yyoverflowlab;
473          yynsp = yyns + yysize - 1;
474 #endif
475          if (!yyss || ! yyvs || ! yyps)
476                goto yyoverflowlab;
477
478          yyssp = yyss + yysize - 1;
479          yyvsp = yyvs + yysize - 1;
480          yypsp = yyps + yysize - 1;
481
482
483          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
484                                    (unsigned long int) yystacksize));
485
486          if (yyss + yystacksize - 1 <= yyssp)
487                YYABORT;
488     }
489
490     goto yybackup;
491
492   /*-----------.
493   | yybackup.  |
494   `-----------*/
495   yybackup:
496
497 /* Do appropriate processing given the current state.  */
498 /* Read a lookahead token if we need one and don't already have one.  */
499 /* yyresume: */
500
501     /* First try to decide what to do without reference to lookahead token.  */
502
503     yyn = yypact[yystate];
504     if (yyn == YYPACT_NINF)
505         goto yydefault;
506
507     /* Not known => get a lookahead token if don't already have one.  */
508
509     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
510     if (yychar == YYEMPTY) {
511         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
512 #ifdef PERL_IN_MADLY_C
513         yychar = PL_madskills ? madlex() : yylex();
514 #else
515         yychar = yylex();
516 #endif
517
518 #  ifdef EBCDIC
519         if (yychar >= 0 && yychar < 255) {
520             yychar = NATIVE_TO_ASCII(yychar);
521         }
522 #  endif
523     }
524
525     if (yychar <= YYEOF) {
526         yychar = yytoken = YYEOF;
527         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
528     }
529     else {
530         yytoken = YYTRANSLATE (yychar);
531         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
532     }
533
534     /* If the proper action on seeing token YYTOKEN is to reduce or to
535           detect an error, take that action.  */
536     yyn += yytoken;
537     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
538         goto yydefault;
539     yyn = yytable[yyn];
540     if (yyn <= 0) {
541         if (yyn == 0 || yyn == YYTABLE_NINF)
542             goto yyerrlab;
543         yyn = -yyn;
544         goto yyreduce;
545     }
546
547     if (yyn == YYFINAL)
548         YYACCEPT;
549
550     /* Shift the lookahead token.  */
551     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
552
553     /* Discard the token being shifted unless it is eof.  */
554     if (yychar != YYEOF)
555         yychar = YYEMPTY;
556
557     *++yyvsp = yylval;
558     *++yypsp = PL_comppad;
559 #ifdef DEBUGGING
560     *++yynsp = (const char *)(yytname[yytoken]);
561 #endif
562
563
564     /* Count tokens shifted since error; after three, turn off error
565           status.  */
566     if (yyerrstatus)
567         yyerrstatus--;
568
569     yystate = yyn;
570     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
571
572     goto yynewstate;
573
574
575   /*-----------------------------------------------------------.
576   | yydefault -- do the default action for the current state.  |
577   `-----------------------------------------------------------*/
578   yydefault:
579     yyn = yydefact[yystate];
580     if (yyn == 0)
581         goto yyerrlab;
582     goto yyreduce;
583
584
585   /*-----------------------------.
586   | yyreduce -- Do a reduction.  |
587   `-----------------------------*/
588   yyreduce:
589     /* yyn is the number of a rule to reduce with.  */
590     yylen = yyr2[yyn];
591
592     /* If YYLEN is nonzero, implement the default value of the action:
593       "$$ = $1".
594
595       Otherwise, the following line sets YYVAL to garbage.
596       This behavior is undocumented and Bison
597       users should not rely upon it.  Assigning to YYVAL
598       unconditionally makes the parser a bit smaller, and it avoids a
599       GCC warning that YYVAL may be used uninitialized.  */
600     yyval = yyvsp[1-yylen];
601
602
603     YY_REDUCE_PRINT (yyn);
604
605     /* running external code may trigger a die (eg 'use nosuchmodule'):
606      * record the current stack state so that an unwind will
607      * free all the pesky OPs lounging around on the parse stack */
608     ss_save->yyss = yyss;
609     ss_save->yyssp = yyssp;
610     ss_save->yyvsp = yyvsp;
611     ss_save->yypsp = yypsp;
612     ss_save->yylen = yylen;
613
614     switch (yyn) {
615
616
617 #define dep() deprecate("\"do\" to call subroutines")
618
619 #ifdef PERL_IN_MADLY_C
620 #  define IVAL(i) (i)->tk_lval.ival
621 #  define PVAL(p) (p)->tk_lval.pval
622 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
623 #  define TOKEN_FREE(a) token_free(a)
624 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
625 #  define IF_MAD(a,b) (a)
626 #  define DO_MAD(a) a
627 #  define MAD
628 #else
629 #  define IVAL(i) (i)
630 #  define PVAL(p) (p)
631 #  define TOKEN_GETMAD(a,b,c)
632 #  define TOKEN_FREE(a)
633 #  define OP_GETMAD(a,b,c)
634 #  define IF_MAD(a,b) (b)
635 #  define DO_MAD(a)
636 #  undef MAD
637 #endif
638
639 /* contains all the rule actions; auto-generated from perly.y */
640 #include "perly.act"
641
642     }
643
644     yyvsp -= yylen;
645     yyssp -= yylen;
646     yypsp -= yylen;
647 #ifdef DEBUGGING
648     yynsp -= yylen;
649 #endif
650
651
652     *++yyvsp = yyval;
653     *++yypsp = PL_comppad;
654
655 #ifdef DEBUGGING
656     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
657 #endif
658
659     /* Now shift the result of the reduction.  Determine what state
660           that goes to, based on the state we popped back to and the rule
661           number reduced by.  */
662
663     yyn = yyr1[yyn];
664
665     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
666     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
667         yystate = yytable[yystate];
668     else
669         yystate = yydefgoto[yyn - YYNTOKENS];
670
671     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
672
673 #ifdef DEBUGGING
674     /* tmp push yystate for stack print; this is normally pushed later in
675      * yynewstate */
676     yyssp++;
677     *yyssp = yystate;
678     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
679     if (yydebug && DEBUG_v_TEST)
680     {
681         /* XXX */
682         int i;
683         int start = 1;
684         int count = (int)(yyssp - yyss);
685
686         if (count > 8) {
687             start = count - 8 + 1;
688             count = 8;
689         }
690
691         PerlIO_printf(Perl_debug_log, "cppad:");
692         for (i=0; i < count; i++)
693             PerlIO_printf(Perl_debug_log, " %8p", yyps[start+i]);
694         PerlIO_printf(Perl_debug_log, "\n");
695     }
696     yyssp--;
697 #endif
698
699     goto yynewstate;
700
701
702   /*------------------------------------.
703   | yyerrlab -- here on detecting error |
704   `------------------------------------*/
705   yyerrlab:
706     /* If not already recovering from an error, report this error.  */
707     if (!yyerrstatus) {
708         ++yynerrs;
709 #if YYERROR_VERBOSE
710         yyn = yypact[yystate];
711
712         if (YYPACT_NINF < yyn && yyn < YYLAST) {
713             YYSIZE_T yysize = 0;
714             const int yytype = YYTRANSLATE (yychar);
715             char *yymsg;
716             int yyx, yycount;
717
718             yycount = 0;
719             /* Start YYX at -YYN if negative to avoid negative indexes in
720                   YYCHECK.  */
721             for (yyx = yyn < 0 ? -yyn : 0;
722                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
723                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
724                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
725             yysize += yystrlen ("syntax error, unexpected ") + 1;
726             yysize += yystrlen (yytname[yytype]);
727             Newx(yymsg, yysize, char *);
728             if (yymsg != 0) {
729                 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
730                 yyp = yystpcpy (yyp, yytname[yytype]);
731
732                 if (yycount < 5) {
733                     yycount = 0;
734                     for (yyx = yyn < 0 ? -yyn : 0;
735                               yyx < (int) (sizeof (yytname) / sizeof (char *));
736                               yyx++)
737                     {
738                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
739                             const char *yyq = ! yycount ?
740                                                     ", expecting " : " or ";
741                             yyp = yystpcpy (yyp, yyq);
742                             yyp = yystpcpy (yyp, yytname[yyx]);
743                             yycount++;
744                         }
745                     }
746                 }
747                 yyerror (yymsg);
748                 YYSTACK_FREE (yymsg);
749             }
750             else
751                 yyerror ("syntax error; also virtual memory exhausted");
752         }
753         else
754 #endif /* YYERROR_VERBOSE */
755             yyerror ("syntax error");
756     }
757
758
759     if (yyerrstatus == 3) {
760         /* If just tried and failed to reuse lookahead token after an
761               error, discard it.  */
762
763         /* Return failure if at end of input.  */
764         if (yychar == YYEOF) {
765             /* Pop the error token.  */
766             YYPOPSTACK;
767             /* Pop the rest of the stack.  */
768             while (yyss < yyssp) {
769                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
770                 if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
771                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
772                     if (*yypsp != PL_comppad) {
773                         PAD_RESTORE_LOCAL(*yypsp);
774                     }
775                     op_free(yyvsp->opval);
776                 }
777                 YYPOPSTACK;
778             }
779             YYABORT;
780         }
781
782         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
783         yychar = YYEMPTY;
784
785     }
786
787     /* Else will try to reuse lookahead token after shifting the error
788           token.  */
789     goto yyerrlab1;
790
791
792   /*----------------------------------------------------.
793   | yyerrlab1 -- error raised explicitly by an action.  |
794   `----------------------------------------------------*/
795   yyerrlab1:
796     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
797
798     for (;;) {
799         yyn = yypact[yystate];
800         if (yyn != YYPACT_NINF) {
801             yyn += YYTERROR;
802             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
803                 yyn = yytable[yyn];
804                 if (0 < yyn)
805                     break;
806             }
807         }
808
809         /* Pop the current state because it cannot handle the error token.  */
810         if (yyssp == yyss)
811             YYABORT;
812
813         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
814         if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
815             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
816             if (*yypsp != PL_comppad) {
817                 PAD_RESTORE_LOCAL(*yypsp);
818             }
819             op_free(yyvsp->opval);
820         }
821         yyvsp--;
822         yypsp--;
823 #ifdef DEBUGGING
824         yynsp--;
825 #endif
826         yystate = *--yyssp;
827
828         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
829         if (yydebug && DEBUG_v_TEST)
830         {
831             /* XXX */
832             int i;
833             int start = 1;
834             int count = (int)(yyssp - yyss);
835
836             if (count > 8) {
837                 start = count - 8 + 1;
838                 count = 8;
839             }
840
841             PerlIO_printf(Perl_debug_log, "cppad:");
842             for (i=0; i < count; i++)
843                 PerlIO_printf(Perl_debug_log, " %8p", yyps[start+i]);
844             PerlIO_printf(Perl_debug_log, "\n");
845         }
846     }
847
848     if (yyn == YYFINAL)
849         YYACCEPT;
850
851     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
852
853     *++yyvsp = yylval;
854     *++yypsp = PL_comppad;
855 #ifdef DEBUGGING
856     *++yynsp ="<err>";
857 #endif
858
859     yystate = yyn;
860     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
861
862     goto yynewstate;
863
864
865   /*-------------------------------------.
866   | yyacceptlab -- YYACCEPT comes here.  |
867   `-------------------------------------*/
868   yyacceptlab:
869     yyresult = 0;
870     goto yyreturn;
871
872   /*-----------------------------------.
873   | yyabortlab -- YYABORT comes here.  |
874   `-----------------------------------*/
875   yyabortlab:
876     yyresult = 1;
877     goto yyreturn;
878
879   /*----------------------------------------------.
880   | yyoverflowlab -- parser overflow comes here.  |
881   `----------------------------------------------*/
882   yyoverflowlab:
883     yyerror ("parser stack overflow");
884     yyresult = 2;
885     /* Fall through.  */
886
887   yyreturn:
888
889     ss_save->yyss = NULL;       /* disarm parse stack cleanup */
890     LEAVE;                      /* force stack free before we return */
891
892     return yyresult;
893 }
894
895 /*
896  * Local variables:
897  * c-indentation-style: bsd
898  * c-basic-offset: 4
899  * indent-tabs-mode: t
900  * End:
901  *
902  * ex: set ts=8 sts=4 sw=4 noet:
903  */