gv_fetchpvn_flags ranks highly in the profile, and the ::/' scanning

loop is iterated over millions of times. Add a flag GV_NOTQUAL purely
as an optimisation, when the caller is passing in a string that is
known not to contain any package separators.

p4raw-id: //depot/perl@27053

diff --git a/doio.c b/doio.c
index 97baa0f..495599c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -734,7 +734,7 @@ Perl_nextargv(pTHX_ register GV *gv)
     IO * const io = GvIOp(gv);
 
     if (!PL_argvoutgv)
-       PL_argvoutgv = gv_fetchpvs("ARGVOUT",GV_ADD,SVt_PVIO);
+       PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
        IoFLAGS(io) &= ~IOf_START;
        if (PL_inplace) {
@@ -767,7 +767,8 @@ Perl_nextargv(pTHX_ register GV *gv)
            if (PL_inplace) {
                TAINT_PROPER("inplace open");
                if (oldlen == 1 && *PL_oldname == '-') {
-                   setdefout(gv_fetchpvs("STDOUT",GV_ADD,SVt_PVIO));
+                   setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL,
+                                         SVt_PVIO));
                    return IoIFP(GvIOp(gv));
                }
 #ifndef FLEXFILENAMES
@@ -934,7 +935,7 @@ Perl_nextargv(pTHX_ register GV *gv)
            SvREFCNT_dec(oldout);
            return Nullfp;
        }
-       setdefout(gv_fetchpvs("STDOUT",GV_ADD,SVt_PVIO));
+       setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO));
     }
     return Nullfp;
 }

diff --git a/gv.c b/gv.c
index 0cf779f..492c1f3 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -762,10 +762,17 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
     const I32 no_expand = flags & GV_NOEXPAND;
-    const I32 add = flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND;
+    const I32 add =
+       flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND & ~GV_NOTQUAL;
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
 
+    if (flags & GV_NOTQUAL) {
+       /* Caller promised that there is no stash, so we can skip the check. */
+       len = full_len;
+       goto no_stash;
+    }
+
     if (full_len > 2 && *name == '*' && isALPHA(name[1])) {
        /* accidental stringify on a GV? */
        name++;
@@ -827,6 +834,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     /* No stash in name, so see how we can default */
 
     if (!stash) {
+    no_stash:
        if (len && isIDFIRST_lazy(name)) {
            bool global = FALSE;
 

diff --git a/gv.h b/gv.h
index 4b410e8..7bd16cd 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -173,6 +173,8 @@ Return the SV from the GV.
 #define GV_NOADD_NOINIT        0x20    /* Don't add the symbol if it's not there.
                                   Don't init it if it is there but ! PVGV */
 #define GV_NOEXPAND    0x40    /* Don't expand SvOK() entries to PVGV */
+#define GV_NOTQUAL     0x80    /* A plain symbol name, not qualified with a
+                                  package (so skip checks for :: and ')  */
 
 /*      SVf_UTF8 (more accurately the return value from SvUTF8) is also valid
        as a flag to gv_fetch_pvn_flags, so ensure it lies outside this range.

diff --git a/op.c b/op.c
index 08d3e88..e7ed292 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2050,8 +2050,9 @@ OP *
 Perl_jmaybe(pTHX_ OP *o)
 {
     if (o->op_type == OP_LIST) {
-       OP * const o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD,
-                                                              SVt_PV)));
+       OP * const o2
+           = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL,
+                                                    SVt_PV)));
        o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
     }
     return o;
@@ -3235,7 +3236,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
     GV *gv = Nullgv;
 
     if (!force_builtin) {
-       gv = gv_fetchpvs("do", 0, SVt_PVCV);
+       gv = gv_fetchpvs("do", GV_NOTQUAL, SVt_PVCV);
        if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
            GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "do", FALSE);
            gv = gvp ? *gvp : Nullgv;
@@ -4974,7 +4975,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 
     GV * const gv = o
        ? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM)
-       : gv_fetchpvs("STDOUT", GV_ADD, SVt_PVFM);
+       : gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM);
 
 #ifdef GV_UNIQUE_CHECK
     if (GvUNIQUE(gv)) {
@@ -5801,7 +5802,7 @@ Perl_ck_glob(pTHX_ OP *o)
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        append_elem(OP_GLOB, o, newDEFSVOP());
 
-    if (!((gv = gv_fetchpvs("glob", 0, SVt_PVCV))
+    if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV))
          && GvCVu(gv) && GvIMPORTED_CV(gv)))
     {
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
@@ -6223,7 +6224,7 @@ Perl_ck_require(pTHX_ OP *o)
 
     if (!(o->op_flags & OPf_SPECIAL)) { /* Wasn't written as CORE::require */
        /* handle override, if any */
-       gv = gv_fetchpvs("require", 0, SVt_PVCV);
+       gv = gv_fetchpvs("require", GV_NOTQUAL, SVt_PVCV);
        if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
            GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "require", FALSE);
            gv = gvp ? *gvp : Nullgv;
@@ -6384,8 +6385,8 @@ S_simplify_sort(pTHX_ OP *o)
     const char *gvname;
     if (!(o->op_flags & OPf_STACKED))
        return;
-    GvMULTI_on(gv_fetchpvs("a", GV_ADD, SVt_PV));
-    GvMULTI_on(gv_fetchpvs("b", GV_ADD, SVt_PV));
+    GvMULTI_on(gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV));
+    GvMULTI_on(gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV));
     kid = kUNOP->op_first;                             /* get past null */
     if (kid->op_type != OP_SCOPE)
        return;

diff --git a/perl.c b/perl.c
index f0261b9..9aa2a90 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1371,7 +1371,7 @@ S_procself_val(pTHX_ SV *sv, const char *arg0)
 STATIC void
 S_set_caret_X(pTHX) {
     dVAR;
-    GV* tmpgv = gv_fetchpvs("\030", GV_ADD, SVt_PV); /* $^X */
+    GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
     if (tmpgv) {
 #ifdef HAS_PROCSELFEXE
        S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
@@ -2122,7 +2122,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                  (fp = IoOFP(io)))
                   PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
              if ((PL_unicode & PERL_UNICODE_INOUT_FLAG) &&
-                 (sv = GvSV(gv_fetchpvs("\017PEN", GV_ADD, SVt_PV)))) {
+                 (sv = GvSV(gv_fetchpvs("\017PEN", GV_ADD|GV_NOTQUAL,
+                                        SVt_PV)))) {
                   U32 in  = PL_unicode & PERL_UNICODE_IN_FLAG;
                   U32 out = PL_unicode & PERL_UNICODE_OUT_FLAG;
                   if (in) {
@@ -3461,7 +3462,7 @@ S_init_main_stash(pTHX)
        table, so it's a small saving to use it rather than allocate another
        8 bytes.  */
     PL_curstname = newSVpvs_share("main");
-    gv = gv_fetchpvs("main::", GV_ADD, SVt_PVHV);
+    gv = gv_fetchpvs("main::", GV_ADD|GV_NOTQUAL, SVt_PVHV);
     /* If we hadn't caused another reference to "main" to be in the shared
        string table above, then it would be worth reordering these two,
        because otherwise all we do is delete "main" from it as a consequence
@@ -3470,17 +3471,18 @@ S_init_main_stash(pTHX)
     hv_name_set(PL_defstash, "main", 4, 0);
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
-    PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD, SVt_PVAV)));
+    PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL,
+                                            SVt_PVAV)));
     SvREFCNT_inc(PL_incgv); /* Don't allow it to be freed */
     GvMULTI_on(PL_incgv);
-    PL_hintgv = gv_fetchpvs("\010", GV_ADD, SVt_PV); /* ^H */
+    PL_hintgv = gv_fetchpvs("\010", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^H */
     GvMULTI_on(PL_hintgv);
-    PL_defgv = gv_fetchpvs("_", GV_ADD, SVt_PVAV);
+    PL_defgv = gv_fetchpvs("_", GV_ADD|GV_NOTQUAL, SVt_PVAV);
     SvREFCNT_inc(PL_defgv);
-    PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD, SVt_PV));
+    PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD|GV_NOTQUAL, SVt_PV));
     SvREFCNT_inc(PL_errgv);
     GvMULTI_on(PL_errgv);
-    PL_replgv = gv_fetchpvs("\022", GV_ADD, SVt_PV); /* ^R */
+    PL_replgv = gv_fetchpvs("\022", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^R */
     GvMULTI_on(PL_replgv);
     (void)Perl_form(aTHX_ "%240s",""); /* Preallocate temp - for immediate signals. */
 #ifdef PERL_DONT_CREATE_GVSV
@@ -4490,31 +4492,31 @@ S_init_predump_symbols(pTHX)
     IO *io;
 
     sv_setpvn(get_sv("\"", TRUE), " ", 1);
-    PL_stdingv = gv_fetchpvs("STDIN", GV_ADD, SVt_PVIO);
+    PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
     io = GvIOp(PL_stdingv);
     IoTYPE(io) = IoTYPE_RDONLY;
     IoIFP(io) = PerlIO_stdin();
-    tmpgv = gv_fetchpvs("stdin", GV_ADD, SVt_PV);
+    tmpgv = gv_fetchpvs("stdin", GV_ADD|GV_NOTQUAL, SVt_PV);
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
-    tmpgv = gv_fetchpvs("STDOUT", GV_ADD, SVt_PVIO);
+    tmpgv = gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(tmpgv);
     io = GvIOp(tmpgv);
     IoTYPE(io) = IoTYPE_WRONLY;
     IoOFP(io) = IoIFP(io) = PerlIO_stdout();
     setdefout(tmpgv);
-    tmpgv = gv_fetchpvs("stdout", GV_ADD, SVt_PV);
+    tmpgv = gv_fetchpvs("stdout", GV_ADD|GV_NOTQUAL, SVt_PV);
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
-    PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD, SVt_PVIO);
+    PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     GvMULTI_on(PL_stderrgv);
     io = GvIOp(PL_stderrgv);
     IoTYPE(io) = IoTYPE_WRONLY;
     IoOFP(io) = IoIFP(io) = PerlIO_stderr();
-    tmpgv = gv_fetchpvs("stderr", GV_ADD, SVt_PV);
+    tmpgv = gv_fetchpvs("stderr", GV_ADD|GV_NOTQUAL, SVt_PV);
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
@@ -4547,7 +4549,7 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
                sv_setiv(GvSV(gv_fetchpv(argv[0]+1, GV_ADD, SVt_PV)),1);
        }
     }
-    if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD, SVt_PVAV))) {
+    if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD|GV_NOTQUAL, SVt_PVAV))) {
        GvMULTI_on(PL_argvgv);
        (void)gv_AVadd(PL_argvgv);
        av_clear(GvAVn(PL_argvgv));
@@ -4582,7 +4584,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 
     init_argv_symbols(argc,argv);
 
-    if ((tmpgv = gv_fetchpvs("0", GV_ADD, SVt_PV))) {
+    if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) {
 #ifdef MACOS_TRADITIONAL
        /* $0 is not majick on a Mac */
        sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename));
@@ -4591,7 +4593,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        magicname("0", "0", 1);
 #endif
     }
-    if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD, SVt_PVHV))) {
+    if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
        HV *hv;
        GvMULTI_on(PL_envgv);
        hv = GvHVn(PL_envgv);
@@ -4640,7 +4642,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #endif /* !PERL_MICRO */
     }
     TAINT_NOT;
-    if ((tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV))) {
+    if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
         SvREADONLY_off(GvSV(tmpgv));
        sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
         SvREADONLY_on(GvSV(tmpgv));

diff --git a/pp_ctl.c b/pp_ctl.c
index 98642e1..c8b4870 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1078,7 +1078,7 @@ PP(pp_flip)
                flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
            }
            else {
-               GV * const gv = gv_fetchpvs(".", GV_ADD, SVt_PV);
+               GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV);
                if (gv && GvSV(gv))
                    flip = SvIV(sv) == SvIV(GvSV(gv));
            }
@@ -1172,7 +1172,7 @@ PP(pp_flop)
                flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
            }
            else {
-               GV * const gv = gv_fetchpvs(".", GV_ADD, SVt_PV);
+               GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV);
                if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv));
            }
        }

diff --git a/pp_sort.c b/pp_sort.c
index 1c43f6d..868d6ab 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1631,8 +1631,8 @@ PP(pp_sort)
                SAVESPTR(PL_firstgv);
                SAVESPTR(PL_secondgv);
                SAVESPTR(PL_sortstash);
-               PL_firstgv = gv_fetchpvs("a", GV_ADD, SVt_PV);
-               PL_secondgv = gv_fetchpvs("b", GV_ADD, SVt_PV);
+               PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
+               PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);
                PL_sortstash = stash;
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));

diff --git a/pp_sys.c b/pp_sys.c
index bc5a23e..4470aa6 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1330,7 +1330,7 @@ PP(pp_leavewrite)
                topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
-                 !gv_fetchpvs("top", 0, SVt_PVFM))
+                 !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM))
                    IoTOP_NAME(io) = savesvpv(topname);
                else
                    IoTOP_NAME(io) = savepvs("top");
@@ -3856,7 +3856,7 @@ PP(pp_fork)
     if (childpid < 0)
        RETSETUNDEF;
     if (!childpid) {
-       GV * const tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV);
+       GV * const tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV);
        if (tmpgv) {
             SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());

diff --git a/toke.c b/toke.c
index fafd82e..95f86fa 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2893,8 +2893,8 @@ Perl_yylex(pTHX)
                     * at least, set argv[0] to the basename of the Perl
                     * interpreter. So, having found "#!", we'll set it right.
                     */
-                   SV * const x
-                       = GvSV(gv_fetchpvs("\030", GV_ADD, SVt_PV)); /* $^X */
+                   SV * const x = GvSV(gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL,
+                                                   SVt_PV)); /* $^X */
                    assert(SvPOK(x) || SvGMAGICAL(x));
                    if (sv_eq(x, CopFILESV(PL_curcop))) {
                        sv_setpvn(x, ipath, ipathend - ipath);
@@ -3127,7 +3127,7 @@ Perl_yylex(pTHX)
            case 'T': ftst = OP_FTTEXT;         break;
            case 'B': ftst = OP_FTBINARY;       break;
            case 'M': case 'A': case 'C':
-               gv_fetchpvs("\024",GV_ADD, SVt_PV);
+               gv_fetchpvs("\024", GV_ADD|GV_NOTQUAL, SVt_PV);
                switch (tmp) {
                case 'M': ftst = OP_FTMTIME;    break;
                case 'A': ftst = OP_FTATIME;    break;
@@ -4694,7 +4694,8 @@ Perl_yylex(pTHX)
            }
 
        case KEY_chdir:
-           (void)gv_fetchpvs("ENV", GV_ADD, SVt_PVHV); /* may use HOME */
+           /* may use HOME */
+           (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV);
            UNI(OP_CHDIR);
 
        case KEY_close:
@@ -5668,10 +5669,11 @@ Perl_yylex(pTHX)
            char ctl_l[2];
            ctl_l[0] = toCTRL('L');
            ctl_l[1] = '\0';
-           gv_fetchpvn_flags(ctl_l, 1, GV_ADD, SVt_PV);
+           gv_fetchpvn_flags(ctl_l, 1, GV_ADD|GV_NOTQUAL, SVt_PV);
        }
 #else
-           gv_fetchpvs("\f", GV_ADD, SVt_PV);  /* Make sure $^L is defined */
+           /* Make sure $^L is defined */
+           gv_fetchpvs("\f", GV_ADD|GV_NOTQUAL, SVt_PV);
 #endif
            UNI(OP_ENTERWRITE);
 
@@ -10016,7 +10018,7 @@ S_scan_inputsymbol(pTHX_ char *start)
            Copy("ARGV",d,5,char);
 
        /* Check whether readline() is overriden */
-       gv_readline = gv_fetchpvs("readline", 0, SVt_PVCV);
+       gv_readline = gv_fetchpvs("readline", GV_NOTQUAL, SVt_PVCV);
        if ((gv_readline
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||

diff --git a/util.c b/util.c
index 1917730..636b06d 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2273,7 +2273,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
            PerlProc__exit(1);
        }
 #endif /* defined OS2 */
-       if ((tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV))) {
+       if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
            SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), PerlProc_getpid());
            SvREADONLY_on(GvSV(tmpgv));