unify stacks arithmetic in parser
[p5sagit/p5-mst-13.2.git] / perly.c
CommitLineData
0de566d7 1/* perly.c
2 *
54ca4ee7 3 * Copyright (c) 2004, 2005, 2006 Larry Wall and others
0de566d7 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
f05e27e5 10 * and edited; the bits that are dependent on perly.y are now
11 * #included from the files perly.tab and perly.act.
0de566d7 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.
bc463c31 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,
f05e27e5 23 * but which includes extra code for dumping the parse tree.
24 * This is controlled by the PERL_IN_MADLY_C define.
0de566d7 25 */
26
27
3797f23d 28
0de566d7 29/* allow stack size to grow effectively without limit */
30#define YYMAXDEPTH 10000000
31
79072805 32#include "EXTERN.h"
864dbfa3 33#define PERL_IN_PERLY_C
79072805 34#include "perl.h"
09bef843 35
3797f23d 36typedef unsigned char yytype_uint8;
37typedef signed char yytype_int8;
38typedef unsigned short int yytype_uint16;
39typedef short int yytype_int16;
0de566d7 40typedef signed char yysigned_char;
41
42#ifdef DEBUGGING
43# define YYDEBUG 1
93a17b20 44#else
0de566d7 45# define YYDEBUG 0
93a17b20 46#endif
09bef843 47
f05e27e5 48/* contains all the parser state tables; auto-generated from perly.y */
49#include "perly.tab"
0de566d7 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) \
72do \
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 } \
84while (0)
85
86#define YYTERROR 1
87#define YYERRCODE 256
88
0de566d7 89/* Enable debugging if requested. */
9388183f 90#ifdef DEBUGGING
0de566d7 91
92# define yydebug (DEBUG_p_TEST)
93
94# define YYFPRINTF PerlIO_printf
95
96# define YYDPRINTF(Args) \
97do { \
98 if (yydebug) \
99 YYFPRINTF Args; \
100} while (0)
101
9388183f 102# define YYDSYMPRINTF(Title, Token, Value) \
0de566d7 103do { \
104 if (yydebug) { \
105 YYFPRINTF (Perl_debug_log, "%s ", Title); \
356f4fed 106 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
0de566d7 107 YYFPRINTF (Perl_debug_log, "\n"); \
108 } \
109} while (0)
110
111/*--------------------------------.
112| Print this symbol on YYOUTPUT. |
113`--------------------------------*/
114
115static void
356f4fed 116yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
0de566d7 117{
0de566d7 118 if (yytype < YYNTOKENS) {
119 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
120# ifdef YYPRINT
121 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
9388183f 122# else
e4584336 123 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
0de566d7 124# endif
125 }
126 else
127 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
128
0de566d7 129 YYFPRINTF (yyoutput, ")");
130}
131
132
9388183f 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 */
0de566d7 136
137static void
df35152e 138yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
0de566d7 139{
9388183f 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:");
21612876 153 for (i=0; i < count; i++)
154 PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
9388183f 155 PerlIO_printf(Perl_debug_log, "\ntoken:");
21612876 156 for (i=0; i < count; i++)
157 PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
9388183f 158 PerlIO_printf(Perl_debug_log, "\nvalue:");
21612876 159 for (i=0; i < count; i++) {
d5c6462e 160 switch (yy_type_tab[yystos[yyss[start+i]]]) {
161 case toketype_opval:
21612876 162 PerlIO_printf(Perl_debug_log, " %8.8s",
163 yyvs[start+i].opval
164 ? PL_op_name[yyvs[start+i].opval->op_type]
670f3923 165 : "(Nullop)"
21612876 166 );
d5c6462e 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:
ca06c01c 177 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)yyvs[start+i].ival);
d5c6462e 178 break;
179 default:
21612876 180 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
d5c6462e 181 }
21612876 182 }
9388183f 183 PerlIO_printf(Perl_debug_log, "\n\n");
0de566d7 184}
185
9388183f 186# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns) \
0de566d7 187do { \
9388183f 188 if (yydebug && DEBUG_v_TEST) \
189 yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
0de566d7 190} while (0)
191
09bef843 192
0de566d7 193/*------------------------------------------------.
194| Report that the YYRULE is going to be reduced. |
195`------------------------------------------------*/
196
197static void
198yy_reduce_print (pTHX_ int yyrule)
199{
200 int yyi;
df35152e 201 const unsigned int yylineno = yyrline[yyrule];
0de566d7 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) \
211do { \
212 if (yydebug) \
213 yy_reduce_print (aTHX_ Rule); \
214} while (0)
215
216#else /* !DEBUGGING */
217# define YYDPRINTF(Args)
9388183f 218# define YYDSYMPRINTF(Title, Token, Value)
219# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
0de566d7 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
09bef843 227#endif
09bef843 228
0de566d7 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. */
236static YYSIZE_T
237yystrlen (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. */
255static char *
256yystpcpy (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
718a7425 271
272/* a snapshot of the current stack position variables for use by
273 * S_clear_yystack */
274
275typedef 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
286static void
287S_clear_yystack(pTHX_ const void *p)
288{
289 yystack_positions *y = (yystack_positions*) p;
670f3923 290 int i;
718a7425 291
292 if (!y->yyss)
293 return;
294 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
670f3923 295
296 /* Freeing ops on the stack, and the op_latefree/op_latefreed flags:
297 *
298 * When we pop tokens off the stack during error recovery, or when
299 * we pop all the tokens off the stack after a die during a shift or
300 * reduce (ie Perl_croak somewhere in yylex(), or in one of the
301 * newFOO() functions, then its possible that some of these tokens are
302 * of type opval, pointing to an OP. All these ops are orphans; each is
303 * its own miniature subtree that has not yet been attached to a
304 * larger tree. In this case, we shoould clearly free the op (making
305 * sure, for each op we free thyat we have PL_comppad pointing to the
306 * right place for freeing any SVs attached to the op in threaded
307 * builds.
308 *
309 * However, there is a particular problem if we die in newFOO called
310 * by a reducing action; e.g.
311 *
312 * foo : bar baz boz
313 * { $$ = newFOO($1,$2,$3) }
314 *
315 * where
316 * OP *newFOO { .... croak .... }
317 *
318 * In this case, when we come to clean bar baz and boz off the stack,
319 * we don't know whether newFOO() has already:
320 * * freed them
321 * * left them as it
322 * * attached them to part of a larger tree
323 *
324 * To get round this problem, we set the flag op_latefree on every op
325 * that gets pushed onto the parser stack. If op_free() sees this
326 * flag, it clears the op and frees any children,, but *doesn't* free
327 * the op itself; instead it sets the op_latefreed flag. This means
328 * that we can safely call op_free() multiple times on each stack op.
329 * So, when clearing the stack, we first, for each op that was being
330 * reduced, call op_free with op_latefree=1. This ensures that all ops
331 * hanging off these op are freed, but the reducing ops themselces are
332 * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
333 * and free them. A little though should convince you that this
334 * two-part approach to the reducing ops should handle all three cases
335 * above safely.
336 */
337
338 /* free any reducing ops (1st pass) */
339
340 for (i=0; i< y->yylen; i++) {
341 if (yy_type_tab[yystos[y->yyssp[-i]]] == toketype_opval
342 && y->yyvsp[-i].opval) {
343 if (y->yypsp[-i] != PL_comppad) {
344 PAD_RESTORE_LOCAL(y->yypsp[-i]);
345 }
346 op_free(y->yyvsp[-i].opval);
347 }
348 }
349
350 /* now free whole the stack, including the just-reduced ops */
351
718a7425 352 while (y->yyssp > y->yyss) {
670f3923 353 if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval
354 && y->yyvsp->opval)
355 {
718a7425 356 if (*y->yypsp != PL_comppad) {
357 PAD_RESTORE_LOCAL(*y->yypsp);
358 }
359 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
670f3923 360 y->yyvsp->opval->op_latefree = 0;
718a7425 361 op_free(y->yyvsp->opval);
362 }
363 y->yyvsp--;
364 y->yyssp--;
365 y->yypsp--;
366 }
367}
368
369
370
0de566d7 371/*----------.
372| yyparse. |
373`----------*/
374
79072805 375int
bc463c31 376#ifdef PERL_IN_MADLY_C
377Perl_madparse (pTHX)
378#else
0de566d7 379Perl_yyparse (pTHX)
bc463c31 380#endif
79072805 381{
97aff369 382 dVAR;
0de566d7 383 int yychar; /* The lookahead symbol. */
384 YYSTYPE yylval; /* The semantic value of the lookahead symbol. */
385 int yynerrs; /* Number of syntax errors so far. */
386 register int yystate;
387 register int yyn;
388 int yyresult;
389
390 /* Number of tokens to shift before error messages enabled. */
391 int yyerrstatus;
392 /* Lookahead token as an internal (translated) token number. */
393 int yytoken = 0;
394
718a7425 395 /* three stacks and their tools:
a0288114 396 yyss: related to states,
397 yyvs: related to semantic values,
718a7425 398 yyps: current value of PL_comppad for each state
399
0de566d7 400
401 Refer to the stacks thru separate pointers, to allow yyoverflow
402 to reallocate them elsewhere. */
403
404 /* The state stack. */
405 short *yyss;
93a17b20 406 register short *yyssp;
0de566d7 407
408 /* The semantic value stack. */
409 YYSTYPE *yyvs;
93a17b20 410 register YYSTYPE *yyvsp;
a0d0e21e 411
718a7425 412 AV **yyps;
413 AV **yypsp;
414
415 /* for ease of re-allocation and automatic freeing, have three SVs whose
0de566d7 416 * SvPVX points to the stacks */
718a7425 417 SV *yyss_sv, *yyvs_sv, *yyps_sv;
418 SV *ss_save_sv;
419 yystack_positions *ss_save;
420
0de566d7 421
9388183f 422#ifdef DEBUGGING
423 /* maintain also a stack of token/rule names for debugging with -Dpv */
e1ec3a88 424 const char **yyns, **yynsp;
9388183f 425 SV *yyns_sv;
718a7425 426# define YYPOPSTACK (yyvsp--, yyssp--, yypsp--, yynsp--)
9388183f 427#else
718a7425 428# define YYPOPSTACK (yyvsp--, yyssp--, yypsp--)
9388183f 429#endif
430
0de566d7 431
432 YYSIZE_T yystacksize = YYINITDEPTH;
433
434 /* The variables used to return semantic value and location from the
435 action routines. */
436 YYSTYPE yyval;
437
438
439 /* When reducing, the number of symbols on the RHS of the reduced
440 rule. */
441 int yylen;
442
bc463c31 443#ifndef PERL_IN_MADLY_C
444# ifdef PERL_MAD
00e74f14 445 if (PL_madskills)
446 return madparse();
bc463c31 447# endif
81d86705 448#endif
449
0de566d7 450 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
451
0de566d7 452 ENTER; /* force stack free before we return */
12fbd33b 453 SAVEVPTR(PL_yycharp);
454 SAVEVPTR(PL_yylvalp);
455 PL_yycharp = &yychar; /* so PL_yyerror() can access it */
456 PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
457
561b68a9 458 yyss_sv = newSV(YYINITDEPTH * sizeof(short));
459 yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
718a7425 460 yyps_sv = newSV(YYINITDEPTH * sizeof(AV*));
461 ss_save_sv = newSV(sizeof(yystack_positions));
0de566d7 462 SAVEFREESV(yyss_sv);
463 SAVEFREESV(yyvs_sv);
718a7425 464 SAVEFREESV(yyps_sv);
465 SAVEFREESV(ss_save_sv);
0de566d7 466 yyss = (short *) SvPVX(yyss_sv);
467 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
718a7425 468 yyps = (AV **) SvPVX(yyps_sv);
469 ss_save = (yystack_positions *) SvPVX(ss_save_sv);
470
471 ss_save->yyss = NULL; /* disarm stack cleanup */
472 /* cleanup the parse stack on premature exit */
473 SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
474
9388183f 475 /* note that elements zero of yyvs and yyns are not used */
476 yyssp = yyss;
477 yyvsp = yyvs;
718a7425 478 yypsp = yyps;
9388183f 479#ifdef DEBUGGING
561b68a9 480 yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
9388183f 481 SAVEFREESV(yyns_sv);
a28509cc 482 /* XXX This seems strange to cast char * to char ** */
94a11853 483 yyns = (const char **) SvPVX(yyns_sv);
9388183f 484 yynsp = yyns;
485#endif
79072805 486
05a03161 487 *yyssp = 0;
488 yyvsp->ival = 0;
0de566d7 489 yyerrstatus = 0;
93a17b20 490 yynerrs = 0;
0de566d7 491 yychar = YYEMPTY; /* Cause a token to be read. */
492
0de566d7 493/*------------------------------------------------------------.
494| yynewstate -- Push a new state, which is found in yystate. |
495`------------------------------------------------------------*/
496 yynewstate:
0de566d7 497
05a03161 498 yystate = *yyssp;
499
670f3923 500 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7 501
670f3923 502 if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
503 yyvsp->opval->op_latefree = 1;
504 yyvsp->opval->op_latefreed = 0;
505 }
506
507 ss_save->yyss = yyss;
508 ss_save->yyssp = yyssp;
509 ss_save->yyvsp = yyvsp;
510 ss_save->yypsp = yypsp;
511 ss_save->yylen = 0;
512
0de566d7 513 if (yyss + yystacksize - 1 <= yyssp) {
514 /* Get the current used size of the three stacks, in elements. */
df35152e 515 const YYSIZE_T yysize = yyssp - yyss + 1;
0de566d7 516
517 /* Extend the stack our own way. */
518 if (YYMAXDEPTH <= yystacksize)
519 goto yyoverflowlab;
520 yystacksize *= 2;
521 if (YYMAXDEPTH < yystacksize)
522 yystacksize = YYMAXDEPTH;
523
524 SvGROW(yyss_sv, yystacksize * sizeof(short));
525 SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
718a7425 526 SvGROW(yyps_sv, yystacksize * sizeof(AV*));
0de566d7 527 yyss = (short *) SvPVX(yyss_sv);
528 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
718a7425 529 yyps = (AV **) SvPVX(yyps_sv);
9388183f 530#ifdef DEBUGGING
531 SvGROW(yyns_sv, yystacksize * sizeof(char *));
a28509cc 532 /* XXX This seems strange to cast char * to char ** */
94a11853 533 yyns = (const char **) SvPVX(yyns_sv);
9388183f 534 if (! yyns)
535 goto yyoverflowlab;
536 yynsp = yyns + yysize - 1;
537#endif
718a7425 538 if (!yyss || ! yyvs || ! yyps)
0de566d7 539 goto yyoverflowlab;
540
541 yyssp = yyss + yysize - 1;
542 yyvsp = yyvs + yysize - 1;
718a7425 543 yypsp = yyps + yysize - 1;
0de566d7 544
545
546 YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
547 (unsigned long int) yystacksize));
548
549 if (yyss + yystacksize - 1 <= yyssp)
550 YYABORT;
670f3923 551
552 ss_save->yyss = yyss;
553 ss_save->yyssp = yyssp;
554 ss_save->yyvsp = yyvsp;
555 ss_save->yypsp = yypsp;
556 ss_save->yylen = 0;
93a17b20 557 }
0de566d7 558
0de566d7 559 goto yybackup;
560
561 /*-----------.
562 | yybackup. |
563 `-----------*/
564 yybackup:
565
566/* Do appropriate processing given the current state. */
567/* Read a lookahead token if we need one and don't already have one. */
568/* yyresume: */
569
570 /* First try to decide what to do without reference to lookahead token. */
571
572 yyn = yypact[yystate];
573 if (yyn == YYPACT_NINF)
574 goto yydefault;
575
576 /* Not known => get a lookahead token if don't already have one. */
577
578 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
579 if (yychar == YYEMPTY) {
580 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 581#ifdef PERL_IN_MADLY_C
00e74f14 582 yychar = PL_madskills ? madlex() : yylex();
f05e27e5 583#else
12fbd33b 584 yychar = yylex();
81d86705 585#endif
bc463c31 586
12fbd33b 587# ifdef EBCDIC
588 if (yychar >= 0 && yychar < 255) {
589 yychar = NATIVE_TO_ASCII(yychar);
590 }
591# endif
0de566d7 592 }
593
594 if (yychar <= YYEOF) {
595 yychar = yytoken = YYEOF;
596 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 597 }
0de566d7 598 else {
599 yytoken = YYTRANSLATE (yychar);
9388183f 600 YYDSYMPRINTF ("Next token is", yytoken, &yylval);
93a17b20 601 }
771df094 602
0de566d7 603 /* If the proper action on seeing token YYTOKEN is to reduce or to
604 detect an error, take that action. */
605 yyn += yytoken;
606 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
607 goto yydefault;
608 yyn = yytable[yyn];
609 if (yyn <= 0) {
610 if (yyn == 0 || yyn == YYTABLE_NINF)
611 goto yyerrlab;
612 yyn = -yyn;
613 goto yyreduce;
614 }
7b57b0ea 615
0de566d7 616 if (yyn == YYFINAL)
617 YYACCEPT;
771df094 618
0de566d7 619 /* Shift the lookahead token. */
620 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
621
622 /* Discard the token being shifted unless it is eof. */
623 if (yychar != YYEOF)
624 yychar = YYEMPTY;
625
05a03161 626 *++yyssp = yyn;
0de566d7 627 *++yyvsp = yylval;
718a7425 628 *++yypsp = PL_comppad;
9388183f 629#ifdef DEBUGGING
e1ec3a88 630 *++yynsp = (const char *)(yytname[yytoken]);
9388183f 631#endif
0de566d7 632
633
634 /* Count tokens shifted since error; after three, turn off error
635 status. */
636 if (yyerrstatus)
637 yyerrstatus--;
638
0de566d7 639 goto yynewstate;
640
641
642 /*-----------------------------------------------------------.
643 | yydefault -- do the default action for the current state. |
644 `-----------------------------------------------------------*/
645 yydefault:
646 yyn = yydefact[yystate];
647 if (yyn == 0)
648 goto yyerrlab;
649 goto yyreduce;
650
651
652 /*-----------------------------.
653 | yyreduce -- Do a reduction. |
654 `-----------------------------*/
655 yyreduce:
656 /* yyn is the number of a rule to reduce with. */
657 yylen = yyr2[yyn];
658
659 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 660 "$$ = $1".
0de566d7 661
662 Otherwise, the following line sets YYVAL to garbage.
663 This behavior is undocumented and Bison
664 users should not rely upon it. Assigning to YYVAL
665 unconditionally makes the parser a bit smaller, and it avoids a
666 GCC warning that YYVAL may be used uninitialized. */
667 yyval = yyvsp[1-yylen];
668
4d28fe79 669 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
0de566d7 670 YY_REDUCE_PRINT (yyn);
718a7425 671
672 /* running external code may trigger a die (eg 'use nosuchmodule'):
673 * record the current stack state so that an unwind will
674 * free all the pesky OPs lounging around on the parse stack */
675 ss_save->yyss = yyss;
676 ss_save->yyssp = yyssp;
677 ss_save->yyvsp = yyvsp;
678 ss_save->yypsp = yypsp;
679 ss_save->yylen = yylen;
680
0de566d7 681 switch (yyn) {
682
0de566d7 683
684#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 685
bc463c31 686#ifdef PERL_IN_MADLY_C
f05e27e5 687# define IVAL(i) (i)->tk_lval.ival
688# define PVAL(p) (p)->tk_lval.pval
689# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
690# define TOKEN_FREE(a) token_free(a)
691# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
692# define IF_MAD(a,b) (a)
693# define DO_MAD(a) a
694# define MAD
bc463c31 695#else
f05e27e5 696# define IVAL(i) (i)
697# define PVAL(p) (p)
698# define TOKEN_GETMAD(a,b,c)
699# define TOKEN_FREE(a)
700# define OP_GETMAD(a,b,c)
701# define IF_MAD(a,b) (b)
702# define DO_MAD(a)
703# undef MAD
bc463c31 704#endif
7b57b0ea 705
f05e27e5 706/* contains all the rule actions; auto-generated from perly.y */
707#include "perly.act"
708
93a17b20 709 }
0de566d7 710
670f3923 711 /* any just-reduced ops with the op_latefreed flag cleared need to be
712 * freed; the rest need the flag resetting */
713 {
714 int i;
715 for (i=0; i< yylen; i++) {
716 if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
717 && yyvsp[-i].opval)
718 {
719 yyvsp[-i].opval->op_latefree = 0;
720 if (yyvsp[-i].opval->op_latefreed)
721 op_free(yyvsp[-i].opval);
722 }
723 }
724 }
725
0de566d7 726 yyvsp -= yylen;
727 yyssp -= yylen;
718a7425 728 yypsp -= yylen;
9388183f 729#ifdef DEBUGGING
730 yynsp -= yylen;
731#endif
0de566d7 732
05a03161 733 /* Now shift the result of the reduction. Determine what state
734 that goes to, based on the state we popped back to and the rule
735 number reduced by. */
736
0de566d7 737 *++yyvsp = yyval;
718a7425 738 *++yypsp = PL_comppad;
9388183f 739#ifdef DEBUGGING
e1ec3a88 740 *++yynsp = (const char *)(yytname [yyr1[yyn]]);
9388183f 741#endif
0de566d7 742
743 yyn = yyr1[yyn];
744
745 yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
746 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
747 yystate = yytable[yystate];
93a17b20 748 else
0de566d7 749 yystate = yydefgoto[yyn - YYNTOKENS];
05a03161 750 *++yyssp = yystate;
751
0de566d7 752 goto yynewstate;
753
754
755 /*------------------------------------.
756 | yyerrlab -- here on detecting error |
757 `------------------------------------*/
758 yyerrlab:
759 /* If not already recovering from an error, report this error. */
760 if (!yyerrstatus) {
761 ++yynerrs;
762#if YYERROR_VERBOSE
763 yyn = yypact[yystate];
764
765 if (YYPACT_NINF < yyn && yyn < YYLAST) {
766 YYSIZE_T yysize = 0;
df35152e 767 const int yytype = YYTRANSLATE (yychar);
0de566d7 768 char *yymsg;
769 int yyx, yycount;
770
771 yycount = 0;
772 /* Start YYX at -YYN if negative to avoid negative indexes in
773 YYCHECK. */
774 for (yyx = yyn < 0 ? -yyn : 0;
775 yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
776 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
777 yysize += yystrlen (yytname[yyx]) + 15, yycount++;
778 yysize += yystrlen ("syntax error, unexpected ") + 1;
779 yysize += yystrlen (yytname[yytype]);
4b711db3 780 Newx(yymsg, yysize, char *);
0de566d7 781 if (yymsg != 0) {
df35152e 782 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
0de566d7 783 yyp = yystpcpy (yyp, yytname[yytype]);
784
785 if (yycount < 5) {
786 yycount = 0;
787 for (yyx = yyn < 0 ? -yyn : 0;
788 yyx < (int) (sizeof (yytname) / sizeof (char *));
789 yyx++)
790 {
791 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
792 const char *yyq = ! yycount ?
793 ", expecting " : " or ";
794 yyp = yystpcpy (yyp, yyq);
795 yyp = yystpcpy (yyp, yytname[yyx]);
796 yycount++;
797 }
798 }
ecb2f335 799 }
0de566d7 800 yyerror (yymsg);
801 YYSTACK_FREE (yymsg);
802 }
803 else
804 yyerror ("syntax error; also virtual memory exhausted");
805 }
806 else
807#endif /* YYERROR_VERBOSE */
808 yyerror ("syntax error");
93a17b20 809 }
0de566d7 810
811
812 if (yyerrstatus == 3) {
813 /* If just tried and failed to reuse lookahead token after an
814 error, discard it. */
815
816 /* Return failure if at end of input. */
817 if (yychar == YYEOF) {
818 /* Pop the error token. */
819 YYPOPSTACK;
820 /* Pop the rest of the stack. */
821 while (yyss < yyssp) {
9388183f 822 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
670f3923 823 if (yy_type_tab[yystos[*yyssp]] == toketype_opval
824 && yyvsp->opval)
825 {
0539ab63 826 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
718a7425 827 if (*yypsp != PL_comppad) {
828 PAD_RESTORE_LOCAL(*yypsp);
829 }
670f3923 830 yyvsp->opval->op_latefree = 0;
0539ab63 831 op_free(yyvsp->opval);
832 }
0de566d7 833 YYPOPSTACK;
834 }
835 YYABORT;
836 }
837
9388183f 838 YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
0de566d7 839 yychar = YYEMPTY;
840
93a17b20 841 }
0de566d7 842
843 /* Else will try to reuse lookahead token after shifting the error
844 token. */
845 goto yyerrlab1;
846
847
848 /*----------------------------------------------------.
849 | yyerrlab1 -- error raised explicitly by an action. |
850 `----------------------------------------------------*/
851 yyerrlab1:
852 yyerrstatus = 3; /* Each real token shifted decrements this. */
853
854 for (;;) {
855 yyn = yypact[yystate];
856 if (yyn != YYPACT_NINF) {
857 yyn += YYTERROR;
858 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
859 yyn = yytable[yyn];
860 if (0 < yyn)
861 break;
862 }
863 }
864
865 /* Pop the current state because it cannot handle the error token. */
866 if (yyssp == yyss)
867 YYABORT;
868
9388183f 869 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
670f3923 870 if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
0539ab63 871 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
718a7425 872 if (*yypsp != PL_comppad) {
873 PAD_RESTORE_LOCAL(*yypsp);
874 }
670f3923 875 yyvsp->opval->op_latefree = 0;
0539ab63 876 op_free(yyvsp->opval);
877 }
0de566d7 878 yyvsp--;
718a7425 879 yypsp--;
9388183f 880#ifdef DEBUGGING
881 yynsp--;
882#endif
0de566d7 883 yystate = *--yyssp;
884
9388183f 885 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
93a17b20 886 }
0de566d7 887
888 if (yyn == YYFINAL)
889 YYACCEPT;
890
891 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
892
05a03161 893 *++yyssp = yyn;
0de566d7 894 *++yyvsp = yylval;
718a7425 895 *++yypsp = PL_comppad;
9388183f 896#ifdef DEBUGGING
897 *++yynsp ="<err>";
898#endif
0de566d7 899
0de566d7 900 goto yynewstate;
901
902
903 /*-------------------------------------.
904 | yyacceptlab -- YYACCEPT comes here. |
905 `-------------------------------------*/
906 yyacceptlab:
907 yyresult = 0;
908 goto yyreturn;
909
910 /*-----------------------------------.
911 | yyabortlab -- YYABORT comes here. |
912 `-----------------------------------*/
913 yyabortlab:
914 yyresult = 1;
915 goto yyreturn;
916
917 /*----------------------------------------------.
918 | yyoverflowlab -- parser overflow comes here. |
919 `----------------------------------------------*/
920 yyoverflowlab:
921 yyerror ("parser stack overflow");
922 yyresult = 2;
923 /* Fall through. */
924
925 yyreturn:
926
718a7425 927 ss_save->yyss = NULL; /* disarm parse stack cleanup */
c86b7e91 928 LEAVE; /* force stack free before we return */
e1f15930 929
0de566d7 930 return yyresult;
e1f15930 931}
66610fdd 932
933/*
934 * Local variables:
935 * c-indentation-style: bsd
936 * c-basic-offset: 4
937 * indent-tabs-mode: t
938 * End:
939 *
37442d52 940 * ex: set ts=8 sts=4 sw=4 noet:
941 */