X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3c217e575b5dd35db3bc7ab880483c03fb323ba1..aa034fa00bac53c08ef0dd886ebf864da25d155a:/perly.c diff --git a/perly.c b/perly.c index e4db365..41978fa 100644 --- a/perly.c +++ b/perly.c @@ -280,6 +280,8 @@ Perl_yyparse (pTHX_ int gramtype) /* initialise state for this parse */ parser->yychar = gramtype; + yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)); + parser->yyerrstatus = 0; parser->yylen = 0; Newx(parser->stack, YYINITDEPTH, yy_stack_frame); @@ -288,23 +290,22 @@ Perl_yyparse (pTHX_ int gramtype) ps->state = 0; SAVEDESTRUCTOR_X(S_clear_yystack, parser); -/*------------------------------------------------------------. -| yynewstate -- Push a new state, which is found in yystate. | -`------------------------------------------------------------*/ - yynewstate: - while (1) { - yystate = ps->state; + /* main loop: shift some tokens, then reduce when possible */ - YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate)); + while (1) { + /* shift a token, or quit when it's possible to reduce */ - parser->yylen = 0; + yystate = ps->state; - { - /* grow the stack? We always leave 1 spare slot, - * in case of a '' -> 'foo' reduction. + YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate)); + + parser->yylen = 0; + + /* Grow the stack? We always leave 1 spare slot, in case of a + * '' -> 'foo' reduction. * Note that stack_max1 points to the (top-1)th allocated stack - * element to make this check fast */ + * element to make this check faster */ if (ps >= parser->stack_max1) { Size_t pos = ps - parser->stack; @@ -318,254 +319,254 @@ Perl_yyparse (pTHX_ int gramtype) "parser stack size increased to %lu frames\n", (unsigned long int)newsize)); } - } - - /* Do appropriate processing given the current state. */ - /* Read a lookahead token if we need one and don't already have one. */ - - /* First try to decide what to do without reference to lookahead token. */ - - yyn = yypact[yystate]; - if (yyn == YYPACT_NINF) - break; - /* Not known => get a lookahead token if don't already have one. */ - - /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ - if (parser->yychar == YYEMPTY) { - YYDPRINTF ((Perl_debug_log, "Reading a token:\n")); - parser->yychar = yylex(); - } + /* Do appropriate processing given the current state. Read a + * lookahead token if we need one and don't already have one. + * */ + + /* First try to decide what to do without reference to + * lookahead token. */ + + yyn = yypact[yystate]; + if (yyn == YYPACT_NINF) + goto yydefault; + + /* Not known => get a lookahead token if don't already have + * one. YYCHAR is either YYEMPTY or YYEOF or a valid + * lookahead symbol. */ + + if (parser->yychar == YYEMPTY) { + YYDPRINTF ((Perl_debug_log, "Reading a token:\n")); + parser->yychar = yylex(); + assert(parser->yychar >= 0); + if (parser->yychar == YYEOF) { + YYDPRINTF ((Perl_debug_log, "Now at end of input.\n")); + } + /* perly.tab is shipped based on an ASCII system, so need + * to index it with characters translated to ASCII. + * Although it's not designed for this purpose, we can use + * NATIVE_TO_UNI here. It returns its argument on ASCII + * platforms, and on EBCDIC translates native to ascii in + * the 0-255 range, leaving every other possible input + * unchanged. This jibes with yylex() returning some bare + * characters in that range, but all tokens it returns are + * either 0, or above 255. There could be a problem if NULs + * weren't 0, or were ever returned as raw chars by yylex() */ + yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)); + } - if (parser->yychar <= YYEOF) { - parser->yychar = yytoken = YYEOF; - YYDPRINTF ((Perl_debug_log, "Now at end of input.\n")); - } - else { - /* perly.tab is shipped based on an ASCII system, so need to index it - * with characters translated to ASCII. Although it's not designed for - * this purpose, we can use NATIVE_TO_UNI here. It returns its - * argument on ASCII platforms, and on EBCDIC translates native to - * ascii in the 0-255 range, leaving everything else unchanged. This - * jibes with yylex() returning some bare characters in that range, but - * all tokens it returns are either 0, or above 255. There could be a - * problem if NULs weren't 0, or were ever returned as raw chars by - * yylex() */ - yytoken = YYTRANSLATE (NATIVE_TO_UNI(parser->yychar)); - YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval); - } + /* make sure no-one's changed yychar since the last call to yylex */ + assert(yytoken == YYTRANSLATE(NATIVE_TO_UNI(parser->yychar))); + YYDSYMPRINTF("lookahead token is", yytoken, &parser->yylval); + + + /* If the proper action on seeing token YYTOKEN is to reduce or to + * detect an error, take that action. + * Casting yyn to unsigned allows a >=0 test to be included as + * part of the <=YYLAST test for speed */ + yyn += yytoken; + if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) { + yydefault: + /* do the default action for the current state. */ + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + break; /* time to reduce */ + } - /* If the proper action on seeing token YYTOKEN is to reduce or to - * detect an error, take that action. - * Casting yyn to unsigned allows a >=0 test to be included as - * part of the <=YYLAST test for speed */ - yyn += yytoken; - if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) - break; - - yyn = yytable[yyn]; - if (yyn <= 0) { - if (yyn == 0 || yyn == YYTABLE_NINF) - goto yyerrlab; - yyn = -yyn; - goto yyreduce; - } + yyn = yytable[yyn]; + if (yyn <= 0) { + if (yyn == 0 || yyn == YYTABLE_NINF) + goto yyerrlab; + yyn = -yyn; + break; /* time to reduce */ + } - if (yyn == YYFINAL) - YYACCEPT; + if (yyn == YYFINAL) + YYACCEPT; - /* Shift the lookahead token. */ - YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken])); + /* Shift the lookahead token. */ + YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken])); - /* Discard the token being shifted unless it is eof. */ - if (parser->yychar != YYEOF) - parser->yychar = YYEMPTY; + /* Discard the token being shifted unless it is eof. */ + if (parser->yychar != YYEOF) + parser->yychar = YYEMPTY; - YYPUSHSTACK; - ps->state = yyn; - ps->val = parser->yylval; - ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); - ps->savestack_ix = PL_savestack_ix; + YYPUSHSTACK; + ps->state = yyn; + ps->val = parser->yylval; + ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING - ps->name = (const char *)(yytname[yytoken]); + ps->name = (const char *)(yytname[yytoken]); #endif - /* Count tokens shifted since error; after three, turn off error - status. */ - if (parser->yyerrstatus) - parser->yyerrstatus--; - - } + /* Count tokens shifted since error; after three, turn off error + status. */ + if (parser->yyerrstatus) + parser->yyerrstatus--; + } - /*-----------------------------------------------------------. - | do the default action for the current state. | - `-----------------------------------------------------------*/ - yyn = yydefact[yystate]; - if (yyn == 0) - goto yyerrlab; + /* Do a reduction */ - /*-----------------------------. - | yyreduce -- Do a reduction. | - `-----------------------------*/ - yyreduce: - /* yyn is the number of a rule to reduce with. */ - parser->yylen = yyr2[yyn]; + /* yyn is the number of a rule to reduce with. */ + parser->yylen = yyr2[yyn]; - /* If YYLEN is nonzero, implement the default value of the action: - "$$ = $1". + /* If YYLEN is nonzero, implement the default value of the action: + "$$ = $1". - Otherwise, the following line sets YYVAL to garbage. - This behavior is undocumented and Bison - users should not rely upon it. Assigning to YYVAL - unconditionally makes the parser a bit smaller, and it avoids a - GCC warning that YYVAL may be used uninitialized. */ - yyval = ps[1-parser->yylen].val; + Otherwise, the following line sets YYVAL to garbage. + This behavior is undocumented and Bison + users should not rely upon it. Assigning to YYVAL + unconditionally makes the parser a bit smaller, and it avoids a + GCC warning that YYVAL may be used uninitialized. */ + yyval = ps[1-parser->yylen].val; - YY_STACK_PRINT(parser); - YY_REDUCE_PRINT (yyn); + YY_STACK_PRINT(parser); + YY_REDUCE_PRINT (yyn); - switch (yyn) { + switch (yyn) { -/* contains all the rule actions; auto-generated from perly.y */ + /* contains all the rule actions; auto-generated from perly.y */ #include "perly.act" - } + } - { - int i; - for (i=0; i< parser->yylen; i++) { - SvREFCNT_dec(ps[-i].compcv); - } - } + { + int i; + for (i=0; i< parser->yylen; i++) { + SvREFCNT_dec(ps[-i].compcv); + } + } - parser->ps = ps -= (parser->yylen-1); + parser->ps = ps -= (parser->yylen-1); - /* Now shift the result of the reduction. Determine what state - that goes to, based on the state we popped back to and the rule - number reduced by. */ + /* Now shift the result of the reduction. Determine what state + that goes to, based on the state we popped back to and the rule + number reduced by. */ - ps->val = yyval; - ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); - ps->savestack_ix = PL_savestack_ix; + ps->val = yyval; + ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING - ps->name = (const char *)(yytname [yyr1[yyn]]); + ps->name = (const char *)(yytname [yyr1[yyn]]); #endif - yyn = yyr1[yyn]; + yyn = yyr1[yyn]; - yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state; - if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state) - yystate = yytable[yystate]; - else - yystate = yydefgoto[yyn - YYNTOKENS]; - ps->state = yystate; + yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state; + if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state) + yystate = yytable[yystate]; + else + yystate = yydefgoto[yyn - YYNTOKENS]; + ps->state = yystate; - goto yynewstate; + continue; - /*------------------------------------. - | yyerrlab -- here on detecting error | - `------------------------------------*/ - yyerrlab: - /* If not already recovering from an error, report this error. */ - if (!parser->yyerrstatus) { - yyerror ("syntax error"); - } - + /*------------------------------------. + | yyerrlab -- here on detecting error | + `------------------------------------*/ + yyerrlab: + /* If not already recovering from an error, report this error. */ + if (!parser->yyerrstatus) { + yyerror ("syntax error"); + } - if (parser->yyerrstatus == 3) { - /* If just tried and failed to reuse lookahead token after an - error, discard it. */ - - /* Return failure if at end of input. */ - if (parser->yychar == YYEOF) { - /* Pop the error token. */ - SvREFCNT_dec(ps->compcv); - YYPOPSTACK; - /* Pop the rest of the stack. */ - while (ps > parser->stack) { - YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val); - LEAVE_SCOPE(ps->savestack_ix); - if (yy_type_tab[yystos[ps->state]] == toketype_opval - && ps->val.opval) - { - YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); - if (ps->compcv != PL_compcv) { - PL_compcv = ps->compcv; - PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); - } - op_free(ps->val.opval); - } - SvREFCNT_dec(ps->compcv); - YYPOPSTACK; - } - YYABORT; - } - YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval); - parser->yychar = YYEMPTY; + if (parser->yyerrstatus == 3) { + /* If just tried and failed to reuse lookahead token after an + error, discard it. */ + + /* Return failure if at end of input. */ + if (parser->yychar == YYEOF) { + /* Pop the error token. */ + SvREFCNT_dec(ps->compcv); + YYPOPSTACK; + /* Pop the rest of the stack. */ + while (ps > parser->stack) { + YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val); + LEAVE_SCOPE(ps->savestack_ix); + if (yy_type_tab[yystos[ps->state]] == toketype_opval + && ps->val.opval) + { + YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); + if (ps->compcv != PL_compcv) { + PL_compcv = ps->compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); + } + op_free(ps->val.opval); + } + SvREFCNT_dec(ps->compcv); + YYPOPSTACK; + } + YYABORT; + } - } + YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval); + parser->yychar = YYEMPTY; - /* Else will try to reuse lookahead token after shifting the error - token. */ - goto yyerrlab1; - - - /*----------------------------------------------------. - | yyerrlab1 -- error raised explicitly by an action. | - `----------------------------------------------------*/ - yyerrlab1: - parser->yyerrstatus = 3; /* Each real token shifted decrements this. */ - - for (;;) { - yyn = yypact[yystate]; - if (yyn != YYPACT_NINF) { - yyn += YYTERROR; - if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { - yyn = yytable[yyn]; - if (0 < yyn) - break; - } - } + } - /* Pop the current state because it cannot handle the error token. */ - if (ps == parser->stack) - YYABORT; + /* Else will try to reuse lookahead token after shifting the error + token. */ + goto yyerrlab1; + + + /*----------------------------------------------------. + | yyerrlab1 -- error raised explicitly by an action. | + `----------------------------------------------------*/ + yyerrlab1: + parser->yyerrstatus = 3; /* Each real token shifted decrements this. */ + + for (;;) { + yyn = yypact[yystate]; + if (yyn != YYPACT_NINF) { + yyn += YYTERROR; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } - YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val); - LEAVE_SCOPE(ps->savestack_ix); - if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) { - YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); - if (ps->compcv != PL_compcv) { - PL_compcv = ps->compcv; - PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); - } - op_free(ps->val.opval); - } - SvREFCNT_dec(ps->compcv); - YYPOPSTACK; - yystate = ps->state; + /* Pop the current state because it cannot handle the error token. */ + if (ps == parser->stack) + YYABORT; + + YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val); + LEAVE_SCOPE(ps->savestack_ix); + if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) { + YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); + if (ps->compcv != PL_compcv) { + PL_compcv = ps->compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); + } + op_free(ps->val.opval); + } + SvREFCNT_dec(ps->compcv); + YYPOPSTACK; + yystate = ps->state; - YY_STACK_PRINT(parser); - } + YY_STACK_PRINT(parser); + } - if (yyn == YYFINAL) - YYACCEPT; + if (yyn == YYFINAL) + YYACCEPT; - YYDPRINTF ((Perl_debug_log, "Shifting error token, ")); + YYDPRINTF ((Perl_debug_log, "Shifting error token, ")); - YYPUSHSTACK; - ps->state = yyn; - ps->val = parser->yylval; - ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); - ps->savestack_ix = PL_savestack_ix; + YYPUSHSTACK; + ps->state = yyn; + ps->val = parser->yylval; + ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); + ps->savestack_ix = PL_savestack_ix; #ifdef DEBUGGING - ps->name =""; + ps->name =""; #endif - goto yynewstate; + } /* main loop */ /*-------------------------------------.