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