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