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