In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1eb7a0dec318d22fee300bd4348df9d7c80e2a2a?hp=a14be3eb83c92f38596c3a429d631615e84e660b>
- Log ----------------------------------------------------------------- commit 1eb7a0dec318d22fee300bd4348df9d7c80e2a2a Author: David Mitchell <[email protected]> Date: Mon Dec 5 09:37:36 2016 +0000 optimise Perl_sv_gets(): use memchr() for loop The inner loop which searches for the next separator character and copies buffer bytes: replace with memchr() and Copy(). These functions are likely to be optimised to use whatever hardware facilities are available. (But first check that the first char in the buffer isn't the separator: blank lines are quite common, and we can skip the overhead of calling memchr() in that case). M sv.c commit 0f8490d1d7ad76cac844fc2ae882994e38aaf2ef Author: David Mitchell <[email protected]> Date: Sun Dec 4 08:10:27 2016 +0000 yyparse: only calculate yytoken on yychar change yytoken is a translated (via lookup table) version of parser->yychar. So we only need to recalculate it when yychar changes (usually by assigning the result of yylex() to it). This means when multiple reductions are done without shifting another token, we skip the extra overhead each time. M perly.act M perly.c M perly.h M perly.tab M perly.y commit b2c9b6ee5d402c923568f214f2e2606287c912d3 Author: David Mitchell <[email protected]> Date: Sat Dec 3 20:58:37 2016 +0000 yyparse(): only check stack size in outer loop Rather than checking before each individual shift whether the parse stack needs extending, only check once per rule, making sure there's enough space to shift all the items for the longest possible rule M parser.h M perly.c M sv.c M toke.c commit ddbfb8f680c952529cc9849a6e461bbfeb703526 Author: David Mitchell <[email protected]> Date: Sat Dec 3 16:27:24 2016 +0000 yyparse: reindent whitespace-only. The previous commit wrapped the main body of code in a while (1) { ...} M perly.c commit fbe80aaa158f216c296a66de69523d1fc7de4d2c Author: David Mitchell <[email protected]> Date: Sat Dec 3 16:23:55 2016 +0000 yyparse: replace yynewstate label with while(1) {} makes the code easier to understand M perly.c commit 5019c3ae02ccf325d3fd2246619613ab90090c35 Author: David Mitchell <[email protected]> Date: Sat Dec 3 16:00:58 2016 +0000 yyparse: eliminate yyreduce label Makes things slightly simpler. M perly.c commit 3c217e575b5dd35db3bc7ab880483c03fb323ba1 Author: David Mitchell <[email protected]> Date: Sat Dec 3 15:12:49 2016 +0000 yyparse: reindent whitespace-only; previous commit wrapped a block of code in while (1){} M perly.c commit 3d849f133038a22ab4a4a9957092bb4ee0eab37b Author: David Mitchell <[email protected]> Date: Sat Dec 3 15:11:11 2016 +0000 yyparse: replace some gotos with a while(1) loop Just as efficient, and more readable. Welcome to 1970's structured programming! M perly.c commit 73f2343123f6b98ed4a0b1fc57fd65e720f38b1b Author: David Mitchell <[email protected]> Date: Sat Dec 3 14:08:56 2016 +0000 optimising yyparse: avoid a < 0 check casting to unsigned allows (0 <= yyn <= YYLAST) to be done in a single conditional. M perly.c commit 0e0707c5741b52ed1f26e1f69d89b66a1b05f985 Author: David Mitchell <[email protected]> Date: Sat Dec 3 14:01:19 2016 +0000 optimising yyparse: replace stack_size with a ptr Makes testing whether the parser stack needs extending cheaper M parser.h M perly.c M sv.c M toke.c ----------------------------------------------------------------------- Summary of changes: parser.h | 4 +- perly.act | 8 +- perly.c | 519 ++++++++++++++++++++++++++++++++------------------------------ perly.h | 10 +- perly.tab | 2 +- perly.y | 6 +- sv.c | 30 +++- toke.c | 2 +- 8 files changed, 303 insertions(+), 278 deletions(-) diff --git a/parser.h b/parser.h index 9c2209459e..3c7bb4e97d 100644 --- a/parser.h +++ b/parser.h @@ -42,9 +42,11 @@ typedef struct yy_parser { /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; - int stack_size; int yylen; /* length of active reduction */ yy_stack_frame *stack; /* base of stack */ + yy_stack_frame *stack_maxbase;/* (stack + alloced size - YY_MAXRULE) + * it's offset by -YY_MAXRULE to make + * overflow checks quicker */ yy_stack_frame *ps; /* current stack frame */ /* lexer state */ diff --git a/perly.act b/perly.act index 20f89b72bf..73c44e5449 100644 --- a/perly.act +++ b/perly.act @@ -54,7 +54,7 @@ case 2: PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } break; @@ -74,7 +74,7 @@ case 2: PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } break; @@ -94,7 +94,7 @@ case 2: PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } break; @@ -1977,6 +1977,6 @@ case 2: /* Generated from: - * 5646c76b3536061de3b69eb5df829f5643d09247aa0d249bf2d2e050594b3679 perly.y + * a8b5527eacb1205d15c8c01acb4a8f99b494e5b453ddd68a2a2e7fca4be3302a perly.y * 153cba5d215c1a083a0459c43f4d55c45fd0a7093c197d7247a456dcde21ea53 regen_perly.pl * ex: set ro: */ diff --git a/perly.c b/perly.c index 2d5857d0c0..5d1519f262 100644 --- a/perly.c +++ b/perly.c @@ -58,6 +58,15 @@ typedef signed char yysigned_char; # define YYSIZE_T size_t +/* the max number of RHS shifted elements that can make up a rule. + * This should really be auto-generated from the max value in yyr2[] + * but that involves extra work, so set it slightly higher than the + * current max, and assert each time yyr2[] is accessed. + * Used to determine if the parse stack needs extending. + */ + +#define YY_MAXRULE 15 + #define YYEOF 0 #define YYTERROR 1 @@ -273,296 +282,298 @@ Perl_yyparse (pTHX_ int gramtype) SAVEPPTR(parser->yylval.pval); SAVEINT(parser->yychar); SAVEINT(parser->yyerrstatus); - SAVEINT(parser->stack_size); SAVEINT(parser->yylen); SAVEVPTR(parser->stack); + SAVEVPTR(parser->stack_maxbase); SAVEVPTR(parser->ps); /* initialise state for this parse */ parser->yychar = gramtype; + yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)); + parser->yyerrstatus = 0; - parser->stack_size = YYINITDEPTH; parser->yylen = 0; Newx(parser->stack, YYINITDEPTH, yy_stack_frame); + parser->stack_maxbase = parser->stack + YYINITDEPTH - YY_MAXRULE; ps = parser->ps = parser->stack; ps->state = 0; SAVEDESTRUCTOR_X(S_clear_yystack, parser); -/*------------------------------------------------------------. -| yynewstate -- Push a new state, which is found in yystate. | -`------------------------------------------------------------*/ - yynewstate: - - yystate = ps->state; - - YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate)); - - parser->yylen = 0; - - { - size_t size = ps - parser->stack + 1; - - /* grow the stack? We always leave 1 spare slot, - * in case of a '' -> 'foo' reduction */ - - if (size >= (size_t)parser->stack_size - 1) { - /* this will croak on insufficient memory */ - parser->stack_size *= 2; - Renew(parser->stack, parser->stack_size, yy_stack_frame); - ps = parser->ps = parser->stack + size -1; - - YYDPRINTF((Perl_debug_log, - "parser stack size increased to %lu frames\n", - (unsigned long int)parser->stack_size)); - } - } - -/* 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(); - } - - 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); - } - - /* If the proper action on seeing token YYTOKEN is to reduce or to - detect an error, take that action. */ - yyn += yytoken; - if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) - goto yydefault; - yyn = yytable[yyn]; - if (yyn <= 0) { - if (yyn == 0 || yyn == YYTABLE_NINF) - goto yyerrlab; - yyn = -yyn; - goto yyreduce; - } - - if (yyn == YYFINAL) - YYACCEPT; - - /* 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; - - YYPUSHSTACK; - ps->state = yyn; - ps->val = parser->yylval; - ps->compcv = (CV*)SvREFCNT_inc(PL_compcv); - ps->savestack_ix = PL_savestack_ix; + while (1) { + /* main loop: shift some tokens, then reduce when possible */ + + /* grow the stack to accommodate longest possible rule */ + if (ps >= parser->stack_maxbase) { + Size_t pos = ps - parser->stack; + Size_t newsize = 2 * (parser->stack_maxbase + YY_MAXRULE + - parser->stack); + /* this will croak on insufficient memory */ + Renew(parser->stack, newsize, yy_stack_frame); + ps = parser->ps = parser->stack + pos; + parser->stack_maxbase = parser->stack + newsize - YY_MAXRULE; + + YYDPRINTF((Perl_debug_log, + "parser stack size increased to %lu frames\n", + (unsigned long int)newsize)); + } + + while (1) { + /* shift a token, or quit when it's possible to reduce */ + + assert(ps < parser->stack_maxbase + YY_MAXRULE); + yystate = ps->state; + + YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate)); + + parser->yylen = 0; + + /* 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 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)); + } + + /* make sure no-ones 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 */ + } + + yyn = yytable[yyn]; + if (yyn <= 0) { + if (yyn == 0 || yyn == YYTABLE_NINF) + goto yyerrlab; + yyn = -yyn; + break; /* time to reduce */ + } + + if (yyn == YYFINAL) + YYACCEPT; + + /* 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; + + 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--; - goto yynewstate; + } + /* Do a reduction */ - /*-----------------------------------------------------------. - | yydefault -- do the default action for the current state. | - `-----------------------------------------------------------*/ - yydefault: - yyn = yydefact[yystate]; - if (yyn == 0) - goto yyerrlab; - goto yyreduce; + /* yyn is the number of a rule to reduce with. */ + parser->yylen = yyr2[yyn]; + assert(parser->yylen <= YY_MAXRULE); /* see defn of YY_MAXRULE above */ + /* If YYLEN is nonzero, implement the default value of the action: + "$$ = $1". - /*-----------------------------. - | yyreduce -- Do a reduction. | - `-----------------------------*/ - yyreduce: - /* yyn is the number of a rule to reduce with. */ - parser->yylen = yyr2[yyn]; + 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; - /* If YYLEN is nonzero, implement the default value of the action: - "$$ = $1". + YY_STACK_PRINT(parser); + YY_REDUCE_PRINT (yyn); - 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; + switch (yyn) { - YY_STACK_PRINT(parser); - YY_REDUCE_PRINT (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]; - - 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; - - - /*------------------------------------. - | 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; - - } - - /* 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; - - 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); - } - - if (yyn == YYFINAL) - YYACCEPT; - - 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; + 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; + + continue; + + + /*------------------------------------. + | 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; + + } + + /* 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; + + 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); + } + + if (yyn == YYFINAL) + YYACCEPT; + + 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; #ifdef DEBUGGING - ps->name ="<err>"; + ps->name ="<err>"; #endif - goto yynewstate; + } /* main loop */ /*-------------------------------------. diff --git a/perly.h b/perly.h index 1f5d6d738e..a7e9a4348b 100644 --- a/perly.h +++ b/perly.h @@ -7,11 +7,11 @@ #define PERL_BISON_VERSION 30000 #ifdef PERL_CORE -/* A Bison parser, made by GNU Bison 3.0.4. */ +/* A Bison parser, made by GNU Bison 3.0.2. */ /* Bison interface for Yacc-like parsers in C - Copyright (C) 1984, 1989-1990, 2000-2015 Free Software Foundation, Inc. + Copyright (C) 1984, 1989-1990, 2000-2013 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -160,7 +160,7 @@ S_is_opval_token(int type) { #endif /* PERL_IN_TOKE_C */ #endif /* PERL_CORE */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED - +typedef union YYSTYPE YYSTYPE; union YYSTYPE { @@ -171,8 +171,6 @@ union YYSTYPE GV *gvval; }; - -typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 #endif @@ -183,6 +181,6 @@ int yyparse (void); /* Generated from: - * 5646c76b3536061de3b69eb5df829f5643d09247aa0d249bf2d2e050594b3679 perly.y + * a8b5527eacb1205d15c8c01acb4a8f99b494e5b453ddd68a2a2e7fca4be3302a perly.y * 153cba5d215c1a083a0459c43f4d55c45fd0a7093c197d7247a456dcde21ea53 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 0d0b607421..e4065de3ea 100644 --- a/perly.tab +++ b/perly.tab @@ -1109,6 +1109,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 5646c76b3536061de3b69eb5df829f5643d09247aa0d249bf2d2e050594b3679 perly.y + * a8b5527eacb1205d15c8c01acb4a8f99b494e5b453ddd68a2a2e7fca4be3302a perly.y * 153cba5d215c1a083a0459c43f4d55c45fd0a7093c197d7247a456dcde21ea53 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 3440dcbaad..7d57deacc2 100644 --- a/perly.y +++ b/perly.y @@ -143,7 +143,7 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMBARESTMT { @@ -155,7 +155,7 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMFULLSTMT { @@ -167,7 +167,7 @@ grammar : GRAMPROG PL_eval_root = $3; $$ = 0; yyunlex(); - parser->yychar = YYEOF; + parser->yychar = yytoken = YYEOF; } | GRAMSTMTSEQ { diff --git a/sv.c b/sv.c index 6a17049a9a..dc392f098e 100644 --- a/sv.c +++ b/sv.c @@ -8653,13 +8653,27 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) if (cnt > 0) { /* if there is a separator */ if (rslen) { - /* loop until we hit the end of the read-ahead buffer */ - while (cnt > 0) { /* this | eat */ - /* scan forward copying and searching for rslast as we go */ - cnt--; - if ((*bp++ = *ptr++) == rslast) /* really | dust */ - goto thats_all_folks; /* screams | sed :-) */ - } + /* find next rslast */ + STDCHAR *p; + + /* shortcut common case of blank line */ + cnt--; + if ((*bp++ = *ptr++) == rslast) + goto thats_all_folks; + + p = (STDCHAR *)memchr(ptr, rslast, cnt); + if (p) { + SSize_t got = p - ptr + 1; + Copy(ptr, bp, got, STDCHAR); + ptr += got; + bp += got; + cnt -= got; + goto thats_all_folks; + } + Copy(ptr, bp, cnt, STDCHAR); + ptr += cnt; + bp += cnt; + cnt = 0; } else { /* no separator, slurp the full buffer */ @@ -13130,7 +13144,7 @@ Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param) parser->old_parser = NULL; parser->stack = NULL; parser->ps = NULL; - parser->stack_size = 0; + parser->stack_maxbase = NULL; /* XXX parser->stack->state = 0; */ /* XXX eventually, just Copy() most of the parser struct ? */ diff --git a/toke.c b/toke.c index 1c88d8a2ee..936eab5110 100644 --- a/toke.c +++ b/toke.c @@ -705,8 +705,8 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) PL_parser = parser; parser->stack = NULL; + parser->stack_maxbase = NULL; parser->ps = NULL; - parser->stack_size = 0; /* on scope exit, free this parser and restore any outer one */ SAVEPARSER(parser); -- Perl5 Master Repository
