In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/10c25cd94120c0e509e5ce54480c24d08281e090?hp=e093953796c2b52df4a70fb9d48a4cad66bc6cc1>
- Log ----------------------------------------------------------------- commit 10c25cd94120c0e509e5ce54480c24d08281e090 Author: Father Chrysostomos <[email protected]> Date: Wed Sep 3 19:03:20 2014 -0700 Avoid duplicate GV lookup for barewords Since commit f74617600 (5.12), the GV lookup that this commit removes from yylex has only been used to see whether the bareword could be a filehandle. The result is used by intuit_method to decide whether we have a method call for âfoo barâ or âfoo $barâ. Doing this lookup for every bareword we encounter even when we are not going to call intuit_method is wasteful. The previous commit ensured that intuit_method is called only once for each bareword, so we can put that gv lookup directly inside intuit_method. M embed.fnc M proto.h M toke.c commit d484d78941e5be45f7c13c93622be0687ef90863 Author: Father Chrysostomos <[email protected]> Date: Wed Sep 3 18:21:18 2014 -0700 Donât call intuit_method twice for the same barewords This calls intuit_method once: sub fooo; print foo bar This calls it twice: sub foo; print foo bar because seeing whether we are dealing with a bareword after âprintâ, âsayâ etc. must happen *before* we look past the space after âfooâ to see whether âfoo barâ could be a method call. Thatâs because skipping a space could reset the internal variables that track whether we have just seen âprintâ. Hence, we end up with a call to intuit_method (i.e., is this a method?) inside the block that deals with print FOO. But then we have another call to intuit_method later that deals with the non-print cases. But the former can fall through to the latter if we donât have a method call here. And then intuit_method is called again with exactly the same arguments. So we just repeat the check needlessly. Avoiding the call the second time (if we have already called it above) will allow the next commit to put a GV lookup that occurs only for the sake of intuit_method directly inside intuit_method, avoiding the need for that lookup for most barewords. M toke.c commit 294a536f50e99601d3257f44b17f0e40f73f0735 Author: Father Chrysostomos <[email protected]> Date: Wed Sep 3 18:02:48 2014 -0700 MAD leftovers in toke.c M toke.c commit e5debd1111585b5c96f1f1b3d271e88e0ab68134 Author: Father Chrysostomos <[email protected]> Date: Wed Sep 3 12:59:15 2014 -0700 toke.c: Stop using len to indicate trailing :: This variable stores the length of the word we are parsing. But at one point it starts being used as a boolean to indicate that we have a bareword ending in two colons. So if are looking up are bareword that does not end in ::, we have to call strlen() to scan the string and determine the length. M toke.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- proto.h | 2 +- toke.c | 119 ++++++++++++++++++++++++++++++-------------------------------- 3 files changed, 60 insertions(+), 63 deletions(-) diff --git a/embed.fnc b/embed.fnc index 0513663..54c7f97 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2369,7 +2369,7 @@ s |void |checkcomma |NN const char *s|NN const char *name \ s |void |force_ident |NN const char *s|int kind s |void |force_ident_maybe_lex|char pit s |void |incline |NN const char *s -s |int |intuit_method |NN char *s|NULLOK GV *gv|NULLOK CV *cv +s |int |intuit_method |NN char *s|NULLOK SV *ioname|NULLOK CV *cv s |int |intuit_more |NN char *s s |I32 |lop |I32 f|int x|NN char *s rs |void |missingterm |NULLOK char *s diff --git a/proto.h b/proto.h index 35ec89b..af28f6c 100644 --- a/proto.h +++ b/proto.h @@ -7597,7 +7597,7 @@ STATIC void S_incline(pTHX_ const char *s) #define PERL_ARGS_ASSERT_INCLINE \ assert(s) -STATIC int S_intuit_method(pTHX_ char *s, GV *gv, CV *cv) +STATIC int S_intuit_method(pTHX_ char *s, SV *ioname, CV *cv) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_INTUIT_METHOD \ assert(s) diff --git a/toke.c b/toke.c index e5e3ddf..9c9731a 100644 --- a/toke.c +++ b/toke.c @@ -167,11 +167,6 @@ static const char* const lex_state_names[] = { #define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline)) -# define SKIPSPACE0(s) skipspace(s) -# define SKIPSPACE1(s) skipspace(s) -# define SKIPSPACE2(s,tsv) skipspace(s) -# define PEEKSPACE(s) skipspace(s) - /* * Convenience functions to return different tokens and prime the * lexer for the next token. They all take an argument. @@ -249,7 +244,7 @@ static const char* const lex_state_names[] = { PL_last_lop_op = f; \ if (*s == '(') \ return REPORT( (int)FUNC1 ); \ - s = PEEKSPACE(s); \ + s = skipspace(s); \ return REPORT( *s=='(' ? (int)FUNC1 : (int)UNIOP ); \ } #define UNI(f) UNI3(f,XTERM,1) @@ -1875,7 +1870,7 @@ S_lop(pTHX_ I32 f, int x, char *s) PL_expect = x; if (*s == '(') return REPORT(FUNC); - s = PEEKSPACE(s); + s = skipspace(s); if (*s == '(') return REPORT(FUNC); else { @@ -2003,7 +1998,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) PERL_ARGS_ASSERT_FORCE_WORD; - start = SKIPSPACE1(start); + start = skipspace(start); s = start; if (isIDFIRST_lazy_if(s,UTF) || (allow_pack && *s == ':') ) @@ -2017,7 +2012,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) return start; } if (token == METHOD) { - s = SKIPSPACE1(s); + s = skipspace(s); if (*s == '(') PL_expect = XTERM; else { @@ -2121,7 +2116,7 @@ S_force_version(pTHX_ char *s, int guessing) PERL_ARGS_ASSERT_FORCE_VERSION; - s = SKIPSPACE1(s); + s = skipspace(s); d = s; if (*d == 'v') @@ -2174,7 +2169,7 @@ S_force_strict_version(pTHX_ char *s) version = newSVOP(OP_CONST, 0, ver); } else if ( (*s != ';' && *s != '{' && *s != '}' ) && - (s = SKIPSPACE1(s), (*s != ';' && *s != '{' && *s != '}' ))) + (s = skipspace(s), (*s != ';' && *s != '{' && *s != '}' ))) { PL_bufptr = s; if (errstr) @@ -3818,12 +3813,18 @@ S_intuit_more(pTHX_ char *s) */ STATIC int -S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) +S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv) { char *s = start + (*start == '$'); char tmpbuf[sizeof PL_tokenbuf]; STRLEN len; GV* indirgv; + /* Mustn't actually add anything to a symbol table. + But also don't want to "initialise" any placeholder + constants that might already be there into full + blown PVGVs with attached PVCV. */ + GV * const gv = + ioname ? gv_fetchsv(ioname, GV_NOADD_NOINIT, SVt_PVCV) : NULL; PERL_ARGS_ASSERT_INTUIT_METHOD; @@ -3843,7 +3844,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY || isUPPER(*PL_tokenbuf)) return 0; - s = PEEKSPACE(s); + s = skipspace(s); PL_bufptr = start; PL_expect = XREF; return *s == '(' ? FUNCMETH : METHOD; @@ -3866,7 +3867,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) return 0; /* filehandle or package name makes it a method */ if (!cv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, UTF ? SVf_UTF8 : 0)) { - s = PEEKSPACE(s); + s = skipspace(s); if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>') return 0; /* no assumptions -- "=>" quotes bareword */ bare_package: @@ -4142,11 +4143,11 @@ S_tokenize_use(pTHX_ int is_use, char *s) { yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression", is_use ? "use" : "no")); PL_expect = XTERM; - s = SKIPSPACE1(s); + s = skipspace(s); if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { s = force_version(s, TRUE); if (*s == ';' || *s == '}' - || (s = SKIPSPACE1(s), (*s == ';' || *s == '}'))) { + || (s = skipspace(s), (*s == ';' || *s == '}'))) { NEXTVAL_NEXTTOKE.opval = NULL; force_next(WORD); } @@ -5062,7 +5063,7 @@ Perl_yylex(pTHX) } else if (*s == '>') { s++; - s = SKIPSPACE1(s); + s = skipspace(s); if (FEATURE_POSTDEREF_IS_ENABLED && ( ((*s == '$' || *s == '&') && s[1] == '*') ||(*s == '$' && s[1] == '#' && s[2] == '*') @@ -5239,7 +5240,7 @@ Perl_yylex(pTHX) case XATTRTERM: PL_expect = XTERMBLOCK; grabattrs: - s = PEEKSPACE(s); + s = skipspace(s); attrs = NULL; while (isIDFIRST_lazy_if(s,UTF)) { I32 tmp; @@ -5323,9 +5324,9 @@ Perl_yylex(pTHX) newSVOP(OP_CONST, 0, sv)); } - s = PEEKSPACE(d); + s = skipspace(d); if (*s == ':' && s[1] != ':') - s = PEEKSPACE(s+1); + s = skipspace(s+1); else if (s == d) break; /* require real whitespace or :'s */ /* XXX losing whitespace on sequential attributes here */ @@ -5376,7 +5377,7 @@ Perl_yylex(pTHX) PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */ else PL_expect = XTERM; - s = SKIPSPACE1(s); + s = skipspace(s); PL_lex_allbrackets++; TOKEN('('); case ';': @@ -5391,7 +5392,7 @@ Perl_yylex(pTHX) TOKEN(0); s++; PL_lex_allbrackets--; - s = SKIPSPACE1(s); + s = skipspace(s); if (*s == '{') PREBLOCK(')'); TERM(')'); @@ -5473,7 +5474,7 @@ Perl_yylex(pTHX) else PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR; PL_lex_allbrackets++; - s = SKIPSPACE1(s); + s = skipspace(s); if (*s == '}') { if (PL_expect == XREF && PL_lex_state == LEX_INTERPNORMAL) { PL_expect = XTERM; @@ -5911,7 +5912,7 @@ Perl_yylex(pTHX) { const char tmp = *s; if (PL_lex_state == LEX_NORMAL || PL_lex_brackets) - s = SKIPSPACE1(s); + s = skipspace(s); if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) { @@ -5923,7 +5924,7 @@ Perl_yylex(pTHX) while (isSPACE(*t) || isWORDCHAR_lazy_if(t,UTF) || *t == '$') t++; if (*t++ == ',') { - PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */ + PL_bufptr = skipspace(PL_bufptr); /* XXX can realloc */ while (t < PL_bufend && *t != ']') t++; Perl_warner(aTHX_ packWARN(WARN_SYNTAX), @@ -6023,7 +6024,7 @@ Perl_yylex(pTHX) PREREF('@'); } if (PL_lex_state == LEX_NORMAL) - s = SKIPSPACE1(s); + s = skipspace(s); if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) { if (*s == '{') PL_tokenbuf[0] = '%'; @@ -6477,6 +6478,7 @@ Perl_yylex(pTHX) lastchar && PL_bufptr - 2 >= PL_linestart ? PL_bufptr[-2] : 0; + bool safebw; /* Get the rest if it looks like a package qualifier */ @@ -6503,8 +6505,7 @@ Perl_yylex(pTHX) no_op("Bareword",s); } - /* Look for a subroutine with this name in current package, - unless this is a lexical sub, or name is "Foo::", + /* See if the name is "Foo::", in which case Foo is a bareword (and a package name). */ @@ -6520,25 +6521,17 @@ Perl_yylex(pTHX) PL_tokenbuf[len] = '\0'; gv = NULL; gvp = 0; + safebw = TRUE; } else { - if (!lex && !gv) { - /* Mustn't actually add anything to a symbol table. - But also don't want to "initialise" any placeholder - constants that might already be there into full - blown PVGVs with attached PVCV. */ - gv = gv_fetchpvn_flags(PL_tokenbuf, len, - GV_NOADD_NOINIT | ( UTF ? SVf_UTF8 : 0 ), - SVt_PVCV); - } - len = 0; + safebw = FALSE; } /* if we saw a global override before, get the right name */ if (!sv) sv = S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, - len ? len : strlen(PL_tokenbuf)); + len); if (gvp) { SV * const tmp_sv = sv; sv = newSVpvs("CORE::GLOBAL::"); @@ -6553,7 +6546,7 @@ Perl_yylex(pTHX) pl_yylval.opval->op_private = OPpCONST_BARE; /* And if "Foo::", then that's what it certainly is. */ - if (len) + if (safebw) goto safe_bareword; if (!off) @@ -6567,6 +6560,10 @@ Perl_yylex(pTHX) : rv2cv_op_cv(rv2cv_op, RV2CVOPCV_RETURN_STUB); } + /* Use this var to track whether intuit_method has been + called. intuit_method returns 0 or > 255. */ + tmp = 1; + /* See if it's the indirect object for a list operator. */ if (PL_oldoldbufptr && @@ -6580,12 +6577,12 @@ Perl_yylex(pTHX) bool immediate_paren = *s == '('; /* (Now we can afford to cross potential line boundary.) */ - s = SKIPSPACE2(s,nextPL_nextwhite); + s = skipspace(s); /* Two barewords in a row may indicate method call. */ if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && - (tmp = intuit_method(s, gv, cv))) { + (tmp = intuit_method(s, lex ? NULL : sv, cv))) { op_free(rv2cv_op); if (tmp == METHOD && !PL_lex_allbrackets && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC) @@ -6665,9 +6662,9 @@ Perl_yylex(pTHX) /* If followed by a bareword, see if it looks like indir obj. */ - if (!orig_keyword + if (tmp == 1 && !orig_keyword && (isIDFIRST_lazy_if(s,UTF) || *s == '$') - && (tmp = intuit_method(s, gv, cv))) { + && (tmp = intuit_method(s, lex ? NULL : sv, cv))) { op_free(rv2cv_op); if (tmp == METHOD && !PL_lex_allbrackets && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC) @@ -7060,7 +7057,7 @@ Perl_yylex(pTHX) PREBLOCK(DEFAULT); case KEY_do: - s = SKIPSPACE1(s); + s = skipspace(s); if (*s == '{') PRETERMBLOCK(DO); if (*s != '\'') { @@ -7069,7 +7066,7 @@ Perl_yylex(pTHX) 1, &len); if (len && (len != 4 || strNE(PL_tokenbuf+1, "CORE")) && !keyword(PL_tokenbuf + 1, len, 0)) { - d = SKIPSPACE1(d); + d = skipspace(d); if (*d == '(') { force_ident_maybe_lex('&'); s = d; @@ -7129,7 +7126,7 @@ Perl_yylex(pTHX) UNI(OP_EXIT); case KEY_eval: - s = SKIPSPACE1(s); + s = skipspace(s); if (*s == '{') { /* block eval */ PL_expect = XTERMBLOCK; UNIBRACK(OP_ENTERTRY); @@ -7178,7 +7175,7 @@ Perl_yylex(pTHX) if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR) return REPORT(0); pl_yylval.ival = CopLINE(PL_curcop); - s = SKIPSPACE1(s); + s = skipspace(s); if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) { char *p = s; @@ -7188,11 +7185,11 @@ Perl_yylex(pTHX) else if ((PL_bufend - p) >= 4 && strnEQ(p, "our", 3) && isSPACE(*(p + 3))) p += 3; - p = PEEKSPACE(p); + p = skipspace(p); /* skip optional package name, as in "for my abc $x (..)" */ if (isIDFIRST_lazy_if(p,UTF)) { p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); - p = PEEKSPACE(p); + p = skipspace(p); } if (*p != '$') Perl_croak(aTHX_ "Missing $ on loop variable"); @@ -7424,7 +7421,7 @@ Perl_yylex(pTHX) case KEY_my: case KEY_state: PL_in_my = (U16)tmp; - s = SKIPSPACE1(s); + s = skipspace(s); if (isIDFIRST_lazy_if(s,UTF)) { s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3)) @@ -7465,7 +7462,7 @@ Perl_yylex(pTHX) TOKEN(USE); case KEY_not: - if (*s == '(' || (s = SKIPSPACE1(s), *s == '(')) + if (*s == '(' || (s = skipspace(s), *s == '(')) FUN1(OP_NOT); else { if (!PL_lex_allbrackets && @@ -7475,7 +7472,7 @@ Perl_yylex(pTHX) } case KEY_open: - s = SKIPSPACE1(s); + s = skipspace(s); if (isIDFIRST_lazy_if(s,UTF)) { const char *t; d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, @@ -7535,7 +7532,7 @@ Perl_yylex(pTHX) case KEY_package: s = force_word(s,WORD,FALSE,TRUE); - s = SKIPSPACE1(s); + s = skipspace(s); s = force_strict_version(s); PREBLOCK(PACKAGE); @@ -7629,7 +7626,7 @@ Perl_yylex(pTHX) OLDLOP(OP_RETURN); case KEY_require: - s = SKIPSPACE1(s); + s = skipspace(s); if (isDIGIT(*s)) { s = force_version(s, FALSE); } @@ -7799,7 +7796,7 @@ Perl_yylex(pTHX) case KEY_sort: checkcomma(s,PL_tokenbuf,"subroutine name"); - s = SKIPSPACE1(s); + s = skipspace(s); PL_expect = XTERM; s = force_word(s,WORD,TRUE,TRUE); LOP(OP_SORT,XREF); @@ -8498,7 +8495,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) PERL_ARGS_ASSERT_SCAN_IDENT; if (isSPACE(*s)) - s = PEEKSPACE(s); + s = skipspace(s); if (isDIGIT(*s)) { while (isDIGIT(*s)) { if (d >= e) @@ -8536,7 +8533,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) s++; orig_copline = CopLINE(PL_curcop); if (s < PL_bufend && isSPACE(*s)) { - s = PEEKSPACE(s); + s = skipspace(s); } } @@ -8596,7 +8593,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) *d = '\0'; tmp_copline = CopLINE(PL_curcop); if (s < PL_bufend && isSPACE(*s)) { - s = PEEKSPACE(s); + s = skipspace(s); } if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { /* ${foo[0]} and ${foo{bar}} notation. */ @@ -8635,7 +8632,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) if ( !tmp_copline ) tmp_copline = CopLINE(PL_curcop); if (s < PL_bufend && isSPACE(*s)) { - s = PEEKSPACE(s); + s = skipspace(s); } /* Expect to find a closing } after consuming any trailing whitespace. @@ -9497,7 +9494,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re /* skip space before the delimiter */ if (isSPACE(*s)) { - s = PEEKSPACE(s); + s = skipspace(s); } /* mark where we are, in case we need to report errors */ -- Perl5 Master Repository
