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