From: Nicholas Clark Date: Fri, 31 Dec 2004 18:22:54 +0000 (+0000) Subject: Refactor gv_fetchpv so that the overwhelmingly common case X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc4c2da608ba3dce3152988597a4f7b3e12c599d;p=p5sagit%2Fp5-mst-13.2.git Refactor gv_fetchpv so that the overwhelmingly common case (variable names starting with a lower case letter or _, longer than one character) get out of the function very quickly. (Without even passing through a switch statement jump table) Also fixes bug 33631 p4raw-id: //depot/perl@23716 --- diff --git a/gv.c b/gv.c index a34df79..b34490c 100644 --- a/gv.c +++ b/gv.c @@ -829,246 +829,241 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) GvMULTI_on(gv) ; /* set up magic where warranted */ - switch (*name) { - case 'A': - if (strEQ(name, "ARGV")) { - IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; - } - break; - case 'E': - if (strnEQ(name, "EXPORT", 6)) - GvMULTI_on(gv); - break; - case 'I': - if (strEQ(name, "ISA")) { - AV* av = GvAVn(gv); - GvMULTI_on(gv); - sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0); - /* NOTE: No support for tied ISA */ - if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA") - && AvFILLp(av) == -1) + if (len > 1) { + if (*name > 'V' ) { + /* Nothing else to do. + The compile will probably turn the switch statement into a + branch table. Make sure we avoid even that small overhead for + the common case of lower case variable names. */ + } else { + const char *name2 = name + 1; + switch (*name) { + case 'A': + if (strEQ(name2, "RGV")) { + IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; + } + break; + case 'E': + if (strnEQ(name2, "XPORT", 5)) + GvMULTI_on(gv); + break; + case 'I': + if (strEQ(name2, "SA")) { + AV* av = GvAVn(gv); + GvMULTI_on(gv); + sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0); + /* NOTE: No support for tied ISA */ + if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA") + && AvFILLp(av) == -1) + { + char *pname; + av_push(av, newSVpvn(pname = "NDBM_File",9)); + gv_stashpvn(pname, 9, TRUE); + av_push(av, newSVpvn(pname = "DB_File",7)); + gv_stashpvn(pname, 7, TRUE); + av_push(av, newSVpvn(pname = "GDBM_File",9)); + gv_stashpvn(pname, 9, TRUE); + av_push(av, newSVpvn(pname = "SDBM_File",9)); + gv_stashpvn(pname, 9, TRUE); + av_push(av, newSVpvn(pname = "ODBM_File",9)); + gv_stashpvn(pname, 9, TRUE); + } + } + break; + case 'O': + if (strEQ(name2, "VERLOAD")) { + HV* hv = GvHVn(gv); + GvMULTI_on(gv); + hv_magic(hv, Nullgv, PERL_MAGIC_overload); + } + break; + case 'S': + if (strEQ(name2, "IG")) { + HV *hv; + I32 i; + if (!PL_psig_ptr) { + Newz(73, PL_psig_ptr, SIG_SIZE, SV*); + Newz(73, PL_psig_name, SIG_SIZE, SV*); + Newz(73, PL_psig_pend, SIG_SIZE, int); + } + GvMULTI_on(gv); + hv = GvHVn(gv); + hv_magic(hv, Nullgv, PERL_MAGIC_sig); + for (i = 1; i < SIG_SIZE; i++) { + SV ** init; + init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); + if (init) + sv_setsv(*init, &PL_sv_undef); + PL_psig_ptr[i] = 0; + PL_psig_name[i] = 0; + PL_psig_pend[i] = 0; + } + } + break; + case 'V': + if (strEQ(name2, "ERSION")) + GvMULTI_on(gv); + break; + case '\005': /* $^ENCODING */ + if (strEQ(name2, "NCODING")) + goto magicalize; + break; + case '\017': /* $^OPEN */ + if (strEQ(name2, "PEN")) + goto magicalize; + break; + case '\024': /* ${^TAINT} */ + if (strEQ(name2, "AINT")) + goto ro_magicalize; + break; + case '\025': + if (strEQ(name2, "NICODE")) + goto ro_magicalize; + break; + case '\027': /* $^WARNING_BITS */ + if (strEQ(name2, "ARNING_BITS")) + goto magicalize; + break; + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': { - char *pname; - av_push(av, newSVpvn(pname = "NDBM_File",9)); - gv_stashpvn(pname, 9, TRUE); - av_push(av, newSVpvn(pname = "DB_File",7)); - gv_stashpvn(pname, 7, TRUE); - av_push(av, newSVpvn(pname = "GDBM_File",9)); - gv_stashpvn(pname, 9, TRUE); - av_push(av, newSVpvn(pname = "SDBM_File",9)); - gv_stashpvn(pname, 9, TRUE); - av_push(av, newSVpvn(pname = "ODBM_File",9)); - gv_stashpvn(pname, 9, TRUE); - } - } - break; - case 'O': - if (strEQ(name, "OVERLOAD")) { - HV* hv = GvHVn(gv); - GvMULTI_on(gv); - hv_magic(hv, Nullgv, PERL_MAGIC_overload); - } - break; - case 'S': - if (strEQ(name, "SIG")) { - HV *hv; - I32 i; - if (!PL_psig_ptr) { - Newz(73, PL_psig_ptr, SIG_SIZE, SV*); - Newz(73, PL_psig_name, SIG_SIZE, SV*); - Newz(73, PL_psig_pend, SIG_SIZE, int); + /* ensures variable is only digits */ + /* ${"1foo"} fails this test (and is thus writeable) */ + /* added by japhy, but borrowed from is_gv_magical */ + const char *end = name + len; + while (--end > name) { + if (!isDIGIT(*end)) return gv; + } + goto ro_magicalize; } - GvMULTI_on(gv); - hv = GvHVn(gv); - hv_magic(hv, Nullgv, PERL_MAGIC_sig); - for (i = 1; i < SIG_SIZE; i++) { - SV ** init; - init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); - if (init) - sv_setsv(*init, &PL_sv_undef); - PL_psig_ptr[i] = 0; - PL_psig_name[i] = 0; - PL_psig_pend[i] = 0; } } - break; - case 'V': - if (strEQ(name, "VERSION")) - GvMULTI_on(gv); - break; - - case '&': - case '`': - case '\'': - if ( - len > 1 || - sv_type == SVt_PVAV || - sv_type == SVt_PVHV || - sv_type == SVt_PVCV || - sv_type == SVt_PVFM || - sv_type == SVt_PVIO - ) { break; } - PL_sawampersand = TRUE; - goto ro_magicalize; - - case ':': - if (len > 1) - break; - sv_setpv(GvSV(gv),PL_chopset); - goto magicalize; - - case '?': - if (len > 1) - break; + } else if (len == 1) { + /* Names of length 1. */ + switch (*name) { + case '&': + case '`': + case '\'': + if ( + sv_type == SVt_PVAV || + sv_type == SVt_PVHV || + sv_type == SVt_PVCV || + sv_type == SVt_PVFM || + sv_type == SVt_PVIO + ) { break; } + PL_sawampersand = TRUE; + goto ro_magicalize; + + case ':': + sv_setpv(GvSV(gv),PL_chopset); + goto magicalize; + + case '?': #ifdef COMPLEX_STATUS - (void)SvUPGRADE(GvSV(gv), SVt_PVLV); + (void)SvUPGRADE(GvSV(gv), SVt_PVLV); #endif - goto magicalize; + goto magicalize; - case '!': - if (len > 1) - break; + case '!': - /* If %! has been used, automatically load Errno.pm. - The require will itself set errno, so in order to - preserve its value we have to set up the magic - now (rather than going to magicalize) - */ + /* If %! has been used, automatically load Errno.pm. + The require will itself set errno, so in order to + preserve its value we have to set up the magic + now (rather than going to magicalize) + */ - sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len); + sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len); - if (sv_type == SVt_PVHV) - require_errno(gv); + if (sv_type == SVt_PVHV) + require_errno(gv); - break; - case '-': - if (len > 1) break; - else { + case '-': + { AV* av = GvAVn(gv); sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0); SvREADONLY_on(av); - } - goto magicalize; - case '*': - if (len == 1 && sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$* is no longer supported"); - break; - case '#': - if (len == 1 && sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Use of $# is deprecated"); - /* FALL THROUGH */ - case '[': - case '^': - case '~': - case '=': - case '%': - case '.': - case '(': - case ')': - case '<': - case '>': - case ',': - case '\\': - case '/': - case '\001': /* $^A */ - case '\003': /* $^C */ - case '\004': /* $^D */ - case '\006': /* $^F */ - case '\010': /* $^H */ - case '\011': /* $^I, NOT \t in EBCDIC */ - case '\016': /* $^N */ - case '\020': /* $^P */ - if (len > 1) - break; - goto magicalize; - case '|': - if (len > 1) - break; - sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0); - goto magicalize; - case '\005': /* $^E && $^ENCODING */ - if (len > 1 && strNE(name, "\005NCODING")) - break; - goto magicalize; - - case '\017': /* $^O & $^OPEN */ - if (len > 1 && strNE(name, "\017PEN")) - break; - goto magicalize; - case '\023': /* $^S */ - if (len > 1) - break; - goto ro_magicalize; - case '\024': /* $^T, ${^TAINT} */ - if (len == 1) - goto magicalize; - else if (strEQ(name, "\024AINT")) - goto ro_magicalize; - else - break; - case '\025': - if (len > 1 && strNE(name, "\025NICODE")) - break; - goto ro_magicalize; - - case '\027': /* $^W & $^WARNING_BITS */ - if (len > 1 - && strNE(name, "\027ARNING_BITS") - ) - break; - goto magicalize; - - case '+': - if (len > 1) + goto magicalize; + } + case '*': + if (sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "$* is no longer supported"); break; - else { - AV* av = GvAVn(gv); + case '#': + if (sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "Use of $# is deprecated"); + goto magicalize; + case '|': + sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0); + goto magicalize; + + case '+': + { + AV* av = GvAVn(gv); sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0); SvREADONLY_on(av); - } - /* FALL THROUGH */ - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - /* ensures variable is only digits */ - /* ${"1foo"} fails this test (and is thus writeable) */ - /* added by japhy, but borrowed from is_gv_magical */ - - if (len > 1) { - const char *end = name + len; - while (--end > name) { - if (!isDIGIT(*end)) return gv; - } + /* FALL THROUGH */ } + case '\023': /* $^S */ + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + ro_magicalize: + SvREADONLY_on(GvSV(gv)); + /* FALL THROUGH */ + case '[': + case '^': + case '~': + case '=': + case '%': + case '.': + case '(': + case ')': + case '<': + case '>': + case ',': + case '\\': + case '/': + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\010': /* $^H */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\016': /* $^N */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\024': /* $^T */ + case '\027': /* $^W */ + magicalize: + sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len); + break; - ro_magicalize: - SvREADONLY_on(GvSV(gv)); - magicalize: - sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len); - break; - - case '\014': /* $^L */ - if (len > 1) + case '\014': /* $^L */ + sv_setpv(GvSV(gv),"\f"); + PL_formfeed = GvSV(gv); break; - sv_setpv(GvSV(gv),"\f"); - PL_formfeed = GvSV(gv); - break; - case ';': - if (len > 1) + case ';': + sv_setpv(GvSV(gv),"\034"); break; - sv_setpv(GvSV(gv),"\034"); - break; - case ']': - if (len == 1) { + case ']': + { SV *sv = GvSV(gv); if (!sv_derived_from(PL_patchlevel, "version")) (void *)upg_version(PL_patchlevel); @@ -1077,14 +1072,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) SvREFCNT_dec(sv); } break; - case '\026': /* $^V */ - if (len == 1) { + case '\026': /* $^V */ + { SV *sv = GvSV(gv); GvSV(gv) = new_version(PL_patchlevel); SvREADONLY_on(GvSV(gv)); SvREFCNT_dec(sv); } break; + } } return gv; }