From 51f77169798efa27e731b2302c26b7e90d678185 Mon Sep 17 00:00:00 2001 From: Abhijit Menon-Sen Date: Fri, 12 Nov 2010 22:56:19 +0530 Subject: [PATCH] Performance improvement for overloaded classes from Benjamin Holzman --- dist/Storable/ChangeLog | 13 +++++++++++++ dist/Storable/README | 2 +- dist/Storable/Storable.pm | 9 ++++++--- dist/Storable/Storable.xs | 12 ++++++++++++ 4 files changed, 32 insertions(+), 4 deletions(-) diff --git a/dist/Storable/ChangeLog b/dist/Storable/ChangeLog index 4ce9853..1bf53bb 100644 --- a/dist/Storable/ChangeLog +++ b/dist/Storable/ChangeLog @@ -1,3 +1,16 @@ +Fri Nov 12 10:52:19 IST 2010 Abhijit Menon-Sen + + Version 2.24 + + Performance improvement for overloaded classes from Benjamin + Holzman. + +Fri Nov 12 10:36:22 IST 2010 Abhijit Menon-Sen + + Version 2.23 + + Release the latest version from the Perl repository. + Thu Aug 6 10:55:50 IST 2009 Abhijit Menon-Sen Version 2.21 diff --git a/dist/Storable/README b/dist/Storable/README index cb4589e..e9def9d 100644 --- a/dist/Storable/README +++ b/dist/Storable/README @@ -59,7 +59,7 @@ Thanks to (in chronological order): Jarkko Hietaniemi Ulrich Pfeifer - Benjamin A. Holzman + Benjamin A. Holzman Andrew Ford Gisle Aas Jeff Gresham diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index ddb9c82..b6bfa88 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 Ulrich Pfeifer - Benjamin A. Holzman + Benjamin A. Holzman Andrew Ford Gisle Aas Jeff Gresham @@ -1165,6 +1165,7 @@ Thank you to (in chronological order): Salvador Ortiz Garcia Dominic Dunlop Erik Haugan + Benjamin A. Holzman 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 bbe15f4..1654557 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 */ + cxt->in_retrieve_overloaded = 0; if (!sv) return (SV *) 0; /* Failed */ -- 2.7.4