From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 7 Oct 2006 22:06:19 +0000 (+0000)
Subject: Make reference stringification (blessed and unblessed) about as fast as
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fafee734dd1789ab8d2c4d54e0089d2894535aeb;p=p5sagit%2Fp5-mst-13.2.git

Make reference stringification (blessed and unblessed) about as fast as
is possible, because I'm told it's used quite frequently.

p4raw-id: //depot/perl@28961
---

diff --git a/sv.c b/sv.c
index 19e1d26..4fa4498 100644
--- a/sv.c
+++ b/sv.c
@@ -2729,12 +2729,15 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		}
 	    }
 	    {
-		SV *tsv;
+		STRLEN len;
+		char *retval;
+		char *buffer;
 		MAGIC *mg;
 		const SV *const referent = (SV*)SvRV(sv);
 
 		if (!referent) {
-		    tsv = sv_2mortal(newSVpvs("NULLREF"));
+		    len = 7;
+		    retval = buffer = savepvn("NULLREF", len);
 		} else if (SvTYPE(referent) == SVt_PVMG
 			   && ((SvFLAGS(referent) &
 				(SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
@@ -2743,21 +2746,66 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		    return stringify_regexp(sv, mg, lp);
 		} else {
 		    const char *const typestr = sv_reftype(referent, 0);
+		    const STRLEN typelen = strlen(typestr);
+		    UV addr = PTR2UV(referent);
+		    const char *stashname = NULL;
+		    STRLEN stashnamelen = 0; /* hush, gcc */
+		    const char *buffer_end;
 
-		    tsv = sv_newmortal();
 		    if (SvOBJECT(referent)) {
-			const char *const name = HvNAME_get(SvSTASH(referent));
-			Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
-				       name ? name : "__ANON__" , typestr,
-				       PTR2UV(referent));
+			const HEK *const name = HvNAME_HEK(SvSTASH(referent));
+
+			if (name) {
+			    stashname = HEK_KEY(name);
+			    stashnamelen = HEK_LEN(name);
+
+			    if (HEK_UTF8(name)) {
+				SvUTF8_on(sv);
+			    } else {
+				SvUTF8_off(sv);
+			    }
+			} else {
+			    stashname = "__ANON__";
+			    stashnamelen = 8;
+			}
+			len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */
+			    + 2 * sizeof(UV) + 2 /* )\0 */;
+		    } else {
+			len = typelen + 3 /* (0x */
+			    + 2 * sizeof(UV) + 2 /* )\0 */;
 		    }
-		    else
-			Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr,
-				       PTR2UV(referent));
+
+		    Newx(buffer, len, char);
+		    buffer_end = retval = buffer + len;
+
+		    /* Working backwards  */
+		    *--retval = '\0';
+		    *--retval = ')';
+		    do {
+			*--retval = PL_hexdigit[addr & 15];
+		    } while (addr >>= 4);
+		    *--retval = 'x';
+		    *--retval = '0';
+		    *--retval = '(';
+
+		    retval -= typelen;
+		    memcpy(retval, typestr, typelen);
+
+		    if (stashname) {
+			*--retval = '=';
+			retval -= stashnamelen;
+			memcpy(retval, stashname, stashnamelen);
+		    }
+		    /* retval may not neccesarily have reached the start of the
+		       buffer here.  */
+		    assert (retval >= buffer);
+
+		    len = buffer_end - retval - 1; /* -1 for that \0  */
 		}
 		if (lp)
-		    *lp = SvCUR(tsv);
-		return SvPVX(tsv);
+		    *lp = len;
+		SAVEFREEPV(buffer);
+		return retval;
 	    }
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {