57eba7105a3647b431a14db3f08b1b754d054341
[p5sagit/p5-mst-13.2.git] / perly.c
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
30 typedef 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)                                  \
62 do                                                              \
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     }                                                           \
74 while (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)                       \
87 do {                                            \
88     if (yydebug)                                \
89         YYFPRINTF Args;                         \
90 } while (0)
91
92 #  define YYDSYMPRINT(Args)                     \
93 do {                                            \
94     if (yydebug)                                \
95         yysymprint Args;                        \
96 } while (0)
97
98 #  define YYDSYMPRINTF(Title, Token, Value)                     \
99 do {                                                            \
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
111 static void
112 yysymprint (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
133 static void
134 yy_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)               \
161 do {                                                            \
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
171 static void
172 yy_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)         \
185 do {                                    \
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.  */
211 static YYSIZE_T
212 yystrlen (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.  */
230 static char *
231 yystpcpy (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
250 int
251 Perl_yyparse (pTHX)
252 {
253     dVAR;
254     int yychar; /* The lookahead symbol.  */
255     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
256     int yynerrs; /* Number of syntax errors so far.  */
257     register int yystate;
258     register int yyn;
259     int yyresult;
260
261     /* Number of tokens to shift before error messages enabled.  */
262     int yyerrstatus;
263     /* Lookahead token as an internal (translated) token number.  */
264     int yytoken = 0;
265
266     /* two stacks and their tools:
267           yyss: related to states,
268           yyvs: related to semantic values,
269
270           Refer to the stacks thru separate pointers, to allow yyoverflow
271           to reallocate them elsewhere.  */
272
273     /* The state stack.  */
274     short *yyss;
275     register short *yyssp;
276
277     /* The semantic value stack.  */
278     YYSTYPE *yyvs;
279     register YYSTYPE *yyvsp;
280
281     /* for ease of re-allocation and automatic freeing, have two SVs whose
282       * SvPVX points to the stacks */
283     SV *yyss_sv, *yyvs_sv;
284
285 #ifdef DEBUGGING
286     /* maintain also a stack of token/rule names for debugging with -Dpv */
287     const char **yyns, **yynsp;
288     SV *yyns_sv;
289 #  define YYPOPSTACK   (yyvsp--, yyssp--, yynsp--)
290 #else
291 #  define YYPOPSTACK   (yyvsp--, yyssp--)
292 #endif
293
294
295     YYSIZE_T yystacksize = YYINITDEPTH;
296
297     /* The variables used to return semantic value and location from the
298           action routines.  */
299     YYSTYPE yyval;
300
301
302     /* When reducing, the number of symbols on the RHS of the reduced
303           rule.  */
304     int yylen;
305
306     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
307
308     ENTER;                      /* force stack free before we return */
309     SAVEVPTR(PL_yycharp);
310     SAVEVPTR(PL_yylvalp);
311     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
312     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
313
314     yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
315     yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
316     SAVEFREESV(yyss_sv);
317     SAVEFREESV(yyvs_sv);
318     yyss = (short *) SvPVX(yyss_sv);
319     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
320     /* note that elements zero of yyvs and yyns are not used */
321     yyssp = yyss;
322     yyvsp = yyvs;
323 #ifdef DEBUGGING
324     yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
325     SAVEFREESV(yyns_sv);
326     /* XXX This seems strange to cast char * to char ** */
327     yyns = (const char **) SvPVX(yyns_sv);
328     yynsp = yyns;
329 #endif
330
331     yystate = 0;
332     yyerrstatus = 0;
333     yynerrs = 0;
334     yychar = YYEMPTY;           /* Cause a token to be read.  */
335
336
337
338     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
339
340     goto yysetstate;
341
342 /*------------------------------------------------------------.
343 | yynewstate -- Push a new state, which is found in yystate.  |
344 `------------------------------------------------------------*/
345   yynewstate:
346     /* In all cases, when you get here, the value and location stacks
347           have just been pushed. so pushing a state here evens the stacks.
348           */
349     yyssp++;
350
351   yysetstate:
352     *yyssp = yystate;
353
354     if (yyss + yystacksize - 1 <= yyssp) {
355          /* Get the current used size of the three stacks, in elements.  */
356          const YYSIZE_T yysize = yyssp - yyss + 1;
357
358          /* Extend the stack our own way.  */
359          if (YYMAXDEPTH <= yystacksize)
360                goto yyoverflowlab;
361          yystacksize *= 2;
362          if (YYMAXDEPTH < yystacksize)
363                yystacksize = YYMAXDEPTH;
364
365          SvGROW(yyss_sv, yystacksize * sizeof(short));
366          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
367          yyss = (short *) SvPVX(yyss_sv);
368          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
369 #ifdef DEBUGGING
370          SvGROW(yyns_sv, yystacksize * sizeof(char *));
371          /* XXX This seems strange to cast char * to char ** */
372          yyns = (const char **) SvPVX(yyns_sv);
373          if (! yyns)
374                goto yyoverflowlab;
375          yynsp = yyns + yysize - 1;
376 #endif
377          if (!yyss || ! yyvs)
378                goto yyoverflowlab;
379
380          yyssp = yyss + yysize - 1;
381          yyvsp = yyvs + yysize - 1;
382
383
384          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
385                                    (unsigned long int) yystacksize));
386
387          if (yyss + yystacksize - 1 <= yyssp)
388                YYABORT;
389     }
390
391     goto yybackup;
392
393   /*-----------.
394   | yybackup.  |
395   `-----------*/
396   yybackup:
397
398 /* Do appropriate processing given the current state.  */
399 /* Read a lookahead token if we need one and don't already have one.  */
400 /* yyresume: */
401
402     /* First try to decide what to do without reference to lookahead token.  */
403
404     yyn = yypact[yystate];
405     if (yyn == YYPACT_NINF)
406         goto yydefault;
407
408     /* Not known => get a lookahead token if don't already have one.  */
409
410     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
411     if (yychar == YYEMPTY) {
412         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
413         yychar = yylex();
414 #  ifdef EBCDIC
415         if (yychar >= 0 && yychar < 255) {
416             yychar = NATIVE_TO_ASCII(yychar);
417         }
418 #  endif
419     }
420
421     if (yychar <= YYEOF) {
422         yychar = yytoken = YYEOF;
423         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
424     }
425     else {
426         yytoken = YYTRANSLATE (yychar);
427         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
428     }
429
430     /* If the proper action on seeing token YYTOKEN is to reduce or to
431           detect an error, take that action.  */
432     yyn += yytoken;
433     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
434         goto yydefault;
435     yyn = yytable[yyn];
436     if (yyn <= 0) {
437         if (yyn == 0 || yyn == YYTABLE_NINF)
438             goto yyerrlab;
439         yyn = -yyn;
440         goto yyreduce;
441     }
442
443     if (yyn == YYFINAL)
444         YYACCEPT;
445
446     /* Shift the lookahead token.  */
447     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
448
449     /* Discard the token being shifted unless it is eof.  */
450     if (yychar != YYEOF)
451         yychar = YYEMPTY;
452
453     *++yyvsp = yylval;
454 #ifdef DEBUGGING
455     *++yynsp = (const char *)(yytname[yytoken]);
456 #endif
457
458
459     /* Count tokens shifted since error; after three, turn off error
460           status.  */
461     if (yyerrstatus)
462         yyerrstatus--;
463
464     yystate = yyn;
465     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
466
467     goto yynewstate;
468
469
470   /*-----------------------------------------------------------.
471   | yydefault -- do the default action for the current state.  |
472   `-----------------------------------------------------------*/
473   yydefault:
474     yyn = yydefact[yystate];
475     if (yyn == 0)
476         goto yyerrlab;
477     goto yyreduce;
478
479
480   /*-----------------------------.
481   | yyreduce -- Do a reduction.  |
482   `-----------------------------*/
483   yyreduce:
484     /* yyn is the number of a rule to reduce with.  */
485     yylen = yyr2[yyn];
486
487     /* If YYLEN is nonzero, implement the default value of the action:
488       "$$ = $1".
489
490       Otherwise, the following line sets YYVAL to garbage.
491       This behavior is undocumented and Bison
492       users should not rely upon it.  Assigning to YYVAL
493       unconditionally makes the parser a bit smaller, and it avoids a
494       GCC warning that YYVAL may be used uninitialized.  */
495     yyval = yyvsp[1-yylen];
496
497
498     YY_REDUCE_PRINT (yyn);
499     switch (yyn) {
500
501 /* contains all the rule actions; auto-generated from perly.y */
502
503 #define dep() deprecate("\"do\" to call subroutines")
504 #include "perly.act"
505
506     }
507
508     yyvsp -= yylen;
509     yyssp -= yylen;
510 #ifdef DEBUGGING
511     yynsp -= yylen;
512 #endif
513
514
515     *++yyvsp = yyval;
516 #ifdef DEBUGGING
517     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
518 #endif
519
520     /* Now shift the result of the reduction.  Determine what state
521           that goes to, based on the state we popped back to and the rule
522           number reduced by.  */
523
524     yyn = yyr1[yyn];
525
526     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
527     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
528         yystate = yytable[yystate];
529     else
530         yystate = yydefgoto[yyn - YYNTOKENS];
531
532     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
533
534 #ifdef DEBUGGING
535     /* tmp push yystate for stack print; this is normally pushed later in
536      * yynewstate */
537     yyssp++;
538     *yyssp = yystate;
539     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
540     yyssp--;
541 #endif
542
543     goto yynewstate;
544
545
546   /*------------------------------------.
547   | yyerrlab -- here on detecting error |
548   `------------------------------------*/
549   yyerrlab:
550     /* If not already recovering from an error, report this error.  */
551     if (!yyerrstatus) {
552         ++yynerrs;
553 #if YYERROR_VERBOSE
554         yyn = yypact[yystate];
555
556         if (YYPACT_NINF < yyn && yyn < YYLAST) {
557             YYSIZE_T yysize = 0;
558             const int yytype = YYTRANSLATE (yychar);
559             char *yymsg;
560             int yyx, yycount;
561
562             yycount = 0;
563             /* Start YYX at -YYN if negative to avoid negative indexes in
564                   YYCHECK.  */
565             for (yyx = yyn < 0 ? -yyn : 0;
566                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
567                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
568                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
569             yysize += yystrlen ("syntax error, unexpected ") + 1;
570             yysize += yystrlen (yytname[yytype]);
571             Newx(yymsg, yysize, char *);
572             if (yymsg != 0) {
573                 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
574                 yyp = yystpcpy (yyp, yytname[yytype]);
575
576                 if (yycount < 5) {
577                     yycount = 0;
578                     for (yyx = yyn < 0 ? -yyn : 0;
579                               yyx < (int) (sizeof (yytname) / sizeof (char *));
580                               yyx++)
581                     {
582                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
583                             const char *yyq = ! yycount ?
584                                                     ", expecting " : " or ";
585                             yyp = yystpcpy (yyp, yyq);
586                             yyp = yystpcpy (yyp, yytname[yyx]);
587                             yycount++;
588                         }
589                     }
590                 }
591                 yyerror (yymsg);
592                 YYSTACK_FREE (yymsg);
593             }
594             else
595                 yyerror ("syntax error; also virtual memory exhausted");
596         }
597         else
598 #endif /* YYERROR_VERBOSE */
599             yyerror ("syntax error");
600     }
601
602
603     if (yyerrstatus == 3) {
604         /* If just tried and failed to reuse lookahead token after an
605               error, discard it.  */
606
607         /* Return failure if at end of input.  */
608         if (yychar == YYEOF) {
609             /* Pop the error token.  */
610             YYPOPSTACK;
611             /* Pop the rest of the stack.  */
612             while (yyss < yyssp) {
613                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
614                 YYPOPSTACK;
615             }
616             YYABORT;
617         }
618
619         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
620         yychar = YYEMPTY;
621
622     }
623
624     /* Else will try to reuse lookahead token after shifting the error
625           token.  */
626     goto yyerrlab1;
627
628
629   /*----------------------------------------------------.
630   | yyerrlab1 -- error raised explicitly by an action.  |
631   `----------------------------------------------------*/
632   yyerrlab1:
633     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
634
635     for (;;) {
636         yyn = yypact[yystate];
637         if (yyn != YYPACT_NINF) {
638             yyn += YYTERROR;
639             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
640                 yyn = yytable[yyn];
641                 if (0 < yyn)
642                     break;
643             }
644         }
645
646         /* Pop the current state because it cannot handle the error token.  */
647         if (yyssp == yyss)
648             YYABORT;
649
650         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
651         yyvsp--;
652 #ifdef DEBUGGING
653         yynsp--;
654 #endif
655         yystate = *--yyssp;
656
657         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
658     }
659
660     if (yyn == YYFINAL)
661         YYACCEPT;
662
663     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
664
665     *++yyvsp = yylval;
666 #ifdef DEBUGGING
667     *++yynsp ="<err>";
668 #endif
669
670     yystate = yyn;
671     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
672
673     goto yynewstate;
674
675
676   /*-------------------------------------.
677   | yyacceptlab -- YYACCEPT comes here.  |
678   `-------------------------------------*/
679   yyacceptlab:
680     yyresult = 0;
681     goto yyreturn;
682
683   /*-----------------------------------.
684   | yyabortlab -- YYABORT comes here.  |
685   `-----------------------------------*/
686   yyabortlab:
687     yyresult = 1;
688     goto yyreturn;
689
690   /*----------------------------------------------.
691   | yyoverflowlab -- parser overflow comes here.  |
692   `----------------------------------------------*/
693   yyoverflowlab:
694     yyerror ("parser stack overflow");
695     yyresult = 2;
696     /* Fall through.  */
697
698   yyreturn:
699
700     LEAVE;                      /* force stack free before we return */
701
702     return yyresult;
703 }
704
705 /*
706  * Local variables:
707  * c-indentation-style: bsd
708  * c-basic-offset: 4
709  * indent-tabs-mode: t
710  * End:
711  *
712  * ex: set ts=8 sts=4 sw=4 noet:
713  */