Performance improvement for overloaded classes from Benjamin Holzman

4 files changed, 32 insertions, 4 deletions

diff --git a/dist/Storable/ChangeLog b/dist/Storable/ChangeLog
index 4ce98539c3..1bf53bb976 100644
--- a/dist/Storable/ChangeLog
+++ b/dist/Storable/ChangeLog
@@ -1,3 +1,16 @@
+Fri Nov 12 10:52:19 IST 2010   Abhijit Menon-Sen <ams@toroid.org>
+
+    Version 2.24
+
+	Performance improvement for overloaded classes from Benjamin
+	Holzman.
+
+Fri Nov 12 10:36:22 IST 2010   Abhijit Menon-Sen <ams@toroid.org>
+
+    Version 2.23
+
+	Release the latest version from the Perl repository.
+
 Thu Aug  6 10:55:50 IST 2009   Abhijit Menon-Sen <ams@toroid.org>
 
     Version 2.21
diff --git a/dist/Storable/README b/dist/Storable/README
index cb4589e161..e9def9d380 100644
--- a/dist/Storable/README
+++ b/dist/Storable/README
@@ -59,7 +59,7 @@ Thanks to (in chronological order):
 
     Jarkko Hietaniemi <jhi@iki.fi>
     Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
-    Benjamin A. Holzman <bah@ecnvantage.com>
+    Benjamin A. Holzman <bholzman@earthlink.net>
     Andrew Ford <A.Ford@ford-mason.co.uk>
     Gisle Aas <gisle@aas.no>
     Jeff Gresham <gresham_jeffrey@jpmorgan.com>
diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm
index ddb9c82f6e..b6bfa885f7 100644
--- a/dist/Storable/Storable.pm
+++ b/dist/Storable/Storable.pm
@@ -23,7 +23,7 @@ use AutoLoader;
 use FileHandle;
 use vars qw($canonical $forgive_me $VERSION);
 
-$VERSION = '2.23';
+$VERSION = '2.24';
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;		# Grrr...
 
 #
@@ -1154,7 +1154,7 @@ Thank you to (in chronological order):
 
 	Jarkko Hietaniemi <jhi@iki.fi>
 	Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
-	Benjamin A. Holzman <bah@ecnvantage.com>
+	Benjamin A. Holzman <bholzman@earthlink.net>
 	Andrew Ford <A.Ford@ford-mason.co.uk>
 	Gisle Aas <gisle@aas.no>
 	Jeff Gresham <gresham_jeffrey@jpmorgan.com>
@@ -1165,6 +1165,7 @@ Thank you to (in chronological order):
 	Salvador Ortiz Garcia <sog@msg.com.mx>
 	Dominic Dunlop <domo@computer.org>
 	Erik Haugan <erik@solbors.no>
+    Benjamin A. Holzman <ben.holzman@grantstreet.com>
 
 for their bug reports, suggestions and contributions.
 
@@ -1176,7 +1177,9 @@ simply counting the objects instead of tagging them (leading to
 a binary incompatibility for the Storable image starting at version
 0.6--older images are, of course, still properly understood).
 Murray Nesbitt made Storable thread-safe.  Marc Lehmann added overloading
-and references to tied items support.
+and references to tied items support.  Benjamin Holzman added a performance
+improvement for overloaded classes; thanks to Grant Street Group for footing
+the bill.
 
 =head1 AUTHOR
 
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index bbe15f4a2f..1654557d67 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -386,6 +386,7 @@ typedef struct stcxt {
 	SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, const char *);	/* retrieve dispatch table */
 	SV *prev;		/* contexts chained backwards in real recursion */
 	SV *my_sv;		/* the blessed scalar who's SvPVX() I am */
+	int in_retrieve_overloaded; /* performance hack for retrieving overloaded objects */
 } stcxt_t;
 
 #define NEW_STORABLE_CXT_OBJ(cxt)					\
@@ -1045,6 +1046,8 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 
 /*
  * Bless `s' in `p', via a temporary reference, required by sv_bless().
+ * "A" magic is added before the sv_bless for overloaded classes, this avoids
+ * an expensive call to S_reset_amagic in sv_bless.
  */
 #define BLESS(s,p) 							\
   STMT_START {								\
@@ -1053,6 +1056,11 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 	TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (p))); \
 	stash = gv_stashpv((p), GV_ADD);			\
 	ref = newRV_noinc(s);					\
+	if (cxt->in_retrieve_overloaded && Gv_AMG(stash)) \
+	{ \
+	    cxt->in_retrieve_overloaded = 0; \
+		SvAMAGIC_on(ref);                            \
+	} \
 	(void) sv_bless(ref, stash);			\
 	SvRV_set(ref, NULL);						\
 	SvREFCNT_dec(ref);						\
@@ -1500,6 +1508,7 @@ static void init_retrieve_context(pTHX_ stcxt_t *cxt, int optype, int is_tainted
         cxt->use_bytes = -1;		/* Fetched from perl if needed */
 #endif
         cxt->accept_future_minor = -1;	/* Fetched from perl if needed */
+	cxt->in_retrieve_overloaded = 0;
 }
 
 /*
@@ -1550,6 +1559,7 @@ static void clean_retrieve_context(pTHX_ stcxt_t *cxt)
 #endif
         cxt->accept_future_minor = -1;	/* Fetched from perl if needed */
 
+	cxt->in_retrieve_overloaded = 0;
 	reset_context(cxt);
 }
 
@@ -4499,7 +4509,9 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname)
 
 	rv = NEWSV(10002, 0);
 	SEEN(rv, cname, 0);		/* Will return if rv is null */
+	cxt->in_retrieve_overloaded = 1; /* so sv_bless doesn't call S_reset_amagic */
 	sv = retrieve(aTHX_ cxt, 0);	/* Retrieve <object> */
+	cxt->in_retrieve_overloaded = 0;
 	if (!sv)
 		return (SV *) 0;	/* Failed */