This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
delete dead code and macros from perly.c
[perl5.git] / perly.c
CommitLineData
0de566d7
DM
1/* perly.c
2 *
54ca4ee7 3 * Copyright (c) 2004, 2005, 2006 Larry Wall and others
0de566d7
DM
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
DM
10 * and edited; the bits that are dependent on perly.y are now
11 * #included from the files perly.tab and perly.act.
0de566d7
DM
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
DM
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
DM
23 * but which includes extra code for dumping the parse tree.
24 * This is controlled by the PERL_IN_MADLY_C define.
0de566d7
DM
25 */
26
27
3797f23d 28
0de566d7
DM
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
DM
36typedef unsigned char yytype_uint8;
37typedef signed char yytype_int8;
38typedef unsigned short int yytype_uint16;
39typedef short int yytype_int16;
0de566d7
DM
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
DM
48/* contains all the parser state tables; auto-generated from perly.y */
49#include "perly.tab"
0de566d7
DM
50
51# define YYSIZE_T size_t
52
0de566d7
DM
53#define YYEMPTY (-2)
54#define YYEOF 0
07a06489 55#define YYTERROR 1
0de566d7
DM
56
57#define YYACCEPT goto yyacceptlab
58#define YYABORT goto yyabortlab
59#define YYERROR goto yyerrlab1
60
0de566d7 61/* Enable debugging if requested. */
9388183f 62#ifdef DEBUGGING
0de566d7
DM
63
64# define yydebug (DEBUG_p_TEST)
65
66# define YYFPRINTF PerlIO_printf
67
68# define YYDPRINTF(Args) \
69do { \
70 if (yydebug) \
71 YYFPRINTF Args; \
72} while (0)
73
9388183f 74# define YYDSYMPRINTF(Title, Token, Value) \
0de566d7
DM
75do { \
76 if (yydebug) { \
77 YYFPRINTF (Perl_debug_log, "%s ", Title); \
356f4fed 78 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
0de566d7
DM
79 YYFPRINTF (Perl_debug_log, "\n"); \
80 } \
81} while (0)
82
83/*--------------------------------.
84| Print this symbol on YYOUTPUT. |
85`--------------------------------*/
86
87static void
356f4fed 88yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
0de566d7 89{
0de566d7
DM
90 if (yytype < YYNTOKENS) {
91 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
92# ifdef YYPRINT
93 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
9388183f 94# else
e4584336 95 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
0de566d7
DM
96# endif
97 }
98 else
99 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
100
0de566d7
DM
101 YYFPRINTF (yyoutput, ")");
102}
103
104
9388183f
CB
105/* yy_stack_print()
106 * print the top 8 items on the parse stack. The args have the same
107 * meanings as the local vars in yyparse() of the same name */
0de566d7
DM
108
109static void
df35152e 110yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
0de566d7 111{
9388183f
CB
112 int i;
113 int start = 1;
114 int count = (int)(yyssp - yyss);
115
116 if (count > 8) {
117 start = count - 8 + 1;
118 count = 8;
119 }
120
121 PerlIO_printf(Perl_debug_log, "\nindex:");
122 for (i=0; i < count; i++)
123 PerlIO_printf(Perl_debug_log, " %8d", start+i);
124 PerlIO_printf(Perl_debug_log, "\nstate:");
21612876
DM
125 for (i=0; i < count; i++)
126 PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
9388183f 127 PerlIO_printf(Perl_debug_log, "\ntoken:");
21612876
DM
128 for (i=0; i < count; i++)
129 PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
9388183f 130 PerlIO_printf(Perl_debug_log, "\nvalue:");
21612876 131 for (i=0; i < count; i++) {
d5c6462e
DM
132 switch (yy_type_tab[yystos[yyss[start+i]]]) {
133 case toketype_opval:
21612876
DM
134 PerlIO_printf(Perl_debug_log, " %8.8s",
135 yyvs[start+i].opval
136 ? PL_op_name[yyvs[start+i].opval->op_type]
670f3923 137 : "(Nullop)"
21612876 138 );
d5c6462e
DM
139 break;
140#ifndef PERL_IN_MADLY_C
141 case toketype_p_tkval:
142 PerlIO_printf(Perl_debug_log, " %8.8s",
143 yyvs[start+i].pval ? yyvs[start+i].pval : "(NULL)");
144 break;
145
146 case toketype_i_tkval:
147#endif
148 case toketype_ival:
ca06c01c 149 PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)yyvs[start+i].ival);
d5c6462e
DM
150 break;
151 default:
21612876 152 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
d5c6462e 153 }
21612876 154 }
9388183f 155 PerlIO_printf(Perl_debug_log, "\n\n");
0de566d7
DM
156}
157
9388183f 158# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns) \
0de566d7 159do { \
9388183f
CB
160 if (yydebug && DEBUG_v_TEST) \
161 yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
0de566d7
DM
162} while (0)
163
09bef843 164
0de566d7
DM
165/*------------------------------------------------.
166| Report that the YYRULE is going to be reduced. |
167`------------------------------------------------*/
168
169static void
170yy_reduce_print (pTHX_ int yyrule)
171{
172 int yyi;
df35152e 173 const unsigned int yylineno = yyrline[yyrule];
0de566d7
DM
174 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
175 yyrule - 1, yylineno);
176 /* Print the symbols being reduced, and their result. */
177 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
178 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
179 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
180}
181
182# define YY_REDUCE_PRINT(Rule) \
183do { \
184 if (yydebug) \
185 yy_reduce_print (aTHX_ Rule); \
186} while (0)
187
188#else /* !DEBUGGING */
189# define YYDPRINTF(Args)
9388183f
CB
190# define YYDSYMPRINTF(Title, Token, Value)
191# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
0de566d7
DM
192# define YY_REDUCE_PRINT(Rule)
193#endif /* !DEBUGGING */
194
195
196/* YYINITDEPTH -- initial size of the parser's stacks. */
07a06489 197#define YYINITDEPTH 200
718a7425
DM
198
199/* a snapshot of the current stack position variables for use by
200 * S_clear_yystack */
201
202typedef struct {
203 short *yyss;
204 short *yyssp;
205 YYSTYPE *yyvsp;
206 AV **yypsp;
207 int yylen;
208} yystack_positions;
209
210/* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
211 * parse stack, thus avoiding leaks if we die */
212
213static void
214S_clear_yystack(pTHX_ const void *p)
215{
216 yystack_positions *y = (yystack_positions*) p;
670f3923 217 int i;
718a7425
DM
218
219 if (!y->yyss)
220 return;
221 YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
670f3923
DM
222
223 /* Freeing ops on the stack, and the op_latefree/op_latefreed flags:
224 *
225 * When we pop tokens off the stack during error recovery, or when
226 * we pop all the tokens off the stack after a die during a shift or
227 * reduce (ie Perl_croak somewhere in yylex(), or in one of the
228 * newFOO() functions, then its possible that some of these tokens are
229 * of type opval, pointing to an OP. All these ops are orphans; each is
230 * its own miniature subtree that has not yet been attached to a
231 * larger tree. In this case, we shoould clearly free the op (making
232 * sure, for each op we free thyat we have PL_comppad pointing to the
233 * right place for freeing any SVs attached to the op in threaded
234 * builds.
235 *
236 * However, there is a particular problem if we die in newFOO called
237 * by a reducing action; e.g.
238 *
239 * foo : bar baz boz
240 * { $$ = newFOO($1,$2,$3) }
241 *
242 * where
243 * OP *newFOO { .... croak .... }
244 *
245 * In this case, when we come to clean bar baz and boz off the stack,
246 * we don't know whether newFOO() has already:
247 * * freed them
248 * * left them as it
249 * * attached them to part of a larger tree
250 *
251 * To get round this problem, we set the flag op_latefree on every op
252 * that gets pushed onto the parser stack. If op_free() sees this
253 * flag, it clears the op and frees any children,, but *doesn't* free
254 * the op itself; instead it sets the op_latefreed flag. This means
255 * that we can safely call op_free() multiple times on each stack op.
256 * So, when clearing the stack, we first, for each op that was being
257 * reduced, call op_free with op_latefree=1. This ensures that all ops
258 * hanging off these op are freed, but the reducing ops themselces are
259 * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
260 * and free them. A little though should convince you that this
261 * two-part approach to the reducing ops should handle all three cases
262 * above safely.
263 */
264
265 /* free any reducing ops (1st pass) */
266
267 for (i=0; i< y->yylen; i++) {
268 if (yy_type_tab[yystos[y->yyssp[-i]]] == toketype_opval
269 && y->yyvsp[-i].opval) {
270 if (y->yypsp[-i] != PL_comppad) {
271 PAD_RESTORE_LOCAL(y->yypsp[-i]);
272 }
273 op_free(y->yyvsp[-i].opval);
274 }
275 }
276
277 /* now free whole the stack, including the just-reduced ops */
278
718a7425 279 while (y->yyssp > y->yyss) {
670f3923
DM
280 if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval
281 && y->yyvsp->opval)
282 {
718a7425
DM
283 if (*y->yypsp != PL_comppad) {
284 PAD_RESTORE_LOCAL(*y->yypsp);
285 }
286 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
670f3923 287 y->yyvsp->opval->op_latefree = 0;
718a7425
DM
288 op_free(y->yyvsp->opval);
289 }
290 y->yyvsp--;
291 y->yyssp--;
292 y->yypsp--;
293 }
294}
295
296
297
0de566d7
DM
298/*----------.
299| yyparse. |
300`----------*/
301
79072805 302int
bc463c31
DM
303#ifdef PERL_IN_MADLY_C
304Perl_madparse (pTHX)
305#else
0de566d7 306Perl_yyparse (pTHX)
bc463c31 307#endif
79072805 308{
97aff369 309 dVAR;
0de566d7
DM
310 int yychar; /* The lookahead symbol. */
311 YYSTYPE yylval; /* The semantic value of the lookahead symbol. */
312 int yynerrs; /* Number of syntax errors so far. */
313 register int yystate;
314 register int yyn;
315 int yyresult;
316
317 /* Number of tokens to shift before error messages enabled. */
318 int yyerrstatus;
319 /* Lookahead token as an internal (translated) token number. */
320 int yytoken = 0;
321
718a7425 322 /* three stacks and their tools:
a0288114
AL
323 yyss: related to states,
324 yyvs: related to semantic values,
718a7425
DM
325 yyps: current value of PL_comppad for each state
326
0de566d7
DM
327
328 Refer to the stacks thru separate pointers, to allow yyoverflow
329 to reallocate them elsewhere. */
330
331 /* The state stack. */
332 short *yyss;
93a17b20 333 register short *yyssp;
0de566d7
DM
334
335 /* The semantic value stack. */
336 YYSTYPE *yyvs;
93a17b20 337 register YYSTYPE *yyvsp;
a0d0e21e 338
718a7425
DM
339 AV **yyps;
340 AV **yypsp;
341
342 /* for ease of re-allocation and automatic freeing, have three SVs whose
0de566d7 343 * SvPVX points to the stacks */
718a7425
DM
344 SV *yyss_sv, *yyvs_sv, *yyps_sv;
345 SV *ss_save_sv;
346 yystack_positions *ss_save;
347
0de566d7 348
9388183f
CB
349#ifdef DEBUGGING
350 /* maintain also a stack of token/rule names for debugging with -Dpv */
e1ec3a88 351 const char **yyns, **yynsp;
9388183f 352 SV *yyns_sv;
718a7425 353# define YYPOPSTACK (yyvsp--, yyssp--, yypsp--, yynsp--)
9388183f 354#else
718a7425 355# define YYPOPSTACK (yyvsp--, yyssp--, yypsp--)
9388183f
CB
356#endif
357
0de566d7
DM
358
359 YYSIZE_T yystacksize = YYINITDEPTH;
360
361 /* The variables used to return semantic value and location from the
362 action routines. */
363 YYSTYPE yyval;
364
365
366 /* When reducing, the number of symbols on the RHS of the reduced
367 rule. */
368 int yylen;
369
bc463c31
DM
370#ifndef PERL_IN_MADLY_C
371# ifdef PERL_MAD
00e74f14
NC
372 if (PL_madskills)
373 return madparse();
bc463c31 374# endif
81d86705
NC
375#endif
376
0de566d7
DM
377 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
378
0de566d7 379 ENTER; /* force stack free before we return */
12fbd33b
DM
380 SAVEVPTR(PL_yycharp);
381 SAVEVPTR(PL_yylvalp);
382 PL_yycharp = &yychar; /* so PL_yyerror() can access it */
383 PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
384
561b68a9
SH
385 yyss_sv = newSV(YYINITDEPTH * sizeof(short));
386 yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
718a7425
DM
387 yyps_sv = newSV(YYINITDEPTH * sizeof(AV*));
388 ss_save_sv = newSV(sizeof(yystack_positions));
0de566d7
DM
389 SAVEFREESV(yyss_sv);
390 SAVEFREESV(yyvs_sv);
718a7425
DM
391 SAVEFREESV(yyps_sv);
392 SAVEFREESV(ss_save_sv);
0de566d7
DM
393 yyss = (short *) SvPVX(yyss_sv);
394 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
718a7425
DM
395 yyps = (AV **) SvPVX(yyps_sv);
396 ss_save = (yystack_positions *) SvPVX(ss_save_sv);
397
398 ss_save->yyss = NULL; /* disarm stack cleanup */
399 /* cleanup the parse stack on premature exit */
400 SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
401
9388183f
CB
402 /* note that elements zero of yyvs and yyns are not used */
403 yyssp = yyss;
404 yyvsp = yyvs;
718a7425 405 yypsp = yyps;
9388183f 406#ifdef DEBUGGING
561b68a9 407 yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
9388183f 408 SAVEFREESV(yyns_sv);
a28509cc 409 /* XXX This seems strange to cast char * to char ** */
94a11853 410 yyns = (const char **) SvPVX(yyns_sv);
9388183f
CB
411 yynsp = yyns;
412#endif
79072805 413
05a03161
DM
414 *yyssp = 0;
415 yyvsp->ival = 0;
0de566d7 416 yyerrstatus = 0;
93a17b20 417 yynerrs = 0;
0de566d7
DM
418 yychar = YYEMPTY; /* Cause a token to be read. */
419
0de566d7
DM
420/*------------------------------------------------------------.
421| yynewstate -- Push a new state, which is found in yystate. |
422`------------------------------------------------------------*/
423 yynewstate:
0de566d7 424
05a03161
DM
425 yystate = *yyssp;
426
670f3923 427 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7 428
670f3923
DM
429 if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
430 yyvsp->opval->op_latefree = 1;
431 yyvsp->opval->op_latefreed = 0;
432 }
433
434 ss_save->yyss = yyss;
435 ss_save->yyssp = yyssp;
436 ss_save->yyvsp = yyvsp;
437 ss_save->yypsp = yypsp;
438 ss_save->yylen = 0;
439
0de566d7
DM
440 if (yyss + yystacksize - 1 <= yyssp) {
441 /* Get the current used size of the three stacks, in elements. */
df35152e 442 const YYSIZE_T yysize = yyssp - yyss + 1;
0de566d7
DM
443
444 /* Extend the stack our own way. */
445 if (YYMAXDEPTH <= yystacksize)
446 goto yyoverflowlab;
447 yystacksize *= 2;
448 if (YYMAXDEPTH < yystacksize)
449 yystacksize = YYMAXDEPTH;
450
451 SvGROW(yyss_sv, yystacksize * sizeof(short));
452 SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
718a7425 453 SvGROW(yyps_sv, yystacksize * sizeof(AV*));
0de566d7
DM
454 yyss = (short *) SvPVX(yyss_sv);
455 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
718a7425 456 yyps = (AV **) SvPVX(yyps_sv);
9388183f
CB
457#ifdef DEBUGGING
458 SvGROW(yyns_sv, yystacksize * sizeof(char *));
a28509cc 459 /* XXX This seems strange to cast char * to char ** */
94a11853 460 yyns = (const char **) SvPVX(yyns_sv);
9388183f
CB
461 if (! yyns)
462 goto yyoverflowlab;
463 yynsp = yyns + yysize - 1;
464#endif
718a7425 465 if (!yyss || ! yyvs || ! yyps)
0de566d7
DM
466 goto yyoverflowlab;
467
468 yyssp = yyss + yysize - 1;
469 yyvsp = yyvs + yysize - 1;
718a7425 470 yypsp = yyps + yysize - 1;
0de566d7
DM
471
472
473 YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
474 (unsigned long int) yystacksize));
475
476 if (yyss + yystacksize - 1 <= yyssp)
477 YYABORT;
670f3923
DM
478
479 ss_save->yyss = yyss;
480 ss_save->yyssp = yyssp;
481 ss_save->yyvsp = yyvsp;
482 ss_save->yypsp = yypsp;
483 ss_save->yylen = 0;
93a17b20 484 }
0de566d7 485
0de566d7
DM
486/* Do appropriate processing given the current state. */
487/* Read a lookahead token if we need one and don't already have one. */
488/* yyresume: */
489
490 /* First try to decide what to do without reference to lookahead token. */
491
492 yyn = yypact[yystate];
493 if (yyn == YYPACT_NINF)
494 goto yydefault;
495
496 /* Not known => get a lookahead token if don't already have one. */
497
498 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
499 if (yychar == YYEMPTY) {
500 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 501#ifdef PERL_IN_MADLY_C
00e74f14 502 yychar = PL_madskills ? madlex() : yylex();
f05e27e5 503#else
12fbd33b 504 yychar = yylex();
81d86705 505#endif
bc463c31 506
12fbd33b
DM
507# ifdef EBCDIC
508 if (yychar >= 0 && yychar < 255) {
509 yychar = NATIVE_TO_ASCII(yychar);
510 }
511# endif
0de566d7
DM
512 }
513
514 if (yychar <= YYEOF) {
515 yychar = yytoken = YYEOF;
516 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 517 }
0de566d7
DM
518 else {
519 yytoken = YYTRANSLATE (yychar);
9388183f 520 YYDSYMPRINTF ("Next token is", yytoken, &yylval);
93a17b20 521 }
771df094 522
0de566d7
DM
523 /* If the proper action on seeing token YYTOKEN is to reduce or to
524 detect an error, take that action. */
525 yyn += yytoken;
526 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
527 goto yydefault;
528 yyn = yytable[yyn];
529 if (yyn <= 0) {
530 if (yyn == 0 || yyn == YYTABLE_NINF)
531 goto yyerrlab;
532 yyn = -yyn;
533 goto yyreduce;
534 }
7b57b0ea 535
0de566d7
DM
536 if (yyn == YYFINAL)
537 YYACCEPT;
771df094 538
0de566d7
DM
539 /* Shift the lookahead token. */
540 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
541
542 /* Discard the token being shifted unless it is eof. */
543 if (yychar != YYEOF)
544 yychar = YYEMPTY;
545
05a03161 546 *++yyssp = yyn;
0de566d7 547 *++yyvsp = yylval;
718a7425 548 *++yypsp = PL_comppad;
9388183f 549#ifdef DEBUGGING
e1ec3a88 550 *++yynsp = (const char *)(yytname[yytoken]);
9388183f 551#endif
0de566d7
DM
552
553
554 /* Count tokens shifted since error; after three, turn off error
555 status. */
556 if (yyerrstatus)
557 yyerrstatus--;
558
0de566d7
DM
559 goto yynewstate;
560
561
562 /*-----------------------------------------------------------.
563 | yydefault -- do the default action for the current state. |
564 `-----------------------------------------------------------*/
565 yydefault:
566 yyn = yydefact[yystate];
567 if (yyn == 0)
568 goto yyerrlab;
569 goto yyreduce;
570
571
572 /*-----------------------------.
573 | yyreduce -- Do a reduction. |
574 `-----------------------------*/
575 yyreduce:
576 /* yyn is the number of a rule to reduce with. */
577 yylen = yyr2[yyn];
578
579 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 580 "$$ = $1".
0de566d7
DM
581
582 Otherwise, the following line sets YYVAL to garbage.
583 This behavior is undocumented and Bison
584 users should not rely upon it. Assigning to YYVAL
585 unconditionally makes the parser a bit smaller, and it avoids a
586 GCC warning that YYVAL may be used uninitialized. */
587 yyval = yyvsp[1-yylen];
588
4d28fe79 589 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
0de566d7 590 YY_REDUCE_PRINT (yyn);
718a7425
DM
591
592 /* running external code may trigger a die (eg 'use nosuchmodule'):
593 * record the current stack state so that an unwind will
594 * free all the pesky OPs lounging around on the parse stack */
595 ss_save->yyss = yyss;
596 ss_save->yyssp = yyssp;
597 ss_save->yyvsp = yyvsp;
598 ss_save->yypsp = yypsp;
599 ss_save->yylen = yylen;
600
0de566d7
DM
601 switch (yyn) {
602
0de566d7
DM
603
604#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 605
bc463c31 606#ifdef PERL_IN_MADLY_C
f05e27e5
DM
607# define IVAL(i) (i)->tk_lval.ival
608# define PVAL(p) (p)->tk_lval.pval
609# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
610# define TOKEN_FREE(a) token_free(a)
611# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
612# define IF_MAD(a,b) (a)
613# define DO_MAD(a) a
614# define MAD
bc463c31 615#else
f05e27e5
DM
616# define IVAL(i) (i)
617# define PVAL(p) (p)
618# define TOKEN_GETMAD(a,b,c)
619# define TOKEN_FREE(a)
620# define OP_GETMAD(a,b,c)
621# define IF_MAD(a,b) (b)
622# define DO_MAD(a)
623# undef MAD
bc463c31 624#endif
7b57b0ea 625
f05e27e5
DM
626/* contains all the rule actions; auto-generated from perly.y */
627#include "perly.act"
628
93a17b20 629 }
0de566d7 630
670f3923
DM
631 /* any just-reduced ops with the op_latefreed flag cleared need to be
632 * freed; the rest need the flag resetting */
633 {
634 int i;
635 for (i=0; i< yylen; i++) {
636 if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
637 && yyvsp[-i].opval)
638 {
639 yyvsp[-i].opval->op_latefree = 0;
640 if (yyvsp[-i].opval->op_latefreed)
641 op_free(yyvsp[-i].opval);
642 }
643 }
644 }
645
0de566d7
DM
646 yyvsp -= yylen;
647 yyssp -= yylen;
718a7425 648 yypsp -= yylen;
9388183f
CB
649#ifdef DEBUGGING
650 yynsp -= yylen;
651#endif
0de566d7 652
05a03161
DM
653 /* Now shift the result of the reduction. Determine what state
654 that goes to, based on the state we popped back to and the rule
655 number reduced by. */
656
0de566d7 657 *++yyvsp = yyval;
718a7425 658 *++yypsp = PL_comppad;
9388183f 659#ifdef DEBUGGING
e1ec3a88 660 *++yynsp = (const char *)(yytname [yyr1[yyn]]);
9388183f 661#endif
0de566d7
DM
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];
93a17b20 668 else
0de566d7 669 yystate = yydefgoto[yyn - YYNTOKENS];
05a03161
DM
670 *++yyssp = yystate;
671
0de566d7
DM
672 goto yynewstate;
673
674
675 /*------------------------------------.
676 | yyerrlab -- here on detecting error |
677 `------------------------------------*/
678 yyerrlab:
679 /* If not already recovering from an error, report this error. */
680 if (!yyerrstatus) {
681 ++yynerrs;
07a06489 682 yyerror ("syntax error");
93a17b20 683 }
0de566d7
DM
684
685
686 if (yyerrstatus == 3) {
687 /* If just tried and failed to reuse lookahead token after an
688 error, discard it. */
689
690 /* Return failure if at end of input. */
691 if (yychar == YYEOF) {
692 /* Pop the error token. */
693 YYPOPSTACK;
694 /* Pop the rest of the stack. */
695 while (yyss < yyssp) {
9388183f 696 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
670f3923
DM
697 if (yy_type_tab[yystos[*yyssp]] == toketype_opval
698 && yyvsp->opval)
699 {
0539ab63 700 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
718a7425
DM
701 if (*yypsp != PL_comppad) {
702 PAD_RESTORE_LOCAL(*yypsp);
703 }
670f3923 704 yyvsp->opval->op_latefree = 0;
0539ab63
DM
705 op_free(yyvsp->opval);
706 }
0de566d7
DM
707 YYPOPSTACK;
708 }
709 YYABORT;
710 }
711
9388183f 712 YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
0de566d7
DM
713 yychar = YYEMPTY;
714
93a17b20 715 }
0de566d7
DM
716
717 /* Else will try to reuse lookahead token after shifting the error
718 token. */
719 goto yyerrlab1;
720
721
722 /*----------------------------------------------------.
723 | yyerrlab1 -- error raised explicitly by an action. |
724 `----------------------------------------------------*/
725 yyerrlab1:
726 yyerrstatus = 3; /* Each real token shifted decrements this. */
727
728 for (;;) {
729 yyn = yypact[yystate];
730 if (yyn != YYPACT_NINF) {
731 yyn += YYTERROR;
732 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
733 yyn = yytable[yyn];
734 if (0 < yyn)
735 break;
736 }
737 }
738
739 /* Pop the current state because it cannot handle the error token. */
740 if (yyssp == yyss)
741 YYABORT;
742
9388183f 743 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
670f3923 744 if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
0539ab63 745 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
718a7425
DM
746 if (*yypsp != PL_comppad) {
747 PAD_RESTORE_LOCAL(*yypsp);
748 }
670f3923 749 yyvsp->opval->op_latefree = 0;
0539ab63
DM
750 op_free(yyvsp->opval);
751 }
0de566d7 752 yyvsp--;
718a7425 753 yypsp--;
9388183f
CB
754#ifdef DEBUGGING
755 yynsp--;
756#endif
0de566d7
DM
757 yystate = *--yyssp;
758
9388183f 759 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
93a17b20 760 }
0de566d7
DM
761
762 if (yyn == YYFINAL)
763 YYACCEPT;
764
765 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
766
05a03161 767 *++yyssp = yyn;
0de566d7 768 *++yyvsp = yylval;
718a7425 769 *++yypsp = PL_comppad;
9388183f
CB
770#ifdef DEBUGGING
771 *++yynsp ="<err>";
772#endif
0de566d7 773
0de566d7
DM
774 goto yynewstate;
775
776
777 /*-------------------------------------.
778 | yyacceptlab -- YYACCEPT comes here. |
779 `-------------------------------------*/
780 yyacceptlab:
781 yyresult = 0;
782 goto yyreturn;
783
784 /*-----------------------------------.
785 | yyabortlab -- YYABORT comes here. |
786 `-----------------------------------*/
787 yyabortlab:
788 yyresult = 1;
789 goto yyreturn;
790
791 /*----------------------------------------------.
792 | yyoverflowlab -- parser overflow comes here. |
793 `----------------------------------------------*/
794 yyoverflowlab:
795 yyerror ("parser stack overflow");
796 yyresult = 2;
797 /* Fall through. */
798
799 yyreturn:
800
718a7425 801 ss_save->yyss = NULL; /* disarm parse stack cleanup */
c86b7e91 802 LEAVE; /* force stack free before we return */
e1f15930 803
0de566d7 804 return yyresult;
e1f15930 805}
66610fdd
RGS
806
807/*
808 * Local variables:
809 * c-indentation-style: bsd
810 * c-basic-offset: 4
811 * indent-tabs-mode: t
812 * End:
813 *
37442d52
RGS
814 * ex: set ts=8 sts=4 sw=4 noet:
815 */