This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perly.c: silence a -Wempty-body warning
[perl5.git] / perly.c
1 /*    perly.c
2  *
3  *    Copyright (c) 2004, 2005, 2006, 2007, 2008,
4  *    2009, 2010, 2011 by Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  * 
9  *    Note that this file was originally generated as an output from
10  *    GNU bison version 1.875, but now the code is statically maintained
11  *    and edited; the bits that are dependent on perly.y are now
12  *    #included from the files perly.tab and perly.act.
13  *
14  *    Here is an important copyright statement from the original, generated
15  *    file:
16  *
17  *      As a special exception, when this file is copied by Bison into a
18  *      Bison output file, you may use that output file without
19  *      restriction.  This special exception was added by the Free
20  *      Software Foundation in version 1.24 of Bison.
21  *
22  */
23
24 #include "EXTERN.h"
25 #define PERL_IN_PERLY_C
26 #include "perl.h"
27 #include "feature.h"
28 #include "keywords.h"
29
30 typedef unsigned char yytype_uint8;
31 typedef signed char yytype_int8;
32 typedef unsigned short int yytype_uint16;
33 typedef short int yytype_int16;
34 typedef signed char yysigned_char;
35
36 /* YYINITDEPTH -- initial size of the parser's stacks.  */
37 #define YYINITDEPTH 200
38
39 #ifdef YYDEBUG
40 #  undef YYDEBUG
41 #endif
42 #ifdef DEBUGGING
43 #  define YYDEBUG 1
44 #else
45 #  define YYDEBUG 0
46 #endif
47
48 #ifndef YY_NULL
49 # define YY_NULL 0
50 #endif
51
52 #ifndef YY_NULLPTR
53 # define YY_NULLPTR NULL
54 #endif
55
56 /* contains all the parser state tables; auto-generated from perly.y */
57 #include "perly.tab"
58
59 # define YYSIZE_T size_t
60
61 /* the max number of RHS shifted elements that can make up a rule.
62  * This should really be auto-generated from the max value in yyr2[]
63  * but that involves extra work, so set it slightly higher than the
64  * current max, and assert each time yyr2[] is accessed.
65  * Used to determine if the parse stack needs extending.
66  */
67
68 #define YY_MAXRULE 15
69
70 #define YYEOF           0
71 #define YYTERROR        1
72
73 #define YYACCEPT        goto yyacceptlab
74 #define YYABORT         goto yyabortlab
75 #define YYERROR         goto yyerrlab1
76
77 /* Enable debugging if requested.  */
78 #ifdef DEBUGGING
79
80 #  define yydebug (DEBUG_p_TEST)
81
82 #  define YYFPRINTF PerlIO_printf
83
84 #  define YYDPRINTF(Args)                       \
85 do {                                            \
86     if (yydebug)                                \
87         YYFPRINTF Args;                         \
88 } while (0)
89
90 #  define YYDSYMPRINTF(Title, Token, Value)                     \
91 do {                                                            \
92     if (yydebug) {                                              \
93         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
94         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
95         YYFPRINTF (Perl_debug_log, "\n");                       \
96     }                                                           \
97 } while (0)
98
99 /*--------------------------------.
100 | Print this symbol on YYOUTPUT.  |
101 `--------------------------------*/
102
103 static void
104 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
105 {
106     PERL_UNUSED_CONTEXT;
107     if (yytype < YYNTOKENS) {
108         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
109 #   ifdef YYPRINT
110         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
111 #   else
112         YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival);
113 #   endif
114     }
115     else
116         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
117
118     YYFPRINTF (yyoutput, ")");
119 }
120
121
122 /*  yy_stack_print()
123  *  print the top 8 items on the parse stack.
124  */
125
126 static void
127 yy_stack_print (pTHX_ const yy_parser *parser)
128 {
129     const yy_stack_frame *ps, *min;
130
131     min = parser->ps - 8 + 1;
132     if (min <= parser->stack)
133         min = parser->stack + 1;
134
135     PerlIO_printf(Perl_debug_log, "\nindex:");
136     for (ps = min; ps <= parser->ps; ps++)
137         PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
138
139     PerlIO_printf(Perl_debug_log, "\nstate:");
140     for (ps = min; ps <= parser->ps; ps++)
141         PerlIO_printf(Perl_debug_log, " %8d", ps->state);
142
143     PerlIO_printf(Perl_debug_log, "\ntoken:");
144     for (ps = min; ps <= parser->ps; ps++)
145         PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
146
147     PerlIO_printf(Perl_debug_log, "\nvalue:");
148     for (ps = min; ps <= parser->ps; ps++) {
149         switch (yy_type_tab[yystos[ps->state]]) {
150         case toketype_opval:
151             PerlIO_printf(Perl_debug_log, " %8.8s",
152                   ps->val.opval
153                     ? PL_op_name[ps->val.opval->op_type]
154                     : "(Nullop)"
155             );
156             break;
157         case toketype_ival:
158             PerlIO_printf(Perl_debug_log, " %8" IVdf, (IV)ps->val.ival);
159             break;
160         default:
161             PerlIO_printf(Perl_debug_log, " %8" UVxf, (UV)ps->val.ival);
162         }
163     }
164     PerlIO_printf(Perl_debug_log, "\n\n");
165 }
166
167 #  define YY_STACK_PRINT(parser)        \
168 do {                                    \
169     if (yydebug && DEBUG_v_TEST)        \
170         yy_stack_print (aTHX_ parser);  \
171 } while (0)
172
173
174 /*------------------------------------------------.
175 | Report that the YYRULE is going to be reduced.  |
176 `------------------------------------------------*/
177
178 static void
179 yy_reduce_print (pTHX_ int yyrule)
180 {
181     int yyi;
182     const 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 #if PERL_BISON_VERSION >= 30000 /* 3.0+ */
187     for (yyi = 0; yyi < yyr2[yyrule]; yyi++)
188         YYFPRINTF (Perl_debug_log, "%s ",
189             yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]);
190 #else
191     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
192         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
193 #endif
194     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
195 }
196
197 #  define YY_REDUCE_PRINT(Rule)         \
198 do {                                    \
199     if (yydebug)                        \
200         yy_reduce_print (aTHX_ Rule);           \
201 } while (0)
202
203 #else /* !DEBUGGING */
204 #  define YYDPRINTF(Args)
205 #  define YYDSYMPRINTF(Title, Token, Value)
206 #  define YY_STACK_PRINT(parser)
207 #  define YY_REDUCE_PRINT(Rule)
208 #endif /* !DEBUGGING */
209
210 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
211  * parse stack, thus avoiding leaks if we die  */
212
213 static void
214 S_clear_yystack(pTHX_  const yy_parser *parser)
215 {
216     yy_stack_frame *ps     = parser->ps;
217     int i = 0;
218
219     if (!parser->stack)
220         return;
221
222     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
223
224     for (i=0; i< parser->yylen; i++) {
225         SvREFCNT_dec(ps[-i].compcv);
226     }
227     ps -= parser->yylen;
228
229     /* now free whole the stack, including the just-reduced ops */
230
231     while (ps > parser->stack) {
232         LEAVE_SCOPE(ps->savestack_ix);
233         if (yy_type_tab[yystos[ps->state]] == toketype_opval
234             && ps->val.opval)
235         {
236             if (ps->compcv && (ps->compcv != PL_compcv)) {
237                 PL_compcv = ps->compcv;
238                 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
239                 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
240             }
241             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
242             op_free(ps->val.opval);
243         }
244         SvREFCNT_dec(ps->compcv);
245         ps--;
246     }
247
248     Safefree(parser->stack);
249 }
250
251
252 /*----------.
253 | yyparse.  |
254 `----------*/
255
256 int
257 Perl_yyparse (pTHX_ int gramtype)
258 {
259     dVAR;
260     int yystate;
261     int yyn;
262     int yyresult;
263
264     /* Lookahead token as an internal (translated) token number.  */
265     int yytoken = 0;
266
267     yy_parser *parser;      /* the parser object */
268     yy_stack_frame  *ps;   /* current parser stack frame */
269
270 #define YYPOPSTACK   parser->ps = --ps
271 #define YYPUSHSTACK  parser->ps = ++ps
272
273     /* The variable used to return semantic value and location from the
274           action routines: ie $$.  */
275     YYSTYPE yyval;
276
277     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
278
279     parser = PL_parser;
280
281     ENTER;  /* force parser state cleanup/restoration before we return */
282     SAVEPPTR(parser->yylval.pval);
283     SAVEINT(parser->yychar);
284     SAVEINT(parser->yyerrstatus);
285     SAVEINT(parser->yylen);
286     SAVEVPTR(parser->stack);
287     SAVEVPTR(parser->stack_maxbase);
288     SAVEVPTR(parser->ps);
289
290     /* initialise state for this parse */
291     parser->yychar = gramtype;
292     yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
293
294     parser->yyerrstatus = 0;
295     parser->yylen = 0;
296     Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
297     parser->stack_maxbase = parser->stack + YYINITDEPTH - YY_MAXRULE;
298     ps = parser->ps = parser->stack;
299     ps->state = 0;
300     SAVEDESTRUCTOR_X(S_clear_yystack, parser);
301
302     while (1) {
303         /* main loop: shift some tokens, then reduce when possible */
304
305         /* grow the stack to accommodate longest possible rule */
306         if (ps >= parser->stack_maxbase) {
307             Size_t pos = ps - parser->stack;
308             Size_t newsize = 2 * (parser->stack_maxbase + YY_MAXRULE
309                                     - parser->stack);
310             /* this will croak on insufficient memory */
311             Renew(parser->stack, newsize, yy_stack_frame);
312             ps = parser->ps = parser->stack + pos;
313             parser->stack_maxbase = parser->stack + newsize - YY_MAXRULE;
314
315             YYDPRINTF((Perl_debug_log,
316                             "parser stack size increased to %lu frames\n",
317                             (unsigned long int)newsize));
318         }
319
320         while (1) {
321             /* shift a token, or quit when it's possible to reduce */
322
323             assert(ps < parser->stack_maxbase + YY_MAXRULE);
324             yystate = ps->state;
325
326             YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
327
328             parser->yylen = 0;
329
330             /* Do appropriate processing given the current state. Read a
331              * lookahead token if we need one and don't already have one.
332              * */
333
334             /* First try to decide what to do without reference to
335              * lookahead token. */
336
337             yyn = yypact[yystate];
338             if (yyn == YYPACT_NINF)
339                 goto yydefault;
340
341             /* Not known => get a lookahead token if don't already have
342              * one.  YYCHAR is either YYEMPTY or YYEOF or a valid
343              * lookahead symbol. */
344
345             if (parser->yychar == YYEMPTY) {
346                 YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
347                 parser->yychar = yylex();
348                 assert(parser->yychar >= 0);
349                 if (parser->yychar == YYEOF) {
350                     YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
351                 }
352                 /* perly.tab is shipped based on an ASCII system, so need
353                  * to index it with characters translated to ASCII.
354                  * Although it's not designed for this purpose, we can use
355                  * NATIVE_TO_UNI here.  It returns its argument on ASCII
356                  * platforms, and on EBCDIC translates native to ascii in
357                  * the 0-255 range, leaving everything else unchanged.
358                  * This jibes with yylex() returning some bare characters
359                  * in that range, but all tokens it returns are either 0,
360                  * or above 255.  There could be a problem if NULs weren't
361                  * 0, or were ever returned as raw chars by yylex() */
362                 yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
363             }
364
365             /* make sure no-ones changed yychar since the last call to yylex */
366             assert(yytoken == YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)));
367             YYDSYMPRINTF("lookahead token is", yytoken, &parser->yylval);
368
369
370             /* If the proper action on seeing token YYTOKEN is to reduce or to
371              * detect an error, take that action.
372              * Casting yyn to unsigned allows a >=0 test to be included as
373              * part of the  <=YYLAST test for speed */
374             yyn += yytoken;
375             if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) {
376               yydefault:
377                 /* do the default action for the current state. */
378                 yyn = yydefact[yystate];
379                 if (yyn == 0)
380                     goto yyerrlab;
381                 break; /* time to reduce */
382             }
383
384             yyn = yytable[yyn];
385             if (yyn <= 0) {
386                 if (yyn == 0 || yyn == YYTABLE_NINF)
387                     goto yyerrlab;
388                 yyn = -yyn;
389                 break; /* time to reduce */
390             }
391
392             if (yyn == YYFINAL)
393                 YYACCEPT;
394
395             /* Shift the lookahead token.  */
396             YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
397
398             /* Discard the token being shifted unless it is eof.  */
399             if (parser->yychar != YYEOF)
400                 parser->yychar = YYEMPTY;
401
402             YYPUSHSTACK;
403             ps->state   = yyn;
404             ps->val     = parser->yylval;
405             ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
406             ps->savestack_ix = PL_savestack_ix;
407 #ifdef DEBUGGING
408             ps->name    = (const char *)(yytname[yytoken]);
409 #endif
410
411             /* Count tokens shifted since error; after three, turn off error
412                   status.  */
413             if (parser->yyerrstatus)
414                 parser->yyerrstatus--;
415
416         }
417
418         /* Do a reduction */
419
420         /* yyn is the number of a rule to reduce with.  */
421         parser->yylen = yyr2[yyn];
422         assert(parser->yylen <= YY_MAXRULE); /* see defn of YY_MAXRULE above */
423
424         /* If YYLEN is nonzero, implement the default value of the action:
425           "$$ = $1".
426
427           Otherwise, the following line sets YYVAL to garbage.
428           This behavior is undocumented and Bison
429           users should not rely upon it.  Assigning to YYVAL
430           unconditionally makes the parser a bit smaller, and it avoids a
431           GCC warning that YYVAL may be used uninitialized.  */
432         yyval = ps[1-parser->yylen].val;
433
434         YY_STACK_PRINT(parser);
435         YY_REDUCE_PRINT (yyn);
436
437         switch (yyn) {
438
439     /* contains all the rule actions; auto-generated from perly.y */
440 #include "perly.act"
441
442         }
443
444         {
445             int i;
446             for (i=0; i< parser->yylen; i++) {
447                 SvREFCNT_dec(ps[-i].compcv);
448             }
449         }
450
451         parser->ps = ps -= (parser->yylen-1);
452
453         /* Now shift the result of the reduction.  Determine what state
454               that goes to, based on the state we popped back to and the rule
455               number reduced by.  */
456
457         ps->val     = yyval;
458         ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
459         ps->savestack_ix = PL_savestack_ix;
460 #ifdef DEBUGGING
461         ps->name    = (const char *)(yytname [yyr1[yyn]]);
462 #endif
463
464         yyn = yyr1[yyn];
465
466         yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
467         if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
468             yystate = yytable[yystate];
469         else
470             yystate = yydefgoto[yyn - YYNTOKENS];
471         ps->state = yystate;
472
473         continue;
474
475
476       /*------------------------------------.
477       | yyerrlab -- here on detecting error |
478       `------------------------------------*/
479       yyerrlab:
480         /* If not already recovering from an error, report this error.  */
481         if (!parser->yyerrstatus) {
482             yyerror ("syntax error");
483         }
484
485
486         if (parser->yyerrstatus == 3) {
487             /* If just tried and failed to reuse lookahead token after an
488                   error, discard it.  */
489
490             /* Return failure if at end of input.  */
491             if (parser->yychar == YYEOF) {
492                 /* Pop the error token.  */
493                 SvREFCNT_dec(ps->compcv);
494                 YYPOPSTACK;
495                 /* Pop the rest of the stack.  */
496                 while (ps > parser->stack) {
497                     YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
498                     LEAVE_SCOPE(ps->savestack_ix);
499                     if (yy_type_tab[yystos[ps->state]] == toketype_opval
500                             && ps->val.opval)
501                     {
502                         YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
503                         if (ps->compcv != PL_compcv) {
504                             PL_compcv = ps->compcv;
505                             PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
506                         }
507                         op_free(ps->val.opval);
508                     }
509                     SvREFCNT_dec(ps->compcv);
510                     YYPOPSTACK;
511                 }
512                 YYABORT;
513             }
514
515             YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
516             parser->yychar = YYEMPTY;
517
518         }
519
520         /* Else will try to reuse lookahead token after shifting the error
521               token.  */
522         goto yyerrlab1;
523
524
525       /*----------------------------------------------------.
526       | yyerrlab1 -- error raised explicitly by an action.  |
527       `----------------------------------------------------*/
528       yyerrlab1:
529         parser->yyerrstatus = 3;        /* Each real token shifted decrements this.  */
530
531         for (;;) {
532             yyn = yypact[yystate];
533             if (yyn != YYPACT_NINF) {
534                 yyn += YYTERROR;
535                 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
536                     yyn = yytable[yyn];
537                     if (0 < yyn)
538                         break;
539                 }
540             }
541
542             /* Pop the current state because it cannot handle the error token.  */
543             if (ps == parser->stack)
544                 YYABORT;
545
546             YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
547             LEAVE_SCOPE(ps->savestack_ix);
548             if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
549                 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
550                 if (ps->compcv != PL_compcv) {
551                     PL_compcv = ps->compcv;
552                     PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
553                 }
554                 op_free(ps->val.opval);
555             }
556             SvREFCNT_dec(ps->compcv);
557             YYPOPSTACK;
558             yystate = ps->state;
559
560             YY_STACK_PRINT(parser);
561         }
562
563         if (yyn == YYFINAL)
564             YYACCEPT;
565
566         YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
567
568         YYPUSHSTACK;
569         ps->state   = yyn;
570         ps->val     = parser->yylval;
571         ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
572         ps->savestack_ix = PL_savestack_ix;
573 #ifdef DEBUGGING
574         ps->name    ="<err>";
575 #endif
576
577     } /* main loop */
578
579
580   /*-------------------------------------.
581   | yyacceptlab -- YYACCEPT comes here.  |
582   `-------------------------------------*/
583   yyacceptlab:
584     yyresult = 0;
585     for (ps=parser->ps; ps > parser->stack; ps--) {
586         SvREFCNT_dec(ps->compcv);
587     }
588     parser->ps = parser->stack; /* disable cleanup */
589     goto yyreturn;
590
591   /*-----------------------------------.
592   | yyabortlab -- YYABORT comes here.  |
593   `-----------------------------------*/
594   yyabortlab:
595     yyresult = 1;
596     goto yyreturn;
597
598   yyreturn:
599     LEAVE;      /* force parser stack cleanup before we return */
600     return yyresult;
601 }
602
603 /*
604  * ex: set ts=8 sts=4 sw=4 et:
605  */