This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid duplicate GV lookup for barewords
authorFather Chrysostomos <sprout@cpan.org>
Thu, 4 Sep 2014 02:03:20 +0000 (19:03 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 4 Sep 2014 02:07:54 +0000 (19:07 -0700)
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.

embed.fnc
proto.h
toke.c

index 0513663..54c7f97 100644 (file)
--- 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 (file)
--- 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 fec45dd..9c9731a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3813,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;
 
@@ -6499,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). */
 
@@ -6519,15 +6524,6 @@ Perl_yylex(pTHX)
                    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);
-                   }
                    safebw = FALSE;
                }
 
@@ -6586,7 +6582,7 @@ Perl_yylex(pTHX)
                    /* 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)
@@ -6668,7 +6664,7 @@ Perl_yylex(pTHX)
 
                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)