Perfect! Applied. Many thanks Dave.
Tim.
On Wed, Apr 18, 2012 at 11:48:31AM +0100, Dave Mitchell wrote:
> On Fri, Mar 02, 2012 at 05:04:29PM +0000, Dave Mitchell wrote:
> > On Fri, Mar 02, 2012 at 03:23:30PM +0000, Dave Mitchell wrote:
> > > I'd be happy in principle, although some guidance would be welcome
> >
> > Also in particular, what needs to continue happening across an API
> > change? Is it just that a driver, compiled and installed against an old
> > DBI, must continue to work if the DBI is upgraded?
>
> I've now attached a revised DBIS patch. The only difference is that
> the new DBI continues to store a pointer to the dbi_state struct in
> $DBI::_dbistate, so that DBD modules compiled against the old DBI can
> continue to retrieve the struct the old way. Once recompiled, they'll
> start to use the new method.
>
> IIUC, this means that there are no binary or backwards compatibility
> issues, and no API version numbers need bumping.
>
> --
> The optimist believes that he lives in the best of all possible worlds.
> As does the pessimist.
> From 0fb5fd6a7099c5fc40bd0b9d40b8b34d748533b5 Mon Sep 17 00:00:00 2001
> From: David Mitchell <da...@iabyn.com>
> Date: Fri, 10 Feb 2012 13:11:13 +0000
> Subject: [PATCH] under ithreads, make DBIS efficient for DBD::*
>
> rather than the slow looking up of $DBI::_dbistate on every use of DBIS,
> convert DBIS into a call to a C-level function that returns the address of
> the dbi_state struct.
>
> Since the C-level function is only directly callable from DBI, store its
> address in an XSUB, so that the DBD:* modules can retrieve the function's
> address and cache it in a static var.
>
> We continue to store the dbi_state struct address within $DBI::_dbistate
> too, so that DBD modules compiled against an older DBI will continue to
> work if the DBI is upgraded but the DBD not recompiled.
> ---
> DBI.pm | 4 +---
> DBI.xs | 39 +++++++++++++++++++--------------------
> DBIXS.h | 39 +++++++++++++++++++++++++++------------
> 3 files changed, 47 insertions(+), 35 deletions(-)
>
> diff --git a/DBI.pm b/DBI.pm
> index 4e02e8c..614ffae 100644
> --- a/DBI.pm
> +++ b/DBI.pm
> @@ -519,10 +519,8 @@ END {
>
>
> sub CLONE {
> - my $olddbis = $DBI::_dbistate;
> _clone_dbis() unless $DBI::PurePerl; # clone the DBIS structure
> - DBI->trace_msg(sprintf "CLONE DBI for new thread %s\n",
> - $DBI::PurePerl ? "" : sprintf("(dbis %x -> %x)",$olddbis,
> $DBI::_dbistate));
> + DBI->trace_msg("CLONE DBI for new thread\n");
> while ( my ($driver, $drh) = each %DBI::installed_drh) {
> no strict 'refs';
> next if defined &{"DBD::${driver}::CLONE"};
> diff --git a/DBI.xs b/DBI.xs
> index 64dc5b1..a9e9000 100644
> --- a/DBI.xs
> +++ b/DBI.xs
> @@ -127,8 +127,6 @@ char *neatsvpv _((SV *sv, STRLEN maxlen));
> SV * preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept,
> void *foo);
> static meth_types get_meth_type(const char * const name);
>
> -DBISTATE_DECLARE;
> -
> struct imp_drh_st { dbih_drc_t com; };
> struct imp_dbh_st { dbih_dbc_t com; };
> struct imp_sth_st { dbih_stc_t com; };
> @@ -310,13 +308,20 @@ typedef struct {
>
> START_MY_CXT
>
> -#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
> -# undef DBIS
> -# define DBIS (MY_CXT.dbi_state)
> -#endif
> +#undef DBIS
> +#define DBIS (MY_CXT.dbi_state)
>
> #define g_dbi_last_h (MY_CXT.dbi_last_h)
>
> +/* allow the 'static' dbi_state struct to be accessed from other files */
> +dbistate_t**
> +_dbi_state_lval(pTHX)
> +{
> + dMY_CXT;
> + return &(MY_CXT.dbi_state);
> +}
> +
> +
> /* --- */
>
> static void *
> @@ -521,15 +526,12 @@ dbi_bootinit(dbistate_t * parent_dbis)
> dbistate_t* DBISx;
>
> DBISx = (struct dbistate_st*)malloc_using_sv(sizeof(struct dbistate_st));
> -
> - /* publish address of dbistate so dynaloaded DBD's can find it,
> - * taking care to store the value in the same way it'll be used
> - * to avoid problems on some architectures, for example see
> - * http://rt.cpan.org/Public/Bug/Display.html?id=32309
> - */
> - sv_setiv(get_sv(DBISTATE_PERLNAME, GV_ADDMULTI), 0); /* force SvIOK */
> DBIS = DBISx;
> - DBIS_PUBLISHED_LVALUE = DBISx;
> +
> + /* make DBIS available to DBD modules the "old" (<= 1.618) way,
> + * so that unrecompiled DBD's will still work against a newer DBI */
> + sv_setiv(get_sv("DBI::_dbistate", GV_ADDMULTI),
> + PTR2IV(MY_CXT.dbi_state));
>
> /* store version and size so we can spot DBI/DBD version mismatch */
> DBIS->check_version = check_version;
> @@ -547,12 +549,6 @@ dbi_bootinit(dbistate_t * parent_dbis)
> DBIS->thr_owner = PERL_GET_THX;
> #endif
>
> - DBISTATE_INIT; /* check DBD code to set DBIS from DBISTATE_PERLNAME */
> -
> - if (DBIS_TRACE_LEVEL > 9) {
> - sv_dump(DBISTATE_ADDRSV);
> - }
> -
> /* store some function pointers so DBD's can call our functions */
> DBIS->getcom = dbih_getcom;
> DBIS->clearcom = dbih_clearcom;
> @@ -4346,6 +4342,9 @@ BOOT:
> (void)cv;
> (void)items; /* avoid 'unused variable' warning */
> dbi_bootinit(NULL);
> + /* make this sub into a fake XS so it can bee seen by DBD::* modules;
> + * never actually call it as an XS sub, or it will crash and burn! */
> + (void) newXS("DBI::_dbi_state_lval", (XSUBADDR_t)_dbi_state_lval,
> __FILE__);
>
>
> I32
> diff --git a/DBIXS.h b/DBIXS.h
> index 7502af8..22a18de 100644
> --- a/DBIXS.h
> +++ b/DBIXS.h
> @@ -467,8 +467,6 @@ struct dbistate_st {
> #define set_attr(h, k, v) set_attr_k(h, k, 0, v)
> #define get_attr(h, k) get_attr_k(h, k, 0)
>
> -#define DBISTATE_PERLNAME "DBI::_dbistate"
> -#define DBISTATE_ADDRSV (get_sv(DBISTATE_PERLNAME, 0x05))
> #define DBILOGFP (DBIS->logfp)
> #ifdef IN_DBI_XS
> #define DBILOGMSG (dbih_logmsg)
> @@ -476,28 +474,45 @@ struct dbistate_st {
> #define DBILOGMSG (DBIS->logmsg)
> #endif
>
> -
> /* --- perl object (ActiveState) / multiplicity hooks and hoops --- */
> /* note that USE_ITHREADS implies MULTIPLICITY */
> -#define DBIS_PUBLISHED_LVALUE (*(INT2PTR(dbistate_t**,
> &SvIVX(DBISTATE_ADDRSV))))
> +
> +typedef dbistate_t** (*_dbi_state_lval_t)(pTHX);
> +
> +# define _DBISTATE_DECLARE_COMMON \
> + static _dbi_state_lval_t dbi_state_lval_p = 0; \
> + static dbistate_t** dbi_get_state(pTHX) { \
> + if (!dbi_state_lval_p) { \
> + CV *cv = get_cv("DBI::_dbi_state_lval", 0); \
> + if (!cv) \
> + croak("Unable to get DBI state function. DBI not loaded."); \
> + dbi_state_lval_p = (_dbi_state_lval_t)CvXSUB(cv); \
> + } \
> + return dbi_state_lval_p(aTHX); \
> + } \
> + typedef int dummy_dbistate /* keep semicolon from feeling lonely */
> +
> #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
>
> -# define DBISTATE_DECLARE typedef int dummy_dbistate /* keep semicolon
> from feeling lonely */
> -# define DBISTATE_INIT_DBIS typedef int dummy_dbistate2; /* keep semicolon
> from feeling lonely */
> +# define DBISTATE_DECLARE _DBISTATE_DECLARE_COMMON
> +# define _DBISTATE_INIT_DBIS
> # undef DBIS
> -# define DBIS DBIS_PUBLISHED_LVALUE
> -# define dbis DBIS_PUBLISHED_LVALUE /* temp for old drivers using 'dbis'
> instead of 'DBIS' */
> +# define DBIS (*dbi_get_state(aTHX))
> +# define dbis DBIS /* temp for old drivers using 'dbis' instead of 'DBIS' */
>
> #else /* plain and simple non perl object / multiplicity case */
>
> -# define DBISTATE_DECLARE static dbistate_t *DBIS
> -# define DBISTATE_INIT_DBIS (DBIS = DBIS_PUBLISHED_LVALUE)
> +# define DBISTATE_DECLARE \
> + static dbistate_t *DBIS; \
> + _DBISTATE_DECLARE_COMMON
> +
> +# define _DBISTATE_INIT_DBIS DBIS = *dbi_get_state(aTHX);
> #endif
>
> # define DBISTATE_INIT { /* typically use in BOOT: of XS file */
> \
> - DBISTATE_INIT_DBIS; \
> + _DBISTATE_INIT_DBIS \
> if (DBIS == NULL) \
> - croak("Unable to get DBI state from %s at %p. DBI not loaded.",
> DBISTATE_PERLNAME, (void*)DBISTATE_ADDRSV); \
> + croak("Unable to get DBI state. DBI not loaded."); \
> DBIS->check_version(__FILE__, DBISTATE_VERSION, sizeof(*DBIS),
> NEED_DBIXS_VERSION, \
> sizeof(dbih_drc_t), sizeof(dbih_dbc_t), sizeof(dbih_stc_t),
> sizeof(dbih_fdc_t) \
> ); \
> --
> 1.7.4.4
>
