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