Author: timbo
Date: Mon Feb 13 05:01:51 2012
New Revision: 15145
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
Log:
Significantly optimized DBI internals for threads (dPERINTERP -> MY_CXT) patch
from Dave Mitchell
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Mon Feb 13 05:01:51 2012
@@ -11,7 +11,9 @@
Fixed compiler warnings in Driver_xst.h (Martin J. Evans)
Fixed compiler warning in DBI.xs (H.Merijn Brand)
- Significantly optimized method dispatch (Dave Mitchell)
+ Significantly optimized method dispatch via cache (Dave Mitchell)
+ Significantly optimized DBI internals for threads (Dave Mitchell)
+ Xsub to xsub calling optimization now enabled for threaded perls.
Corrected typo in example in docs (David Precious)
Added note that calling clone() without an arg may warn in future.
Minor changes to the install_method() docs in DBI::DBD.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Mon Feb 13 05:01:51 2012
@@ -16,8 +16,6 @@
#include <sys/timeb.h>
# endif
-#define MY_VERSION "DBI(" XS_VERSION ")"
-
/* The XS dispatcher code can optimize calls to XS driver methods,
* bypassing the usual call_sv() and argument handling overheads.
* Just-in-case it causes problems there's an (undocumented) way
@@ -278,40 +276,24 @@
/* --- make DBI safe for multiple perl interpreters --- */
-/* Contributed by Murray Nesbitt of ActiveState */
-/* (This pre-dates, and should be replaced by, MY_CTX) */
+/* Originally contributed by Murray Nesbitt of ActiveState, */
+/* but later updated to use MY_CTX */
+
+#define MY_CXT_KEY "DBI::_guts" XS_VERSION
+
typedef struct {
SV *dbi_last_h; /* maybe better moved into dbistate_t? */
dbistate_t* dbi_state;
-} PERINTERP_t;
+} my_cxt_t;
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
-
-# define dPERINTERP_SV \
- SV *perinterp_sv = *hv_fetch(PL_modglobal, MY_VERSION, \
- sizeof(MY_VERSION)-1, TRUE)
-
-# define dPERINTERP_PTR(T,name) \
- T name = (perinterp_sv && SvIOK(perinterp_sv) \
- ? INT2PTR(T, SvIVX(perinterp_sv)) : (T)NULL)
-# define dPERINTERP \
- dPERINTERP_SV; dPERINTERP_PTR(PERINTERP_t *, PERINTERP)
-# define INIT_PERINTERP \
- dPERINTERP; \
- PERINTERP = malloc_using_sv(sizeof(PERINTERP_t)); \
- sv_setiv(perinterp_sv, PTR2IV(PERINTERP))
+START_MY_CXT
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
# undef DBIS
-# define DBIS (PERINTERP->dbi_state)
-
-#else
- static PERINTERP_t Interp;
-# define dPERINTERP typedef int _interp_DBI_dummy
-# define PERINTERP (&Interp)
-# define INIT_PERINTERP
+# define DBIS (MY_CXT.dbi_state)
#endif
-#define g_dbi_last_h (PERINTERP->dbi_last_h)
+#define g_dbi_last_h (MY_CXT.dbi_last_h)
/* --- */
@@ -493,7 +475,7 @@
int dbc_s, int stc_s, int fdc_s)
{
dTHX;
- dPERINTERP;
+ dMY_CXT;
static const char msg[] = "you probably need to rebuild the DBD driver (or
possibly the DBI)";
(void)need_dbixs_cv;
if (dbis_cv != DBISTATE_VERSION || dbis_cs != sizeof(*DBIS))
@@ -513,8 +495,8 @@
dbi_bootinit(dbistate_t * parent_dbis)
{
dTHX;
+ dMY_CXT;
dbistate_t* DBISx;
- INIT_PERINTERP;
DBISx = (struct dbistate_st*)malloc_using_sv(sizeof(struct dbistate_st));
@@ -608,7 +590,7 @@
neatsvpv(SV *sv, STRLEN maxlen) /* return a tidy ascii value, for debugging
only */
{
dTHX;
- dPERINTERP;
+ dMY_CXT;
STRLEN len;
SV *nsv = Nullsv;
SV *infosv = Nullsv;
@@ -907,7 +889,7 @@
static void
close_trace_file(pTHX)
{
- dPERINTERP;
+ dMY_CXT;
if (DBILOGFP == PerlIO_stderr() || DBILOGFP == PerlIO_stdout())
return;
@@ -924,7 +906,7 @@
set_trace_file(SV *file)
{
dTHX;
- dPERINTERP;
+ dMY_CXT;
const char *filename;
PerlIO *fp = Nullfp;
IO *io;
@@ -1053,7 +1035,7 @@
if (!what)
return NULL;
if (1) {
- dPERINTERP;
+ dMY_CXT;
if (DBIS_TRACE_LEVEL)
sv_dump(orv);
}
@@ -1114,7 +1096,7 @@
if (SvROK(hrv)) /* must at least be a ref */
sv = SvRV(hrv);
else {
- dPERINTERP;
+ dMY_CXT;
if (hrv == DBI_LAST_HANDLE) /* special for var::FETCH */
sv = DBI_LAST_HANDLE;
else if (sv_derived_from(hrv, "DBI::common")) {
@@ -1250,11 +1232,11 @@
trace_level = DBIc_TRACE_LEVEL(p_imp_xxh);
}
else {
- dPERINTERP;
+ dMY_CXT;
trace_level = DBIS_TRACE_LEVEL;
}
if (trace_level >= 5) {
- dPERINTERP;
+ dMY_CXT;
PerlIO_printf(DBILOGFP," dbih_make_com(%s, %p, %s, %ld, %p)
thr#%p\n",
neatsvpv(p_h,0), (void*)p_imp_xxh, imp_class, (long)imp_size,
(void*)imp_templ, (void*)PERL_GET_THX);
}
@@ -1302,7 +1284,7 @@
DBIc_DBISTATE(imp) = DBIc_DBISTATE(p_imp_xxh);
}
else {
- dPERINTERP;
+ dMY_CXT;
DBIc_DBISTATE(imp) = DBIS;
}
DBIc_IMP_STASH(imp) = imp_stash;
@@ -1366,13 +1348,13 @@
trace_level = DBIc_TRACE_LEVEL(parent_imp);
}
else {
- dPERINTERP;
+ dMY_CXT;
parent_imp = NULL;
trace_level = DBIS_TRACE_LEVEL;
}
if (trace_level >= 5) {
- dPERINTERP;
+ dMY_CXT;
PerlIO_printf(DBILOGFP," dbih_setup_handle(%s=>%s, %s, %lx, %s)\n",
neatsvpv(orv,0), neatsvpv(h,0), imp_class, (long)parent,
neatsvpv(imp_datasv,0));
}
@@ -1490,7 +1472,7 @@
SvRMAGICAL_on(SvRV(h)); /* so DBI magic gets sv_clear'd ok */
{
- dPERINTERP; /* XXX would be nice to get rid of this */
+ dMY_CXT; /* XXX would be nice to get rid of this */
DBI_SET_LAST_HANDLE(h);
}
@@ -1528,7 +1510,7 @@
static int
dbih_dumpcom(pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level)
{
- dPERINTERP;
+ dMY_CXT;
SV *flags = sv_2mortal(newSVpv("",0));
SV *inner;
static const char pad[] = " ";
@@ -3101,7 +3083,7 @@
XS(XS_DBI_dispatch)
{
dXSARGS;
- dPERINTERP;
+ dMY_CXT;
SV *h = ST(0); /* the DBI handle we are working with */
SV *st1 = ST(1); /* used in debugging */
@@ -4299,6 +4281,8 @@
BOOT:
(void)cv;
(void)items; /* avoid 'unused variable' warning */
+ MY_CXT_INIT;
+ (void)MY_CXT; /* avoid 'unused variable' warning */
dbi_bootinit(NULL);
@@ -4399,9 +4383,14 @@
void
_clone_dbis()
CODE:
- dPERINTERP;
+ dMY_CXT;
+ dbistate_t * parent_dbis = DBIS;
+
(void)cv;
- dbi_bootinit(DBIS);
+ {
+ MY_CXT_CLONE;
+ }
+ dbi_bootinit(parent_dbis);
void
@@ -4412,7 +4401,7 @@
SV * imp_datasv
SV * imp_class
PPCODE:
- dPERINTERP;
+ dMY_CXT;
HV *outer;
SV *outer_ref;
HV *class_stash = gv_stashsv(class, GV_ADDWARN);
@@ -4525,7 +4514,7 @@
SV * attribs
CODE:
{
- dPERINTERP;
+ dMY_CXT;
/* install another method name/interface for the DBI dispatcher */
SV *trace_msg = (DBIS_TRACE_LEVEL >= 10) ? sv_2mortal(newSVpv("",0)) :
Nullsv;
CV *cv;
@@ -4586,7 +4575,7 @@
_debug_dispatch = 1
CODE:
{
- dPERINTERP;
+ dMY_CXT;
IV level;
if (!DBIS) {
ix=ix; /* avoid 'unused variable' warnings */
@@ -4642,7 +4631,7 @@
SV * sv
CODE:
{
- dPERINTERP;
+ dMY_CXT;
(void)cv;
PerlIO_printf(DBILOGFP, "DBI::_svdump(%s)", neatsvpv(sv,0));
#ifdef DEBUGGING
@@ -4770,7 +4759,7 @@
FETCH(sv)
SV * sv
CODE:
- dPERINTERP;
+ dMY_CXT;
/* Note that we do not come through the dispatcher to get here. */
char *meth = SvPV_nolen(SvRV(sv)); /* what should this tie do ? */
char type = *meth++; /* is this a $ or & style */
@@ -5390,7 +5379,7 @@
PerlIO *pio;
CODE:
{
- dPERINTERP;
+ dMY_CXT;
(void)cv;
if (SvROK(sv)) {
D_imp_xxh(sv);
