fix a cast warning in perly.c
[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
0de566d7 487 yystate = 0;
488 yyerrstatus = 0;
93a17b20 489 yynerrs = 0;
0de566d7 490 yychar = YYEMPTY; /* Cause a token to be read. */
491
0de566d7 492 goto yysetstate;
493
494/*------------------------------------------------------------.
495| yynewstate -- Push a new state, which is found in yystate. |
496`------------------------------------------------------------*/
497 yynewstate:
498 /* In all cases, when you get here, the value and location stacks
499 have just been pushed. so pushing a state here evens the stacks.
500 */
501 yyssp++;
502
503 yysetstate:
670f3923 504 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7 505 *yyssp = yystate;
506
670f3923 507 if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
508 yyvsp->opval->op_latefree = 1;
509 yyvsp->opval->op_latefreed = 0;
510 }
511
512 ss_save->yyss = yyss;
513 ss_save->yyssp = yyssp;
514 ss_save->yyvsp = yyvsp;
515 ss_save->yypsp = yypsp;
516 ss_save->yylen = 0;
517
0de566d7 518 if (yyss + yystacksize - 1 <= yyssp) {
519 /* Get the current used size of the three stacks, in elements. */
df35152e 520 const YYSIZE_T yysize = yyssp - yyss + 1;
0de566d7 521
522 /* Extend the stack our own way. */
523 if (YYMAXDEPTH <= yystacksize)
524 goto yyoverflowlab;
525 yystacksize *= 2;
526 if (YYMAXDEPTH < yystacksize)
527 yystacksize = YYMAXDEPTH;
528
529 SvGROW(yyss_sv, yystacksize * sizeof(short));
530 SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
718a7425 531 SvGROW(yyps_sv, yystacksize * sizeof(AV*));
0de566d7 532 yyss = (short *) SvPVX(yyss_sv);
533 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
718a7425 534 yyps = (AV **) SvPVX(yyps_sv);
9388183f 535#ifdef DEBUGGING
536 SvGROW(yyns_sv, yystacksize * sizeof(char *));
a28509cc 537 /* XXX This seems strange to cast char * to char ** */
94a11853 538 yyns = (const char **) SvPVX(yyns_sv);
9388183f 539 if (! yyns)
540 goto yyoverflowlab;
541 yynsp = yyns + yysize - 1;
542#endif
718a7425 543 if (!yyss || ! yyvs || ! yyps)
0de566d7 544 goto yyoverflowlab;
545
546 yyssp = yyss + yysize - 1;
547 yyvsp = yyvs + yysize - 1;
718a7425 548 yypsp = yyps + yysize - 1;
0de566d7 549
550
551 YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
552 (unsigned long int) yystacksize));
553
554 if (yyss + yystacksize - 1 <= yyssp)
555 YYABORT;
670f3923 556
557 ss_save->yyss = yyss;
558 ss_save->yyssp = yyssp;
559 ss_save->yyvsp = yyvsp;
560 ss_save->yypsp = yypsp;
561 ss_save->yylen = 0;
93a17b20 562 }
0de566d7 563
0de566d7 564 goto yybackup;
565
566 /*-----------.
567 | yybackup. |
568 `-----------*/
569 yybackup:
570
571/* Do appropriate processing given the current state. */
572/* Read a lookahead token if we need one and don't already have one. */
573/* yyresume: */
574
575 /* First try to decide what to do without reference to lookahead token. */
576
577 yyn = yypact[yystate];
578 if (yyn == YYPACT_NINF)
579 goto yydefault;
580
581 /* Not known => get a lookahead token if don't already have one. */
582
583 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
584 if (yychar == YYEMPTY) {
585 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 586#ifdef PERL_IN_MADLY_C
00e74f14 587 yychar = PL_madskills ? madlex() : yylex();
f05e27e5 588#else
12fbd33b 589 yychar = yylex();
81d86705 590#endif
bc463c31 591
12fbd33b 592# ifdef EBCDIC
593 if (yychar >= 0 && yychar < 255) {
594 yychar = NATIVE_TO_ASCII(yychar);
595 }
596# endif
0de566d7 597 }
598
599 if (yychar <= YYEOF) {
600 yychar = yytoken = YYEOF;
601 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 602 }
0de566d7 603 else {
604 yytoken = YYTRANSLATE (yychar);
9388183f 605 YYDSYMPRINTF ("Next token is", yytoken, &yylval);
93a17b20 606 }
771df094 607
0de566d7 608 /* If the proper action on seeing token YYTOKEN is to reduce or to
609 detect an error, take that action. */
610 yyn += yytoken;
611 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
612 goto yydefault;
613 yyn = yytable[yyn];
614 if (yyn <= 0) {
615 if (yyn == 0 || yyn == YYTABLE_NINF)
616 goto yyerrlab;
617 yyn = -yyn;
618 goto yyreduce;
619 }
7b57b0ea 620
0de566d7 621 if (yyn == YYFINAL)
622 YYACCEPT;
771df094 623
0de566d7 624 /* Shift the lookahead token. */
625 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
626
627 /* Discard the token being shifted unless it is eof. */
628 if (yychar != YYEOF)
629 yychar = YYEMPTY;
630
631 *++yyvsp = yylval;
718a7425 632 *++yypsp = PL_comppad;
9388183f 633#ifdef DEBUGGING
e1ec3a88 634 *++yynsp = (const char *)(yytname[yytoken]);
9388183f 635#endif
0de566d7 636
637
638 /* Count tokens shifted since error; after three, turn off error
639 status. */
640 if (yyerrstatus)
641 yyerrstatus--;
642
643 yystate = yyn;
9388183f 644
0de566d7 645 goto yynewstate;
646
647
648 /*-----------------------------------------------------------.
649 | yydefault -- do the default action for the current state. |
650 `-----------------------------------------------------------*/
651 yydefault:
652 yyn = yydefact[yystate];
653 if (yyn == 0)
654 goto yyerrlab;
655 goto yyreduce;
656
657
658 /*-----------------------------.
659 | yyreduce -- Do a reduction. |
660 `-----------------------------*/
661 yyreduce:
662 /* yyn is the number of a rule to reduce with. */
663 yylen = yyr2[yyn];
664
665 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 666 "$$ = $1".
0de566d7 667
668 Otherwise, the following line sets YYVAL to garbage.
669 This behavior is undocumented and Bison
670 users should not rely upon it. Assigning to YYVAL
671 unconditionally makes the parser a bit smaller, and it avoids a
672 GCC warning that YYVAL may be used uninitialized. */
673 yyval = yyvsp[1-yylen];
674
4d28fe79 675 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
0de566d7 676 YY_REDUCE_PRINT (yyn);
718a7425 677
678 /* running external code may trigger a die (eg 'use nosuchmodule'):
679 * record the current stack state so that an unwind will
680 * free all the pesky OPs lounging around on the parse stack */
681 ss_save->yyss = yyss;
682 ss_save->yyssp = yyssp;
683 ss_save->yyvsp = yyvsp;
684 ss_save->yypsp = yypsp;
685 ss_save->yylen = yylen;
686
0de566d7 687 switch (yyn) {
688
0de566d7 689
690#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 691
bc463c31 692#ifdef PERL_IN_MADLY_C
f05e27e5 693# define IVAL(i) (i)->tk_lval.ival
694# define PVAL(p) (p)->tk_lval.pval
695# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
696# define TOKEN_FREE(a) token_free(a)
697# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
698# define IF_MAD(a,b) (a)
699# define DO_MAD(a) a
700# define MAD
bc463c31 701#else
f05e27e5 702# define IVAL(i) (i)
703# define PVAL(p) (p)
704# define TOKEN_GETMAD(a,b,c)
705# define TOKEN_FREE(a)
706# define OP_GETMAD(a,b,c)
707# define IF_MAD(a,b) (b)
708# define DO_MAD(a)
709# undef MAD
bc463c31 710#endif
7b57b0ea 711
f05e27e5 712/* contains all the rule actions; auto-generated from perly.y */
713#include "perly.act"
714
93a17b20 715 }
0de566d7 716
670f3923 717 /* any just-reduced ops with the op_latefreed flag cleared need to be
718 * freed; the rest need the flag resetting */
719 {
720 int i;
721 for (i=0; i< yylen; i++) {
722 if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
723 && yyvsp[-i].opval)
724 {
725 yyvsp[-i].opval->op_latefree = 0;
726 if (yyvsp[-i].opval->op_latefreed)
727 op_free(yyvsp[-i].opval);
728 }
729 }
730 }
731
0de566d7 732 yyvsp -= yylen;
733 yyssp -= yylen;
718a7425 734 yypsp -= yylen;
9388183f 735#ifdef DEBUGGING
736 yynsp -= yylen;
737#endif
0de566d7 738
0de566d7 739 *++yyvsp = yyval;
718a7425 740 *++yypsp = PL_comppad;
9388183f 741#ifdef DEBUGGING
e1ec3a88 742 *++yynsp = (const char *)(yytname [yyr1[yyn]]);
9388183f 743#endif
a0288114 744 /* Now shift the result of the reduction. Determine what state
0de566d7 745 that goes to, based on the state we popped back to and the rule
746 number reduced by. */
747
748 yyn = yyr1[yyn];
749
750 yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
751 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
752 yystate = yytable[yystate];
93a17b20 753 else
0de566d7 754 yystate = yydefgoto[yyn - YYNTOKENS];
0de566d7 755 goto yynewstate;
756
757
758 /*------------------------------------.
759 | yyerrlab -- here on detecting error |
760 `------------------------------------*/
761 yyerrlab:
762 /* If not already recovering from an error, report this error. */
763 if (!yyerrstatus) {
764 ++yynerrs;
765#if YYERROR_VERBOSE
766 yyn = yypact[yystate];
767
768 if (YYPACT_NINF < yyn && yyn < YYLAST) {
769 YYSIZE_T yysize = 0;
df35152e 770 const int yytype = YYTRANSLATE (yychar);
0de566d7 771 char *yymsg;
772 int yyx, yycount;
773
774 yycount = 0;
775 /* Start YYX at -YYN if negative to avoid negative indexes in
776 YYCHECK. */
777 for (yyx = yyn < 0 ? -yyn : 0;
778 yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
779 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
780 yysize += yystrlen (yytname[yyx]) + 15, yycount++;
781 yysize += yystrlen ("syntax error, unexpected ") + 1;
782 yysize += yystrlen (yytname[yytype]);
4b711db3 783 Newx(yymsg, yysize, char *);
0de566d7 784 if (yymsg != 0) {
df35152e 785 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
0de566d7 786 yyp = yystpcpy (yyp, yytname[yytype]);
787
788 if (yycount < 5) {
789 yycount = 0;
790 for (yyx = yyn < 0 ? -yyn : 0;
791 yyx < (int) (sizeof (yytname) / sizeof (char *));
792 yyx++)
793 {
794 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
795 const char *yyq = ! yycount ?
796 ", expecting " : " or ";
797 yyp = yystpcpy (yyp, yyq);
798 yyp = yystpcpy (yyp, yytname[yyx]);
799 yycount++;
800 }
801 }
ecb2f335 802 }
0de566d7 803 yyerror (yymsg);
804 YYSTACK_FREE (yymsg);
805 }
806 else
807 yyerror ("syntax error; also virtual memory exhausted");
808 }
809 else
810#endif /* YYERROR_VERBOSE */
811 yyerror ("syntax error");
93a17b20 812 }
0de566d7 813
814
815 if (yyerrstatus == 3) {
816 /* If just tried and failed to reuse lookahead token after an
817 error, discard it. */
818
819 /* Return failure if at end of input. */
820 if (yychar == YYEOF) {
821 /* Pop the error token. */
822 YYPOPSTACK;
823 /* Pop the rest of the stack. */
824 while (yyss < yyssp) {
9388183f 825 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
670f3923 826 if (yy_type_tab[yystos[*yyssp]] == toketype_opval
827 && yyvsp->opval)
828 {
0539ab63 829 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
718a7425 830 if (*yypsp != PL_comppad) {
831 PAD_RESTORE_LOCAL(*yypsp);
832 }
670f3923 833 yyvsp->opval->op_latefree = 0;
0539ab63 834 op_free(yyvsp->opval);
835 }
0de566d7 836 YYPOPSTACK;
837 }
838 YYABORT;
839 }
840
9388183f 841 YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
0de566d7 842 yychar = YYEMPTY;
843
93a17b20 844 }
0de566d7 845
846 /* Else will try to reuse lookahead token after shifting the error
847 token. */
848 goto yyerrlab1;
849
850
851 /*----------------------------------------------------.
852 | yyerrlab1 -- error raised explicitly by an action. |
853 `----------------------------------------------------*/
854 yyerrlab1:
855 yyerrstatus = 3; /* Each real token shifted decrements this. */
856
857 for (;;) {
858 yyn = yypact[yystate];
859 if (yyn != YYPACT_NINF) {
860 yyn += YYTERROR;
861 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
862 yyn = yytable[yyn];
863 if (0 < yyn)
864 break;
865 }
866 }
867
868 /* Pop the current state because it cannot handle the error token. */
869 if (yyssp == yyss)
870 YYABORT;
871
9388183f 872 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
670f3923 873 if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
0539ab63 874 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
718a7425 875 if (*yypsp != PL_comppad) {
876 PAD_RESTORE_LOCAL(*yypsp);
877 }
670f3923 878 yyvsp->opval->op_latefree = 0;
0539ab63 879 op_free(yyvsp->opval);
880 }
0de566d7 881 yyvsp--;
718a7425 882 yypsp--;
9388183f 883#ifdef DEBUGGING
884 yynsp--;
885#endif
0de566d7 886 yystate = *--yyssp;
887
9388183f 888 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
93a17b20 889 }
0de566d7 890
891 if (yyn == YYFINAL)
892 YYACCEPT;
893
894 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
895
896 *++yyvsp = yylval;
718a7425 897 *++yypsp = PL_comppad;
9388183f 898#ifdef DEBUGGING
899 *++yynsp ="<err>";
900#endif
0de566d7 901
902 yystate = yyn;
9388183f 903
0de566d7 904 goto yynewstate;
905
906
907 /*-------------------------------------.
908 | yyacceptlab -- YYACCEPT comes here. |
909 `-------------------------------------*/
910 yyacceptlab:
911 yyresult = 0;
912 goto yyreturn;
913
914 /*-----------------------------------.
915 | yyabortlab -- YYABORT comes here. |
916 `-----------------------------------*/
917 yyabortlab:
918 yyresult = 1;
919 goto yyreturn;
920
921 /*----------------------------------------------.
922 | yyoverflowlab -- parser overflow comes here. |
923 `----------------------------------------------*/
924 yyoverflowlab:
925 yyerror ("parser stack overflow");
926 yyresult = 2;
927 /* Fall through. */
928
929 yyreturn:
930
718a7425 931 ss_save->yyss = NULL; /* disarm parse stack cleanup */
c86b7e91 932 LEAVE; /* force stack free before we return */
e1f15930 933
0de566d7 934 return yyresult;
e1f15930 935}
66610fdd 936
937/*
938 * Local variables:
939 * c-indentation-style: bsd
940 * c-basic-offset: 4
941 * indent-tabs-mode: t
942 * End:
943 *
37442d52 944 * ex: set ts=8 sts=4 sw=4 noet:
945 */