Collapse duplicate settings in hints/solaris_2.sh
[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  * Note that this file is also #included in madly.c, to allow compilation
23  * of a second parser, Perl_madparse, that is identical to Perl_yyparse,
24  * but which includes extra code for dumping the parse tree.
25  * This is controlled by the PERL_IN_MADLY_C define.
26  */
27
28 #include "EXTERN.h"
29 #define PERL_IN_PERLY_C
30 #include "perl.h"
31
32 typedef unsigned char yytype_uint8;
33 typedef signed char yytype_int8;
34 typedef unsigned short int yytype_uint16;
35 typedef short int yytype_int16;
36 typedef signed char yysigned_char;
37
38 /* YYINITDEPTH -- initial size of the parser's stacks.  */
39 #define YYINITDEPTH 200
40
41 #ifdef DEBUGGING
42 #  define YYDEBUG 1
43 #else
44 #  define YYDEBUG 0
45 #endif
46
47 /* contains all the parser state tables; auto-generated from perly.y */
48 #include "perly.tab"
49
50 # define YYSIZE_T size_t
51
52 #define YYEOF           0
53 #define YYTERROR        1
54
55 #define YYACCEPT        goto yyacceptlab
56 #define YYABORT         goto yyabortlab
57 #define YYERROR         goto yyerrlab1
58
59 /* Enable debugging if requested.  */
60 #ifdef DEBUGGING
61
62 #  define yydebug (DEBUG_p_TEST)
63
64 #  define YYFPRINTF PerlIO_printf
65
66 #  define YYDPRINTF(Args)                       \
67 do {                                            \
68     if (yydebug)                                \
69         YYFPRINTF Args;                         \
70 } while (0)
71
72 #  define YYDSYMPRINTF(Title, Token, Value)                     \
73 do {                                                            \
74     if (yydebug) {                                              \
75         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
76         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
77         YYFPRINTF (Perl_debug_log, "\n");                       \
78     }                                                           \
79 } while (0)
80
81 /*--------------------------------.
82 | Print this symbol on YYOUTPUT.  |
83 `--------------------------------*/
84
85 static void
86 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
87 {
88     if (yytype < YYNTOKENS) {
89         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
90 #   ifdef YYPRINT
91         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
92 #   else
93         YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
94 #   endif
95     }
96     else
97         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
98
99     YYFPRINTF (yyoutput, ")");
100 }
101
102
103 /*  yy_stack_print()
104  *  print the top 8 items on the parse stack.
105  */
106
107 static void
108 yy_stack_print (pTHX_ const yy_parser *parser)
109 {
110     const yy_stack_frame *ps, *min;
111
112     min = parser->ps - 8 + 1;
113     if (min <= parser->stack)
114         min = parser->stack + 1;
115
116     PerlIO_printf(Perl_debug_log, "\nindex:");
117     for (ps = min; ps <= parser->ps; ps++)
118         PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
119
120     PerlIO_printf(Perl_debug_log, "\nstate:");
121     for (ps = min; ps <= parser->ps; ps++)
122         PerlIO_printf(Perl_debug_log, " %8d", ps->state);
123
124     PerlIO_printf(Perl_debug_log, "\ntoken:");
125     for (ps = min; ps <= parser->ps; ps++)
126         PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
127
128     PerlIO_printf(Perl_debug_log, "\nvalue:");
129     for (ps = min; ps <= parser->ps; ps++) {
130         switch (yy_type_tab[yystos[ps->state]]) {
131         case toketype_opval:
132             PerlIO_printf(Perl_debug_log, " %8.8s",
133                   ps->val.opval
134                     ? PL_op_name[ps->val.opval->op_type]
135                     : "(Nullop)"
136             );
137             break;
138 #ifndef PERL_IN_MADLY_C
139         case toketype_i_tkval:
140 #endif
141         case toketype_ival:
142             PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
143             break;
144         default:
145             PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
146         }
147     }
148     PerlIO_printf(Perl_debug_log, "\n\n");
149 }
150
151 #  define YY_STACK_PRINT(parser)        \
152 do {                                    \
153     if (yydebug && DEBUG_v_TEST)        \
154         yy_stack_print (aTHX_ parser);  \
155 } while (0)
156
157
158 /*------------------------------------------------.
159 | Report that the YYRULE is going to be reduced.  |
160 `------------------------------------------------*/
161
162 static void
163 yy_reduce_print (pTHX_ int yyrule)
164 {
165     int yyi;
166     const unsigned int yylineno = yyrline[yyrule];
167     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
168                           yyrule - 1, yylineno);
169     /* Print the symbols being reduced, and their result.  */
170     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
171         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
172     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
173 }
174
175 #  define YY_REDUCE_PRINT(Rule)         \
176 do {                                    \
177     if (yydebug)                        \
178         yy_reduce_print (aTHX_ Rule);           \
179 } while (0)
180
181 #else /* !DEBUGGING */
182 #  define YYDPRINTF(Args)
183 #  define YYDSYMPRINTF(Title, Token, Value)
184 #  define YY_STACK_PRINT(parser)
185 #  define YY_REDUCE_PRINT(Rule)
186 #endif /* !DEBUGGING */
187
188 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
189  * parse stack, thus avoiding leaks if we die  */
190
191 static void
192 S_clear_yystack(pTHX_  const yy_parser *parser)
193 {
194     yy_stack_frame *ps     = parser->ps;
195     int i = 0;
196
197     if (!parser->stack)
198         return;
199
200     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
201
202     for (i=0; i< parser->yylen; i++) {
203         SvREFCNT_dec(ps[-i].compcv);
204     }
205     ps -= parser->yylen;
206
207     /* now free whole the stack, including the just-reduced ops */
208
209     while (ps > parser->stack) {
210         LEAVE_SCOPE(ps->savestack_ix);
211         if (yy_type_tab[yystos[ps->state]] == toketype_opval
212             && ps->val.opval)
213         {
214             if (ps->compcv != PL_compcv) {
215                 PL_compcv = ps->compcv;
216                 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
217             }
218             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
219             op_free(ps->val.opval);
220         }
221         SvREFCNT_dec(ps->compcv);
222         ps--;
223     }
224
225     Safefree(parser->stack);
226 }
227
228
229 /*----------.
230 | yyparse.  |
231 `----------*/
232
233 int
234 #ifdef PERL_IN_MADLY_C
235 Perl_madparse (pTHX_ int gramtype)
236 #else
237 Perl_yyparse (pTHX_ int gramtype)
238 #endif
239 {
240     dVAR;
241     int yystate;
242     int yyn;
243     int yyresult;
244
245     /* Lookahead token as an internal (translated) token number.  */
246     int yytoken = 0;
247
248     yy_parser *parser;      /* the parser object */
249     yy_stack_frame  *ps;   /* current parser stack frame */
250
251 #define YYPOPSTACK   parser->ps = --ps
252 #define YYPUSHSTACK  parser->ps = ++ps
253
254     /* The variable used to return semantic value and location from the
255           action routines: ie $$.  */
256     YYSTYPE yyval;
257
258 #ifndef PERL_IN_MADLY_C
259 #  ifdef PERL_MAD
260     if (PL_madskills)
261         return madparse(gramtype);
262 #  endif
263 #endif
264
265     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
266
267     parser = PL_parser;
268
269     ENTER;  /* force parser state cleanup/restoration before we return */
270     SAVEPPTR(parser->yylval.pval);
271     SAVEINT(parser->yychar);
272     SAVEINT(parser->yyerrstatus);
273     SAVEINT(parser->stack_size);
274     SAVEINT(parser->yylen);
275     SAVEVPTR(parser->stack);
276     SAVEVPTR(parser->ps);
277
278     /* initialise state for this parse */
279     parser->yychar = gramtype;
280     parser->yyerrstatus = 0;
281     parser->stack_size = YYINITDEPTH;
282     parser->yylen = 0;
283     Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
284     ps = parser->ps = parser->stack;
285     ps->state = 0;
286     SAVEDESTRUCTOR_X(S_clear_yystack, parser);
287
288 /*------------------------------------------------------------.
289 | yynewstate -- Push a new state, which is found in yystate.  |
290 `------------------------------------------------------------*/
291   yynewstate:
292
293     yystate = ps->state;
294
295     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
296
297     parser->yylen = 0;
298
299     {
300         size_t size = ps - parser->stack + 1;
301
302         /* grow the stack? We always leave 1 spare slot,
303          * in case of a '' -> 'foo' reduction */
304
305         if (size >= (size_t)parser->stack_size - 1) {
306             /* this will croak on insufficient memory */
307             parser->stack_size *= 2;
308             Renew(parser->stack, parser->stack_size, yy_stack_frame);
309             ps = parser->ps = parser->stack + size -1;
310
311             YYDPRINTF((Perl_debug_log,
312                             "parser stack size increased to %lu frames\n",
313                             (unsigned long int)parser->stack_size));
314         }
315     }
316
317 /* Do appropriate processing given the current state.  */
318 /* Read a lookahead token if we need one and don't already have one.  */
319
320     /* First try to decide what to do without reference to lookahead token.  */
321
322     yyn = yypact[yystate];
323     if (yyn == YYPACT_NINF)
324         goto yydefault;
325
326     /* Not known => get a lookahead token if don't already have one.  */
327
328     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
329     if (parser->yychar == YYEMPTY) {
330         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
331 #ifdef PERL_IN_MADLY_C
332         parser->yychar = PL_madskills ? madlex() : yylex();
333 #else
334         parser->yychar = yylex();
335 #endif
336
337 #  ifdef EBCDIC
338         if (parser->yychar >= 0 && parser->yychar < 255) {
339             parser->yychar = NATIVE_TO_ASCII(parser->yychar);
340         }
341 #  endif
342     }
343
344     if (parser->yychar <= YYEOF) {
345         parser->yychar = yytoken = YYEOF;
346         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
347     }
348     else {
349         yytoken = YYTRANSLATE (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
426 #define dep() deprecate("\"do\" to call subroutines")
427
428 #ifdef PERL_IN_MADLY_C
429 #  define IVAL(i) (i)->tk_lval.ival
430 #  define PVAL(p) (p)->tk_lval.pval
431 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
432 #  define TOKEN_FREE(a) token_free(a)
433 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
434 #  define IF_MAD(a,b) (a)
435 #  define DO_MAD(a) a
436 #  define MAD
437 #else
438 #  define IVAL(i) (i)
439 #  define PVAL(p) (p)
440 #  define TOKEN_GETMAD(a,b,c)
441 #  define TOKEN_FREE(a)
442 #  define OP_GETMAD(a,b,c)
443 #  define IF_MAD(a,b) (b)
444 #  define DO_MAD(a)
445 #  undef MAD
446 #endif
447
448 /* contains all the rule actions; auto-generated from perly.y */
449 #include "perly.act"
450
451     }
452
453     {
454         int i;
455         for (i=0; i< parser->yylen; i++) {
456             SvREFCNT_dec(ps[-i].compcv);
457         }
458     }
459
460     parser->ps = ps -= (parser->yylen-1);
461
462     /* Now shift the result of the reduction.  Determine what state
463           that goes to, based on the state we popped back to and the rule
464           number reduced by.  */
465
466     ps->val     = yyval;
467     ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
468     ps->savestack_ix = PL_savestack_ix;
469 #ifdef DEBUGGING
470     ps->name    = (const char *)(yytname [yyr1[yyn]]);
471 #endif
472
473     yyn = yyr1[yyn];
474
475     yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
476     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
477         yystate = yytable[yystate];
478     else
479         yystate = yydefgoto[yyn - YYNTOKENS];
480     ps->state = yystate;
481
482     goto yynewstate;
483
484
485   /*------------------------------------.
486   | yyerrlab -- here on detecting error |
487   `------------------------------------*/
488   yyerrlab:
489     /* If not already recovering from an error, report this error.  */
490     if (!parser->yyerrstatus) {
491         yyerror ("syntax error");
492     }
493
494
495     if (parser->yyerrstatus == 3) {
496         /* If just tried and failed to reuse lookahead token after an
497               error, discard it.  */
498
499         /* Return failure if at end of input.  */
500         if (parser->yychar == YYEOF) {
501             /* Pop the error token.  */
502             SvREFCNT_dec(ps->compcv);
503             YYPOPSTACK;
504             /* Pop the rest of the stack.  */
505             while (ps > parser->stack) {
506                 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
507                 LEAVE_SCOPE(ps->savestack_ix);
508                 if (yy_type_tab[yystos[ps->state]] == toketype_opval
509                         && ps->val.opval)
510                 {
511                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
512                     if (ps->compcv != PL_compcv) {
513                         PL_compcv = ps->compcv;
514                         PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
515                     }
516                     op_free(ps->val.opval);
517                 }
518                 SvREFCNT_dec(ps->compcv);
519                 YYPOPSTACK;
520             }
521             YYABORT;
522         }
523
524         YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
525         if (yy_type_tab[yytoken] == toketype_opval)
526             op_free(parser->yylval.opval);
527         parser->yychar = YYEMPTY;
528
529     }
530
531     /* Else will try to reuse lookahead token after shifting the error
532           token.  */
533     goto yyerrlab1;
534
535
536   /*----------------------------------------------------.
537   | yyerrlab1 -- error raised explicitly by an action.  |
538   `----------------------------------------------------*/
539   yyerrlab1:
540     parser->yyerrstatus = 3;    /* Each real token shifted decrements this.  */
541
542     for (;;) {
543         yyn = yypact[yystate];
544         if (yyn != YYPACT_NINF) {
545             yyn += YYTERROR;
546             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
547                 yyn = yytable[yyn];
548                 if (0 < yyn)
549                     break;
550             }
551         }
552
553         /* Pop the current state because it cannot handle the error token.  */
554         if (ps == parser->stack)
555             YYABORT;
556
557         YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
558         LEAVE_SCOPE(ps->savestack_ix);
559         if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
560             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
561             if (ps->compcv != PL_compcv) {
562                 PL_compcv = ps->compcv;
563                 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
564             }
565             op_free(ps->val.opval);
566         }
567         SvREFCNT_dec(ps->compcv);
568         YYPOPSTACK;
569         yystate = ps->state;
570
571         YY_STACK_PRINT(parser);
572     }
573
574     if (yyn == YYFINAL)
575         YYACCEPT;
576
577     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
578
579     YYPUSHSTACK;
580     ps->state   = yyn;
581     ps->val     = parser->yylval;
582     ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
583     ps->savestack_ix = PL_savestack_ix;
584 #ifdef DEBUGGING
585     ps->name    ="<err>";
586 #endif
587
588     goto yynewstate;
589
590
591   /*-------------------------------------.
592   | yyacceptlab -- YYACCEPT comes here.  |
593   `-------------------------------------*/
594   yyacceptlab:
595     yyresult = 0;
596     for (ps=parser->ps; ps > parser->stack; ps--) {
597         SvREFCNT_dec(ps->compcv);
598     }
599     parser->ps = parser->stack; /* disable cleanup */
600     goto yyreturn;
601
602   /*-----------------------------------.
603   | yyabortlab -- YYABORT comes here.  |
604   `-----------------------------------*/
605   yyabortlab:
606     yyresult = 1;
607     goto yyreturn;
608
609   yyreturn:
610     LEAVE;      /* force parser stack cleanup before we return */
611     return yyresult;
612 }
613
614 /*
615  * Local variables:
616  * c-indentation-style: bsd
617  * c-basic-offset: 4
618  * indent-tabs-mode: nil
619  * End:
620  *
621  * ex: set ts=8 sts=4 sw=4 et:
622  */