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

Reply via email to