From: Nicholas Clark <nick@ccl4.org>
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;
 }