Author: timbo Date: Wed Apr 18 04:34:59 2012 New Revision: 15268 Modified: dbi/trunk/Changes dbi/trunk/DBI.pm dbi/trunk/DBI.xs dbi/trunk/DBIXS.h dbi/trunk/dbixs_rev.h
Log: Subject: [PATCH] under ithreads, make DBIS efficient for DBD::* From: David Mitchell <[email protected]> Date: Fri, 10 Feb 2012 13:11:13 +0000 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. Modified: dbi/trunk/Changes ============================================================================== --- dbi/trunk/Changes (original) +++ dbi/trunk/Changes Wed Apr 18 04:34:59 2012 @@ -6,9 +6,10 @@ =cut -=head2 Changes in DBI 1.619-TRIAL (svn r15202) 25rd February 2012 +=head2 Changes in DBI 1.619-TRIAL (svn r15202) Further method dispatch optimizations thanks to Dave Mitchell. + Optimized driver access to DBI internal state thanks to Dave Mitchell. Fixed the connected method to stop showing the password in trace file (Martin J. Evans). Modified: dbi/trunk/DBI.pm ============================================================================== --- dbi/trunk/DBI.pm (original) +++ dbi/trunk/DBI.pm Wed Apr 18 04:34:59 2012 @@ -519,10 +519,8 @@ 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"}; Modified: dbi/trunk/DBI.xs ============================================================================== --- dbi/trunk/DBI.xs (original) +++ dbi/trunk/DBI.xs Wed Apr 18 04:34:59 2012 @@ -127,8 +127,6 @@ 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 @@ 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 @@ 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 @@ 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 @@ (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 Modified: dbi/trunk/DBIXS.h ============================================================================== --- dbi/trunk/DBIXS.h (original) +++ dbi/trunk/DBIXS.h Wed Apr 18 04:34:59 2012 @@ -474,8 +474,6 @@ #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) @@ -483,28 +481,45 @@ #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) \ ); \ Modified: dbi/trunk/dbixs_rev.h ============================================================================== --- dbi/trunk/dbixs_rev.h (original) +++ dbi/trunk/dbixs_rev.h Wed Apr 18 04:34:59 2012 @@ -1,4 +1,3 @@ -/* Thu Feb 16 16:08:10 2012 */ -/* Mixed revision working copy (15150M:15164) */ +/* Wed Apr 18 12:26:25 2012 */ /* Code modified since last checkin */ -#define DBIXS_REVISION 15150 +#define DBIXS_REVISION 15267
