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