You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2013/11/01 01:31:21 UTC
svn commit: r1537777 - in /perl/modperl/branches/httpd24threading: ./
src/modules/perl/ xs/Apache2/Filter/
Author: stevehay
Date: Fri Nov 1 00:31:21 2013
New Revision: 1537777
URL: http://svn.apache.org/r1537777
Log:
Merged revision(s) 1243509 from perl/modperl/branches/threading:
Improve interpreter management
The goal of this change is to detect earlier cases when a perl interpreter
may be used by multiple threads simultaneously. This is done partly by
wrapping the interpreter allocation functions into preprocessor macros
to provide consistent trace messages and more important to reset aTHX to
NULL when the interpreter is put back.
Currently interpreter are pulled from the pool and set as context via
PERL_SET_CONTEXT. But when an interpreter is put back to the pool the
context is not reset to NULL. In an ideal world this should not be
necessary because the interpreter will not be used again. But for
debugging it's quite useful to put NULL in the perl context upon
putting back the interpreter. Thus, the program will segfault if the
thread wants to use an interpreter that already has been declared as
free.
That way a few errors where found and hopefully fixed:
* modperl_filter_f_cleanup() frees the perl-level filter context but was
called after the interpreter has already been put back.
* similar situation in request time config MERGE operations. They also
register a cleanup handler that uses the perl interpreter. But they
do not make sure that the interpreter is bound to the request at least
up to the time the cleanup is invoked.
Currently available macros include:
* MP_dINTERP
declares the variables aTHX (my_perl) and interp
* MP_INTERPa(r, c, s)
selects an interpreter via modperl_interp_select and assigns aTHX and
interp
* MP_dINTERPa(r, c, s)
combination of MP_dINTERP and MP_INTERPa
* MP_INTERP_POOLa(p, s)
like MP_INTERPa but calls modperl_interp_pool_select
* MP_dINTERP_POOLa(p, s)
combination of MP_dINTERP and MP_INTERP_POOLa
* MP_INTERP_PUTBACK(interp, thx)
puts the interpreter back via modperl_interp_unselect and assigns NULL
to aTHX
* MP_INTERP_REFCNT_inc(interp)
increments interp->refcnt
* MP_INTERP_REFCNT_dec(interp)
alias for MP_INTERP_PUTBACK(interp, NULL)
* MP_ASSERT_CONTEXT(thx)
checks for PERL_GET_CONTEXT==thx
The same set of macros/functions is now also used for pre-runtime stuff.
However, this part is not yet finished.
........
Modified:
perl/modperl/branches/httpd24threading/ (props changed)
perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c
perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h
Propchange: perl/modperl/branches/httpd24threading/
------------------------------------------------------------------------------
Merged /perl/modperl/branches/threading:r1243509
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c Fri Nov 1 00:31:21 2013
@@ -1040,22 +1040,13 @@ int modperl_response_handler(request_rec
{
MP_dDCFG;
apr_status_t retval, rc;
-
-#ifdef USE_ITHREADS
- pTHX;
- modperl_interp_t *interp;
-#endif
+ MP_dINTERP;
if (!strEQ(r->handler, "modperl")) {
return DECLINED;
}
-#ifdef USE_ITHREADS
- interp = modperl_interp_select(r, r->connection, r->server);
- MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- aTHX = interp->perl;
-#endif
+ MP_INTERPa(r, r->connection, r->server);
/* default is -SetupEnv, add if PerlOption +SetupEnv */
if (MpDirSETUP_ENV(dcfg)) {
@@ -1068,11 +1059,7 @@ int modperl_response_handler(request_rec
retval = rc;
}
-#ifdef USE_ITHREADS
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
return retval;
}
@@ -1083,21 +1070,13 @@ int modperl_response_handler_cgi(request
GV *h_stdin, *h_stdout;
apr_status_t retval, rc;
MP_dRCFG;
-#ifdef USE_ITHREADS
- pTHX;
- modperl_interp_t *interp;
-#endif
+ MP_dINTERP;
if (!strEQ(r->handler, "perl-script")) {
return DECLINED;
}
-#ifdef USE_ITHREADS
- interp = modperl_interp_select(r, r->connection, r->server);
- MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- aTHX = interp->perl;
-#endif
+ MP_INTERPa(r, r->connection, r->server);
modperl_perl_global_request_save(aTHX_ r);
@@ -1129,11 +1108,7 @@ int modperl_response_handler_cgi(request
modperl_io_restore_stdout(aTHX_ h_stdout);
FREETMPS;LEAVE;
-#ifdef USE_ITHREADS
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
/* flush output buffer after interpreter is putback */
rc = modperl_response_finish(r);
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c Fri Nov 1 00:31:21 2013
@@ -147,10 +147,7 @@ int modperl_callback_run_handlers(int id
apr_pool_t *ptemp,
modperl_hook_run_mode_e run_mode)
{
-#ifdef USE_ITHREADS
- pTHX;
- modperl_interp_t *interp = NULL;
-#endif
+ MP_dINTERP;
MP_dSCFG(s);
MP_dDCFG;
MP_dRCFG;
@@ -183,23 +180,7 @@ int modperl_callback_run_handlers(int id
return DECLINED;
}
-#ifdef USE_ITHREADS
- if (r || c) {
- interp = modperl_interp_select(r, c, s);
- MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- aTHX = interp->perl;
- /* if you ask why PERL_SET_CONTEXT is omitted here the answer is
- * it is done in modperl_interp_select
- */
- }
- else {
- /* Child{Init,Exit}, OpenLogs */
- aTHX = scfg->mip->parent->perl;
- PERL_SET_CONTEXT(aTHX);
- MP_THX_INTERP_SET(scfg->mip->parent->perl, scfg->mip->parent);
- }
-#endif
+ MP_INTERPa(r, c, s);
switch (type) {
case MP_HANDLER_TYPE_PER_SRV:
@@ -350,13 +331,7 @@ int modperl_callback_run_handlers(int id
SvREFCNT_dec((SV*)av_args);
-#ifdef USE_ITHREADS
- if (r || c) {
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
- }
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
return status;
}
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c Fri Nov 1 00:31:21 2013
@@ -375,23 +375,11 @@ apr_status_t modperl_config_req_cleanup(
{
request_rec *r = (request_rec *)data;
apr_status_t rc;
-
-#ifdef USE_ITHREADS
- pTHX;
- modperl_interp_t *interp = modperl_interp_select(r, NULL, r->server);
-
- MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- aTHX = interp->perl;
-#endif
+ MP_dINTERPa(r, NULL, NULL);
rc = modperl_config_request_cleanup(aTHX_ r);
-#ifdef USE_ITHREADS
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
return rc;
}
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c Fri Nov 1 00:31:21 2013
@@ -282,13 +282,14 @@ static apr_status_t modperl_filter_f_cle
/* mod_perl filter ctx cleanup */
if (ctx->data){
#ifdef USE_ITHREADS
- dTHXa(ctx->perl);
+ dTHXa(ctx->interp->perl);
+ MP_ASSERT_CONTEXT(aTHX);
#endif
if (SvOK(ctx->data) && SvREFCNT(ctx->data)) {
SvREFCNT_dec(ctx->data);
ctx->data = NULL;
}
- ctx->perl = NULL;
+ MP_INTERP_PUTBACK(ctx->interp, aTHX);
}
return APR_SUCCESS;
@@ -439,9 +440,8 @@ static int modperl_run_filter_init(ap_fi
server_rec *s = r ? r->server : c->base_server;
apr_pool_t *p = r ? r->pool : c->pool;
modperl_filter_t *filter = modperl_filter_new(f, NULL, mode, 0, 0, 0);
- MP_pINTERP;
- MP_dINTERP(r, c, s);
+ MP_dINTERPa(r, c, s);
MP_TRACE_h(MP_FUNC, "running filter init handler %s",
modperl_handler_name(handler));
@@ -465,7 +465,7 @@ static int modperl_run_filter_init(ap_fi
FILTER_FREE(filter);
SvREFCNT_dec((SV*)args);
- MP_INTERP_PUTBACK(interp);
+ MP_INTERP_PUTBACK(interp, aTHX);
MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT
"return: %d", modperl_handler_name(handler), status);
@@ -485,9 +485,8 @@ int modperl_run_filter(modperl_filter_t
conn_rec *c = filter->f->c;
server_rec *s = r ? r->server : c->base_server;
apr_pool_t *p = r ? r->pool : c->pool;
- MP_pINTERP;
- MP_dINTERP(r, c, s);
+ MP_dINTERPa(r, c, s);
MP_FILTER_SAVE_ERRSV(errsv);
@@ -557,7 +556,7 @@ int modperl_run_filter(modperl_filter_t
MP_FILTER_RESTORE_ERRSV(errsv);
- MP_INTERP_PUTBACK(interp);
+ MP_INTERP_PUTBACK(interp, aTHX);
MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT
"return: %d", modperl_handler_name(handler), status);
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c Fri Nov 1 00:31:21 2013
@@ -273,11 +273,10 @@ apr_status_t modperl_interp_unselect(voi
modperl_interp_t *interp = (modperl_interp_t *)data;
modperl_interp_pool_t *mip = interp->mip;
- if (interp == mip->parent) return APR_SUCCESS;
-
MP_ASSERT(interp && MpInterpIN_USE(interp));
- MP_TRACE_i(MP_FUNC, "unselect(interp=0x%lx): refcnt=%d",
- (unsigned long)interp, interp->refcnt);
+ MP_TRACE_i(MP_FUNC, "unselect(interp=%pp): refcnt=%d",
+ interp, interp->refcnt);
+
if (interp->refcnt != 0) {
--interp->refcnt;
MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d -- interp still in use",
@@ -285,15 +284,22 @@ apr_status_t modperl_interp_unselect(voi
return APR_SUCCESS;
}
- interp->ccfg->interp = NULL;
MpInterpIN_USE_Off(interp);
modperl_thx_interp_set(interp->perl, NULL);
+#ifdef MP_DEBUG
+ PERL_SET_CONTEXT(NULL);
+#endif
- modperl_tipool_putback_data(mip->tipool, data, interp->num_requests);
-
- MP_TRACE_i(MP_FUNC, "interp=0x%lx freed, tipool(size=%ld, in_use=%ld)",
- (unsigned long)interp, mip->tipool->size, mip->tipool->in_use);
+ if (interp == mip->parent) {
+ MP_TRACE_i(MP_FUNC, "parent interp=%pp freed", interp);
+ }
+ else {
+ interp->ccfg->interp = NULL;
+ modperl_tipool_putback_data(mip->tipool, data, interp->num_requests);
+ MP_TRACE_i(MP_FUNC, "interp=%pp freed, tipool(size=%ld, in_use=%ld)",
+ interp, mip->tipool->size, mip->tipool->in_use);
+ }
return APR_SUCCESS;
}
@@ -363,15 +369,17 @@ modperl_interp_t *modperl_interp_pool_se
interp = modperl_interp_get(s);
modperl_interp_pool_set(p, interp);
- MP_TRACE_i(MP_FUNC, "set interp 0x%lx in pconf pool 0x%lx",
- (unsigned long)interp, (unsigned long)p);
+ MP_TRACE_i(MP_FUNC, "set interp %pp in pconf pool %pp",
+ interp, p);
}
else {
- MP_TRACE_i(MP_FUNC, "found interp 0x%lx in pconf pool 0x%lx",
- (unsigned long)interp, (unsigned long)p);
+ MP_TRACE_i(MP_FUNC, "found interp %pp in pconf pool %pp",
+ interp, p);
}
}
+ MpInterpIN_USE_On(interp);
+ interp->refcnt++;
/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp->perl);
/* let the perl interpreter point back to its interp */
@@ -392,7 +400,7 @@ modperl_interp_t *modperl_interp_pool_se
modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
server_rec *s)
{
- MP_dSCFG((r ? s=r->server : s ? s : NULL));
+ MP_dSCFG((r ? s=r->server : c ? s=c->base_server : s));
MP_dDCFG;
modperl_config_con_t *ccfg;
const char *desc = NULL;
@@ -400,16 +408,27 @@ modperl_interp_t *modperl_interp_select(
apr_pool_t *p = NULL;
modperl_interp_scope_e scope;
- if (!modperl_threaded_mpm()) {
- MP_TRACE_i(MP_FUNC,
- "using parent 0x%pp (perl=0x%pp) non-threaded mpm (%s:%d)",
- scfg->mip->parent, scfg->mip->parent->perl,
- s->server_hostname, s->port);
+ /* What does the following condition mean?
+ * (r || c): if true we are at runtime. There is some kind of request
+ * being processed.
+ * threaded_mpm: self-explanatory
+ *
+ * Thus, it is true if we are either at initialization time or at runtime
+ * but with prefork-MPM. */
+ if (!((r || c) && modperl_threaded_mpm())) {
+ interp = scfg->mip->parent;
+ MpInterpIN_USE_On(interp);
+ interp->refcnt++;
/* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */
- PERL_SET_CONTEXT(scfg->mip->parent->perl);
+ PERL_SET_CONTEXT(interp->perl);
/* let the perl interpreter point back to its interp */
- MP_THX_INTERP_SET(scfg->mip->parent->perl, scfg->mip->parent);
- return scfg->mip->parent;
+ MP_THX_INTERP_SET(interp->perl, interp);
+
+ MP_TRACE_i(MP_FUNC,
+ "using parent 0x%pp (perl=0x%pp) for %s:%d refcnt set to %d",
+ interp, interp->perl, s->server_hostname, s->port,
+ interp->refcnt);
+ return interp;
}
if(!c) c = r->connection;
@@ -430,9 +449,9 @@ modperl_interp_t *modperl_interp_select(
}
MP_TRACE_i(MP_FUNC,
- "fetching interp for (%s:%d)", s->server_hostname, s->port);
+ "fetching interp for %s:%d", s->server_hostname, s->port);
interp = modperl_interp_get(s);
- MP_TRACE_i(MP_FUNC, " --> got %pp", interp);
+ MP_TRACE_i(MP_FUNC, " --> got %pp (perl=%pp)", interp, interp->perl);
++interp->num_requests; /* should only get here once per request */
interp->refcnt = 0;
@@ -447,8 +466,8 @@ modperl_interp_t *modperl_interp_select(
interp->ccfg = ccfg;
MP_TRACE_i(MP_FUNC,
- "pulled interp 0x%lx from mip, num_requests is %d",
- (unsigned long)interp, interp->num_requests);
+ "pulled interp %pp (perl=%pp) from mip, num_requests is %d",
+ interp, interp->perl, interp->num_requests);
/*
* if a per-dir PerlInterpScope is specified, use it.
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h Fri Nov 1 00:31:21 2013
@@ -51,51 +51,46 @@ modperl_interp_t *modperl_interp_pool_se
modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
server_rec *s);
-#define MP_pINTERP pTHX; modperl_interp_t *interp = NULL
+#define MP_dINTERP pTHX; modperl_interp_t *interp = NULL
-#define MP_dINTERP(r, c, s) \
- interp = modperl_interp_select(r, c, s); \
+#define MP_INTERPa(r, c, s) \
+ MP_TRACE_i(MP_FUNC, "selecting interp: r=%pp, c=%pp, s=%pp", \
+ (r), (c), (s)); \
+ interp = modperl_interp_select((r), (c), (s)); \
+ MP_TRACE_i(MP_FUNC, " --> got (0x%pp)->refcnt=%d, perl=%pp", \
+ interp, interp->refcnt, interp->perl); \
aTHX = interp->perl
-#ifdef MP_DEBUG
-#define MP_dINTERP_POOL(p, s) \
+#define MP_dINTERPa(r, c, s) \
+ MP_dINTERP; \
+ MP_INTERPa((r), (c), (s))
+
+#define MP_INTERP_POOLa(p, s) \
MP_TRACE_i(MP_FUNC, "selecting interp: p=%pp, s=%pp", (p), (s)); \
- interp = modperl_interp_pool_select(p, s); \
+ interp = modperl_interp_pool_select((p), (s)); \
MP_TRACE_i(MP_FUNC, " --> got (0x%pp)->refcnt=%d", \
interp, interp->refcnt); \
aTHX = interp->perl
-#else /* MP_DEBUG */
-#define MP_dINTERP_POOL(p, s) \
- interp = modperl_interp_pool_select(p, s); \
- aTHX = interp->perl
-#endif
+
+#define MP_dINTERP_POOLa(p, s) \
+ MP_dINTERP; \
+ MP_INTERP_POOLa((p), (s))
#ifdef MP_DEBUG
-#define MP_INTERP_PUTBACK(interp) \
+#define MP_INTERP_PUTBACK(interp, thx) \
MP_TRACE_i(MP_FUNC, "unselecting interp: (0x%pp)->refcnt=%ld", \
(interp), (interp)->refcnt); \
modperl_interp_unselect(interp); \
interp = NULL; \
- aTHX = NULL; \
- PERL_SET_CONTEXT(NULL)
+ if( thx ) thx = NULL
#else /* MP_DEBUG */
-#define MP_INTERP_PUTBACK(interp) \
+#define MP_INTERP_PUTBACK(interp, thx) \
modperl_interp_unselect(interp)
#endif
-# if 1
-/* ideally we should be able to reset interp and aTHX to NULL after
- * unselecting the interpreter. Unfortunately that does not work, yet */
-#undef MP_INTERP_PUTBACK
-#define MP_INTERP_PUTBACK(interp) \
- MP_TRACE_i(MP_FUNC, "unselecting interp: (0x%pp)->refcnt=%ld", \
- (interp), (interp)->refcnt); \
- modperl_interp_unselect(interp)
-# endif /* 0 */
-
#define MP_INTERP_REFCNT_inc(interp) (interp)->refcnt++
-#define MP_INTERP_REFCNT_dec(interp) MP_INTERP_PUTBACK(interp)
+#define MP_INTERP_REFCNT_dec(interp) MP_INTERP_PUTBACK(interp, NULL)
#define MP_aTHX aTHX
@@ -117,13 +112,17 @@ void modperl_interp_mip_walk_servers(Per
void *data);
#else
-#define MP_pINTERP dNOOP
+#define MP_dINTERP dNOOP
+
+#define MP_INTERPa(r, c, s) NOOP
+
+#define MP_dINTERPa(r, c, s) NOOP
-#define MP_dINTERP(r, c, s) NOOP
+#define MP_INTERP_POOLa(p, s) NOOP
-#define MP_dINTERP_POOL(p, s) NOOP
+#define MP_dINTERP_POOLa(p, s) NOOP
-#define MP_INTERP_PUTBACK(interp) NOOP
+#define MP_INTERP_PUTBACK(interp, thx) NOOP
#define MP_INTERP_REFCNT_inc(interp) NOOP
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c Fri Nov 1 00:31:21 2013
@@ -103,7 +103,9 @@ PTR_TBL_t *modperl_module_config_table_g
}
typedef struct {
- PerlInterpreter *perl;
+#ifdef USE_ITHREADS
+ modperl_interp_t *interp;
+#endif
PTR_TBL_t *table;
void *ptr;
} config_obj_cleanup_t;
@@ -116,15 +118,17 @@ static apr_status_t modperl_module_confi
{
config_obj_cleanup_t *cleanup =
(config_obj_cleanup_t *)data;
- dTHXa(cleanup->perl);
-
+#ifdef USE_ITHREADS
+ dTHXa(cleanup->interp->perl);
MP_ASSERT_CONTEXT(aTHX);
+#endif
modperl_svptr_table_delete(aTHX_ cleanup->table, cleanup->ptr);
- MP_TRACE_c(MP_FUNC, "deleting ptr 0x%lx from table 0x%lx",
- (unsigned long)cleanup->ptr,
- (unsigned long)cleanup->table);
+ MP_TRACE_c(MP_FUNC, "deleting ptr %pp from table %pp",
+ cleanup->ptr, cleanup->table);
+
+ MP_INTERP_PUTBACK(cleanup->interp, aTHX);
return APR_SUCCESS;
}
@@ -140,7 +144,8 @@ static void modperl_module_config_obj_cl
cleanup->table = table;
cleanup->ptr = ptr;
#ifdef USE_ITHREADS
- cleanup->perl = aTHX;
+ cleanup->interp = modperl_thx_interp_get(aTHX);
+ MP_INTERP_REFCNT_inc(cleanup->interp);
#endif
apr_pool_cleanup_register(p, cleanup,
@@ -168,7 +173,7 @@ static void *modperl_module_config_merge
int is_startup;
PTR_TBL_t *table;
SV *mrg_obj = (SV *)NULL, *base_obj, *add_obj;
- MP_pINTERP;
+ MP_dINTERP;
/* if the module is loaded in vhost, base==NULL */
tmp = (base && base->server) ? base : add;
@@ -181,14 +186,14 @@ static void *modperl_module_config_merge
s = tmp->server;
is_startup = (p == s->process->pconf);
- MP_dINTERP_POOL(p, s);
+ MP_INTERP_POOLa(p, s);
table = modperl_module_config_table_get(aTHX_ TRUE);
base_obj = modperl_svptr_table_fetch(aTHX_ table, base);
add_obj = modperl_svptr_table_fetch(aTHX_ table, add);
if (!base_obj || (base_obj == add_obj)) {
- MP_INTERP_PUTBACK(interp);
+ MP_INTERP_PUTBACK(interp, aTHX);
return addv;
}
@@ -235,10 +240,9 @@ static void *modperl_module_config_merge
if (!is_startup) {
modperl_module_config_obj_cleanup_register(aTHX_ p, table, mrg);
- /* MP_INTERP_REFCNT_inc(interp); */
}
- MP_INTERP_PUTBACK(interp);
+ MP_INTERP_PUTBACK(interp, aTHX);
return (void *)mrg;
}
@@ -353,10 +357,7 @@ static const char *modperl_module_cmd_ta
modperl_module_cfg_t *srv_cfg;
int modules_alias = 0;
-#ifdef USE_ITHREADS
- modperl_interp_t *interp = modperl_interp_pool_select(p, s);
- dTHXa(interp->perl);
-#endif
+ MP_dINTERP_POOLa(p, s);
int count;
PTR_TBL_t *table = modperl_module_config_table_get(aTHX_ TRUE);
@@ -405,11 +406,7 @@ static const char *modperl_module_cmd_ta
parms, &obj);
if (errmsg) {
-#ifdef USE_ITHREADS
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
return errmsg;
}
@@ -430,11 +427,7 @@ static const char *modperl_module_cmd_ta
minfo->srv_create,
parms, &srv_obj);
if (errmsg) {
-#ifdef USE_ITHREADS
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
return errmsg;
}
@@ -476,11 +469,7 @@ static const char *modperl_module_cmd_ta
retval = SvPVX(ERRSV);
}
-#ifdef USE_ITHREADS
- MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
- interp, interp->refcnt);
- modperl_interp_unselect(interp);
-#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
if (modules_alias) {
MP_dSCFG(s);
@@ -649,10 +638,7 @@ static const char *modperl_module_add_cm
command_rec *cmd;
AV *module_cmds;
I32 i, fill;
-#ifdef USE_ITHREADS
- MP_dSCFG(s);
- dTHXa(scfg->mip->parent->perl);
-#endif
+ MP_dINTERPa(NULL, NULL, s);
module_cmds = (AV*)SvRV(mod_cmds);
fill = AvFILL(module_cmds);
@@ -669,6 +655,7 @@ static const char *modperl_module_add_cm
cmd = apr_array_push(cmds);
if ((errmsg = modperl_module_cmd_fetch(aTHX_ obj, "name", &val))) {
+ MP_INTERP_PUTBACK(interp, aTHX);
return errmsg;
}
@@ -689,6 +676,7 @@ static const char *modperl_module_add_cm
}
if (!modperl_module_cmd_lookup(cmd)) {
+ MP_INTERP_PUTBACK(interp, aTHX);
return apr_psprintf(p,
"no command function defined for args_how=%d",
cmd->args_how);
@@ -741,6 +729,7 @@ static const char *modperl_module_add_cm
modp->cmds = (command_rec *)cmds->elts;
+ MP_INTERP_PUTBACK(interp, aTHX);
return NULL;
}
@@ -788,9 +777,7 @@ const char *modperl_module_add(apr_pool_
const char *name, SV *mod_cmds)
{
MP_dSCFG(s);
-#ifdef USE_ITHREADS
- dTHXa(scfg->mip->parent->perl);
-#endif
+ MP_dINTERPa(NULL, NULL, s);
const char *errmsg;
module *modp = (module *)apr_pcalloc(p, sizeof(*modp));
modperl_module_info_t *minfo =
@@ -832,6 +819,7 @@ const char *modperl_module_add(apr_pool_
modp->cmds = NULL;
if ((errmsg = modperl_module_add_cmds(p, s, modp, mod_cmds))) {
+ MP_INTERP_PUTBACK(interp, aTHX);
return errmsg;
}
@@ -866,6 +854,7 @@ const char *modperl_module_add(apr_pool_
}
#endif
+ MP_INTERP_PUTBACK(interp, aTHX);
return NULL;
}
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h Fri Nov 1 00:31:21 2013
@@ -243,7 +243,9 @@ typedef struct {
int sent_eos;
SV *data;
modperl_handler_t *handler;
- PerlInterpreter *perl;
+#ifdef USE_ITHREADS
+ modperl_interp_t *interp;
+#endif
} modperl_filter_ctx_t;
typedef struct {
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c Fri Nov 1 00:31:21 2013
@@ -836,6 +836,9 @@ typedef struct {
} modperl_cleanup_pnotes_data_t;
#endif
+/* XXX: This function was highly conflicted in threading vs. httpd24,
+ * so this manually merged version may not be correct.
+ */
static MP_INLINE
apr_status_t modperl_cleanup_pnotes(void *data) {
HV **pnotes = data;
@@ -844,6 +847,7 @@ apr_status_t modperl_cleanup_pnotes(void
#ifdef USE_ITHREADS
modperl_cleanup_pnotes_data_t *cleanup_data = data;
dTHXa(cleanup_data->perl);
+ MP_ASSERT_CONTEXT(aTHX);
pnotes = cleanup_data->pnotes;
#else
pnotes = data;
@@ -852,6 +856,9 @@ apr_status_t modperl_cleanup_pnotes(void
*pnotes = (HV *)NULL;
}
+#ifdef USE_ITHREADS
+ MP_INTERP_PUTBACK(cleanup_data, aTHX);
+#endif
return APR_SUCCESS;
}
Modified: perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h?rev=1537777&r1=1537776&r2=1537777&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h (original)
+++ perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h Fri Nov 1 00:31:21 2013
@@ -196,8 +196,9 @@ static MP_INLINE SV *mpxs_Apache2__Filte
}
#ifdef USE_ITHREADS
- if (!ctx->perl) {
- ctx->perl = aTHX;
+ if (!ctx->interp) {
+ ctx->interp = modperl_thx_interp_get(aTHX);
+ MP_INTERP_REFCNT_inc(ctx->interp);
}
#endif
ctx->data = SvREFCNT_inc(data);