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 */ 628