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