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/10/31 15:26:10 UTC
svn commit: r1537504 - in /perl/modperl/branches/httpd24threading: ./
lib/ModPerl/ src/modules/perl/ xs/APR/Pool/
Author: stevehay
Date: Thu Oct 31 14:26:09 2013
New Revision: 1537504
URL: http://svn.apache.org/r1537504
Log:
Merged revision(s) 594601 from perl/modperl/branches/threading:
For threaded MPMs, change interpreter managment to a new, reference-counted
allocation model.
Reviewed-by: gozer
Submitted-By: Torsten Foertsch <to...@gmx.net>
Message-Id: <20...@gmx.net>
........
Modified:
perl/modperl/branches/httpd24threading/ (props changed)
perl/modperl/branches/httpd24threading/Changes
perl/modperl/branches/httpd24threading/lib/ModPerl/Code.pm
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_cmd.c
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.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/xs/APR/Pool/APR__Pool.h
Propchange: perl/modperl/branches/httpd24threading/
------------------------------------------------------------------------------
Merged /perl/modperl/branches/threading:r594601
Modified: perl/modperl/branches/httpd24threading/Changes
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/Changes?rev=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/Changes (original)
+++ perl/modperl/branches/httpd24threading/Changes Thu Oct 31 14:26:09 2013
@@ -12,6 +12,9 @@ Also refer to the Apache::Test changes l
=item 2.0.9-dev
+For threaded MPMs, change interpreter managment to a new, reference-counted
+allocation model. [Torsten Foertsch]
+
Expose modperl_interp_pool_t via ModPerl::InterpPool, modperl_tipool_t
via ModPerl::TiPool and modperl_tipool_config_t via ModPerl::TiPoolConfig
[Torsten Foertsch]
Modified: perl/modperl/branches/httpd24threading/lib/ModPerl/Code.pm
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/lib/ModPerl/Code.pm?rev=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/lib/ModPerl/Code.pm (original)
+++ perl/modperl/branches/httpd24threading/lib/ModPerl/Code.pm Thu Oct 31 14:26:09 2013
@@ -142,7 +142,7 @@ my %flags = (
Dir => [qw(NONE PARSE_HEADERS SETUP_ENV MERGE_HANDLERS GLOBAL_REQUEST UNSET)],
Req => [qw(NONE SET_GLOBAL_REQUEST PARSE_HEADERS SETUP_ENV
CLEANUP_REGISTERED PERL_SET_ENV_DIR PERL_SET_ENV_SRV)],
- Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
+ Interp => [qw(NONE IN_USE CLONED BASE)],
Handler => [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC FAKE)],
);
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c Thu Oct 31 14:26:09 2013
@@ -392,6 +392,7 @@ int modperl_init_vhost(server_rec *s, ap
}
PERL_SET_CONTEXT(perl);
+ MP_THX_INTERP_SET(perl, base_scfg->mip->parent);
#endif /* USE_ITHREADS */
@@ -467,6 +468,7 @@ void modperl_init(server_rec *base_serve
/* after other parent perls were started in vhosts, make sure that
* the context is set to the base_perl */
PERL_SET_CONTEXT(base_perl);
+ MP_THX_INTERP_SET(base_perl, base_scfg->mip->parent);
#endif
}
@@ -612,8 +614,6 @@ int modperl_hook_init(apr_pool_t *pconf,
return OK;
}
- MP_TRACE_i(MP_FUNC, "mod_perl hook init");
-
MP_init_status = 1; /* now starting */
modperl_restart_count_inc(s);
@@ -741,6 +741,14 @@ static int modperl_hook_create_request(r
{
MP_dRCFG;
+#ifdef USE_ITHREADS
+ if (modperl_threaded_mpm()) {
+ MP_TRACE_i(MP_FUNC, "setting userdata MODPERL_R in pool %#lx to %lx",
+ (unsigned long)r->pool, (unsigned long)r);
+ (void)apr_pool_userdata_set((void *)r, "MODPERL_R", NULL, r->pool);
+ }
+#endif
+
modperl_config_req_init(r, rcfg);
/* set the default for cgi header parsing On as early as possible
@@ -755,6 +763,12 @@ static int modperl_hook_create_request(r
static int modperl_hook_post_read_request(request_rec *r)
{
+#ifdef USE_ITHREADS
+ MP_TRACE_i(MP_FUNC, "%s %s:%d%s",
+ r->method, r->connection->local_addr->hostname,
+ r->connection->local_addr->port, r->unparsed_uri);
+#endif
+
/* if 'PerlOptions +GlobalRequest' is outside a container */
modperl_global_request_cfg_set(r);
@@ -1018,9 +1032,6 @@ static int modperl_response_handler_run(
int modperl_response_handler(request_rec *r)
{
MP_dDCFG;
-#ifdef USE_ITHREADS
- MP_dRCFG;
-#endif
apr_status_t retval, rc;
#ifdef USE_ITHREADS
@@ -1034,10 +1045,9 @@ int modperl_response_handler(request_rec
#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;
- if (MpInterpPUTBACK(interp)) {
- rcfg->interp = interp;
- }
#endif
/* default is -SetupEnv, add if PerlOption +SetupEnv */
@@ -1052,11 +1062,9 @@ int modperl_response_handler(request_rec
}
#ifdef USE_ITHREADS
- if (MpInterpPUTBACK(interp)) {
- /* PerlInterpScope handler */
- rcfg->interp = NULL;
- modperl_interp_unselect(interp);
- }
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
#endif
return retval;
@@ -1079,10 +1087,9 @@ int modperl_response_handler_cgi(request
#ifdef USE_ITHREADS
interp = modperl_interp_select(r, r->connection, r->server);
+ MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
aTHX = interp->perl;
- if (MpInterpPUTBACK(interp)) {
- rcfg->interp = interp;
- }
#endif
modperl_perl_global_request_save(aTHX_ r);
@@ -1116,11 +1123,9 @@ int modperl_response_handler_cgi(request
FREETMPS;LEAVE;
#ifdef USE_ITHREADS
- if (MpInterpPUTBACK(interp)) {
- /* PerlInterpScope handler */
- modperl_interp_unselect(interp);
- rcfg->interp = NULL;
- }
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
#endif
/* flush output buffer after interpreter is putback */
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c Thu Oct 31 14:26:09 2013
@@ -184,17 +184,20 @@ int modperl_callback_run_handlers(int id
}
#ifdef USE_ITHREADS
- if (r && !c && modperl_interp_scope_connection(scfg)) {
- c = r->connection;
- }
if (r || c) {
interp = modperl_interp_select(r, c, s);
+ MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld\n",
+ 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
@@ -355,8 +358,13 @@ int modperl_callback_run_handlers(int id
SvREFCNT_dec((SV*)av_args);
- /* PerlInterpScope handler */
- MP_INTERP_PUTBACK(interp);
+#ifdef USE_ITHREADS
+ if (r || c) {
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
+ }
+#endif
return status;
}
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_cmd.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_cmd.c?rev=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_cmd.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_cmd.c Thu Oct 31 14:26:09 2013
@@ -585,6 +585,9 @@ MP_CMD_SRV_DECLARE(perldo)
arg, NULL);
}
+ MP_TRACE_i(MP_FUNC, "using interp %lx to execute perl section:\n%s",
+ scfg->mip->parent, arg);
+
{
SV *server = MP_PERLSECTIONS_SERVER_SV;
SV *code = newSVpv(arg, 0);
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c Thu Oct 31 14:26:09 2013
@@ -374,9 +374,26 @@ apr_status_t modperl_config_request_clea
apr_status_t modperl_config_req_cleanup(void *data)
{
request_rec *r = (request_rec *)data;
- MP_dTHX;
+ apr_status_t rc;
- return modperl_config_request_cleanup(aTHX_ r);
+#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
+
+ 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
+
+ return rc;
}
void *modperl_get_perl_module_config(ap_conf_vector_t *cv)
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c Thu Oct 31 14:26:09 2013
@@ -61,7 +61,7 @@ modperl_interp_t *modperl_interp_new(mod
memset(interp, '\0', sizeof(*interp));
interp->mip = mip;
- interp->refcnt = 0; /* for use by APR::Pool->cleanup_register */
+ interp->refcnt = 0;
if (perl) {
#ifdef MP_USE_GTOP
@@ -268,33 +268,43 @@ void modperl_interp_init(server_rec *s,
scfg->mip = mip;
}
+#ifdef MP_TRACE
+static apr_status_t modperl_interp_pool_cleanup(void *data)
+{
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ data, ((modperl_interp_t*)data)->refcnt);
+
+ return modperl_interp_unselect(data);
+}
+#endif
+
apr_status_t modperl_interp_unselect(void *data)
{
modperl_interp_t *interp = (modperl_interp_t *)data;
modperl_interp_pool_t *mip = interp->mip;
+ if (interp == mip->parent) return APR_SUCCESS;
+
+ ap_assert(interp && MpInterpIN_USE(interp));
+ MP_TRACE_i(MP_FUNC, "unselect(interp=0x%lx): refcnt=%d\n",
+ (unsigned long)interp, interp->refcnt);
if (interp->refcnt != 0) {
--interp->refcnt;
- MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d",
+ MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d -- interp still in use",
(unsigned long)interp, interp->refcnt);
return APR_SUCCESS;
}
- if (interp->request) {
- /* ithreads + a threaded mpm + PerlInterpScope handler */
- request_rec *r = interp->request;
- MP_dRCFG;
- modperl_config_request_cleanup(interp->perl, r);
- MpReqCLEANUP_REGISTERED_Off(rcfg);
- }
-
+ interp->ccfg->interp = NULL;
MpInterpIN_USE_Off(interp);
- MpInterpPUTBACK_Off(interp);
modperl_thx_interp_set(interp->perl, NULL);
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)\n",
+ (unsigned long)interp, mip->tipool->size, mip->tipool->in_use);
+
return APR_SUCCESS;
}
@@ -321,13 +331,9 @@ modperl_interp_t *modperl_interp_pool_ge
}
void modperl_interp_pool_set(apr_pool_t *p,
- modperl_interp_t *interp,
- int cleanup)
+ modperl_interp_t *interp)
{
- /* same as get_interp but optional cleanup */
- (void)apr_pool_userdata_set((void *)interp, MP_INTERP_KEY,
- cleanup ? modperl_interp_unselect : NULL,
- p);
+ (void)apr_pool_userdata_set((void *)interp, MP_INTERP_KEY, NULL, p);
}
/*
@@ -342,53 +348,77 @@ modperl_interp_t *modperl_interp_pool_se
MP_dSCFG(s);
modperl_interp_t *interp = NULL;
- if (scfg && (is_startup || !modperl_threaded_mpm())) {
- MP_TRACE_i(MP_FUNC, "using parent interpreter at %s",
- is_startup ? "startup" : "request time (non-threaded MPM)");
-
- if (!scfg->mip) {
- /* we get here if directive handlers are invoked
- * before server merge.
- */
- modperl_init_vhost(s, p, NULL);
- if (!scfg->mip) {
- /* FIXME: We get here if global "server_rec" == s, scfg->mip
- * is not created then. I'm not sure if that's bug or
- * bad/good design decicision. For now just return NULL.
- */
- return NULL;
- }
- }
+ if (is_startup) {
+ if (scfg) {
+ MP_TRACE_i(MP_FUNC, "using parent interpreter at startup");
+
+ if (!scfg->mip) {
+ /* we get here if directive handlers are invoked
+ * before server merge.
+ */
+ modperl_init_vhost(s, p, NULL);
+ if (!scfg->mip) {
+ /* FIXME: We get here if global "server_rec" == s, scfg->mip
+ * is not created then. I'm not sure if that's bug or
+ * bad/good design decicision. For now just return NULL.
+ */
+ return NULL;
+ }
+ }
+
+ interp = scfg->mip->parent;
+ }
+ else {
+ if (!(interp = modperl_interp_pool_get(p))) {
+ 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);
+ }
+ else {
+ MP_TRACE_i(MP_FUNC, "found interp 0x%lx in pconf pool 0x%lx",
+ (unsigned long)interp, (unsigned long)p);
+ }
+ }
+
+ /* set context (THX) for this thread */
+ PERL_SET_CONTEXT(interp->perl);
+ /* let the perl interpreter point back to its interp */
+ MP_THX_INTERP_SET(interp->perl, interp);
+
+ return interp;
+ }
+ else if (!modperl_threaded_mpm()) {
+ MP_TRACE_i(MP_FUNC, "using parent interpreter in non-threaded mode");
+
+ /* since we are not running in threaded mode PERL_SET_CONTEXT
+ * is not necessary */
+ /* PERL_SET_CONTEXT(scfg->mip->parent->perl); */
+ /* let the perl interpreter point back to its interp */
+ MP_THX_INTERP_SET(scfg->mip->parent->perl, scfg->mip->parent);
- interp = scfg->mip->parent;
+ return scfg->mip->parent;
}
else {
- if (!(interp = modperl_interp_pool_get(p))) {
- interp = modperl_interp_get(s);
- modperl_interp_pool_set(p, interp, TRUE);
-
- MP_TRACE_i(MP_FUNC, "set interp in request time pool 0x%lx",
- (unsigned long)p);
- }
- else {
- MP_TRACE_i(MP_FUNC, "found interp in request time pool 0x%lx",
- (unsigned long)p);
- }
+ request_rec *r;
+ apr_pool_userdata_get((void **)&r, "MODPERL_R", p);
+ ap_assert(r);
+ MP_TRACE_i(MP_FUNC, "found userdata MODPERL_R in pool %#lx as %lx",
+ (unsigned long)r->pool, (unsigned long)r);
+ return modperl_interp_select(r, NULL, s);
}
-
- return interp;
}
modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
server_rec *s)
{
MP_dSCFG(s);
- MP_dRCFG;
- modperl_config_dir_t *dcfg = modperl_config_dir_get(r);
+ MP_dDCFG;
+ modperl_config_con_t *ccfg;
const char *desc = NULL;
modperl_interp_t *interp = NULL;
apr_pool_t *p = NULL;
- int is_subrequest = (r && r->main) ? 1 : 0;
modperl_interp_scope_e scope;
if (!modperl_threaded_mpm()) {
@@ -397,22 +427,47 @@ modperl_interp_t *modperl_interp_select(
(unsigned long)scfg->mip->parent,
s->server_hostname, s->port);
/* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */
- PERL_SET_CONTEXT(scfg->mip->parent->perl);
+ PERL_SET_CONTEXT(scfg->mip->parent->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;
}
- if (rcfg && rcfg->interp) {
- /* if scope is per-handler and something selected an interpreter
- * before modperl_callback_run_handlers() and is still holding it,
- * e.g. modperl_response_handler_cgi(), that interpreter will
- * be here
- */
+ if(!c) c = r->connection;
+ ccfg = modperl_config_con_get(c);
+
+ if (ccfg && ccfg->interp) {
+ ccfg->interp->refcnt++;
+
MP_TRACE_i(MP_FUNC,
- "found interp 0x%lx in request config\n",
- (unsigned long)rcfg->interp);
- return rcfg->interp;
+ "found interp 0x%lx in con config, refcnt incremented to %d\n",
+ (unsigned long)ccfg->interp, ccfg->interp->refcnt);
+ /* set context (THX) for this thread */
+ PERL_SET_CONTEXT(ccfg->interp->perl);
+ /* MP_THX_INTERP_SET is not called here because the interp
+ * already belongs to the perl interpreter
+ */
+ return ccfg->interp;
}
+ interp = modperl_interp_get(s ? s : r->server);
+ ++interp->num_requests; /* should only get here once per request */
+ interp->refcnt = 0;
+
+ /* set context (THX) for this thread */
+ PERL_SET_CONTEXT(interp->perl);
+ /* let the perl interpreter point back to its interp */
+ MP_THX_INTERP_SET(interp->perl, interp);
+
+ /* make sure ccfg is initialized */
+ modperl_config_con_init(c, ccfg);
+ ccfg->interp = interp;
+ interp->ccfg = ccfg;
+
+ MP_TRACE_i(MP_FUNC,
+ "pulled interp 0x%lx from mip, num_requests is %d\n",
+ (unsigned long)interp, interp->num_requests);
+
/*
* if a per-dir PerlInterpScope is specified, use it.
* else if r != NULL use per-server PerlInterpScope
@@ -426,102 +481,49 @@ modperl_interp_t *modperl_interp_select(
MP_TRACE_i(MP_FUNC, "scope is per-%s",
modperl_interp_scope_desc(scope));
- /*
- * XXX: goto modperl_interp_get() if scope == handler ?
- */
-
- if (c && (scope == MP_INTERP_SCOPE_CONNECTION)) {
- desc = "conn_rec pool";
- get_interp(c->pool);
-
- if (interp) {
- MP_TRACE_i(MP_FUNC,
- "found interp 0x%lx in %s 0x%lx\n",
- (unsigned long)interp, desc, (unsigned long)c->pool);
- return interp;
- }
-
- p = c->pool;
- }
- else if (r) {
- if (is_subrequest && (scope == MP_INTERP_SCOPE_REQUEST)) {
- /* share 1 interpreter across sub-requests */
- request_rec *main_r = r->main;
-
- while (main_r && !interp) {
- p = main_r->pool;
- get_interp(p);
- MP_TRACE_i(MP_FUNC,
- "looking for interp in main request for %s...%s\n",
- main_r->uri, interp ? "found" : "not found");
- main_r = main_r->main;
- }
- }
- else {
- p = r->pool;
- get_interp(p);
- }
-
- desc = "request_rec pool";
-
- if (interp) {
- MP_TRACE_i(MP_FUNC,
- "found interp 0x%lx in %s 0x%lx (%s request for %s)\n",
- (unsigned long)interp, desc, (unsigned long)p,
- (is_subrequest ? "sub" : "main"), r->uri);
- return interp;
- }
-
- /* might have already been set by a ConnectionHandler */
- get_interp(r->connection->pool);
-
- if (interp) {
- desc = "r->connection pool";
- MP_TRACE_i(MP_FUNC,
- "found interp 0x%lx in %s 0x%lx\n",
- (unsigned long)interp, desc,
- (unsigned long)r->connection->pool);
- return interp;
- }
- }
-
- interp = modperl_interp_get(s ? s : r->server);
- ++interp->num_requests; /* should only get here once per request */
-
- if (scope == MP_INTERP_SCOPE_HANDLER) {
- /* caller is responsible for calling modperl_interp_unselect() */
- interp->request = r;
- MpReqCLEANUP_REGISTERED_On(rcfg);
- MpInterpPUTBACK_On(interp);
- }
- else {
- if (!p) {
- /* should never happen */
- MP_TRACE_i(MP_FUNC, "no pool");
- return NULL;
- }
+ if (scope != MP_INTERP_SCOPE_HANDLER) {
+ desc = NULL;
+ if (c && (scope == MP_INTERP_SCOPE_CONNECTION || !r)) {
+ p = c->pool;
+ desc = "connection";
+ }
+ else if (r) {
+ request_rec *main_r = r->main;
+
+ if (main_r && (scope == MP_INTERP_SCOPE_REQUEST)) {
+ /* share 1 interpreter across sub-requests */
+ for(; main_r; main_r = main_r->main) {
+ p = main_r->pool;
+ }
+ desc = "main request";
+ }
+ else {
+ p = r->pool;
+ desc = scope == MP_INTERP_SCOPE_REQUEST
+ ? "main request"
+ : "sub request";
+ }
+ }
- set_interp(p);
+ ap_assert(p);
-#if AP_MODULE_MAGIC_AT_LEAST(20111130, 0)
- MP_TRACE_i(MP_FUNC,
- "set interp 0x%lx in %s 0x%lx (%s request for %s)\n",
- (unsigned long)interp, desc, (unsigned long)p,
- (r ? (is_subrequest ? "sub" : "main") : "conn"),
- (r ? r->uri : c->client_ip));
+#ifdef MP_TRACE
+ apr_pool_cleanup_register(p, (void *)interp,
+ modperl_interp_pool_cleanup,
+ modperl_interp_pool_cleanup);
#else
- MP_TRACE_i(MP_FUNC,
- "set interp 0x%lx in %s 0x%lx (%s request for %s)\n",
- (unsigned long)interp, desc, (unsigned long)p,
- (r ? (is_subrequest ? "sub" : "main") : "conn"),
- (r ? r->uri : c->remote_ip));
+ apr_pool_cleanup_register(p, (void *)interp,
+ modperl_interp_unselect,
+ modperl_interp_unselect);
#endif
- }
- /* set context (THX) for this thread */
- PERL_SET_CONTEXT(interp->perl);
+ /* add a reference for the registered cleanup */
+ interp->refcnt++;
- modperl_thx_interp_set(interp->perl, interp);
+ MP_TRACE_i(MP_FUNC,
+ "registered unselect cleanup for interp 0x%lx in %s\n",
+ (unsigned long)interp, desc);
+ }
return interp;
}
@@ -623,3 +625,9 @@ apr_status_t modperl_interp_cleanup(void
}
#endif /* USE_ITHREADS */
+
+/*
+ * Local Variables:
+ * c-basic-offset: 4
+ * End:
+ */
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h Thu Oct 31 14:26:09 2013
@@ -43,8 +43,7 @@ apr_status_t modperl_interp_unselect(voi
modperl_interp_t *modperl_interp_pool_get(apr_pool_t *p);
void modperl_interp_pool_set(apr_pool_t *p,
- modperl_interp_t *interp,
- int cleanup);
+ modperl_interp_t *interp);
modperl_interp_t *modperl_interp_pool_select(apr_pool_t *p,
server_rec *s);
@@ -59,7 +58,7 @@ modperl_interp_t *modperl_interp_select(
aTHX = interp->perl
#define MP_INTERP_PUTBACK(interp) \
- if (interp && MpInterpPUTBACK(interp)) { \
+ if (interp) { \
modperl_interp_unselect(interp); \
}
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c Thu Oct 31 14:26:09 2013
@@ -193,8 +193,9 @@ static void *modperl_module_config_merge
if (!base_obj || (base_obj == add_obj)) {
#ifdef USE_ITHREADS
- /* XXX: breaks prefork
- modperl_interp_unselect(interp); */
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
MP_PERL_CONTEXT_RESTORE;
#endif
return addv;
@@ -246,8 +247,9 @@ static void *modperl_module_config_merge
}
#ifdef USE_ITHREADS
- /* XXX: breaks prefork
- modperl_interp_unselect(interp); */
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
MP_PERL_CONTEXT_RESTORE;
#endif
@@ -416,6 +418,11 @@ static const char *modperl_module_cmd_ta
parms, &obj);
if (errmsg) {
+#ifdef USE_ITHREADS
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
+#endif
return errmsg;
}
@@ -436,6 +443,11 @@ 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\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
+#endif
return errmsg;
}
@@ -477,6 +489,12 @@ static const char *modperl_module_cmd_ta
retval = SvPVX(ERRSV);
}
+#ifdef USE_ITHREADS
+ MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
+#endif
+
if (modules_alias) {
MP_dSCFG(s);
/* unalias the temp aliasing */
@@ -855,7 +873,9 @@ const char *modperl_module_add(apr_pool_
*/
if (!modperl_interp_pool_get(p)) {
/* for vhosts */
- modperl_interp_pool_set(p, scfg->mip->parent, FALSE);
+ MP_TRACE_i(MP_FUNC, "set interp 0x%lx in pconf pool 0x%lx\n",
+ (unsigned long)scfg->mip->parent, (unsigned long)p);
+ modperl_interp_pool_set(p, scfg->mip->parent);
}
#endif
@@ -903,3 +923,9 @@ SV *modperl_module_config_get_obj(pTHX_
return obj;
}
+
+/*
+ * Local Variables:
+ * c-basic-offset: 4
+ * End:
+ */
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=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h Thu Oct 31 14:26:09 2013
@@ -52,13 +52,14 @@ struct modperl_list_t {
typedef struct modperl_interp_t modperl_interp_t;
typedef struct modperl_interp_pool_t modperl_interp_pool_t;
typedef struct modperl_tipool_t modperl_tipool_t;
+typedef struct modperl_config_con_t modperl_config_con_t;
struct modperl_interp_t {
modperl_interp_pool_t *mip;
PerlInterpreter *perl;
int num_requests;
U8 flags;
- request_rec *request;
+ modperl_config_con_t *ccfg;
int refcnt;
#ifdef MP_TRACE
unsigned long tid;
@@ -257,9 +258,12 @@ typedef struct {
#endif
} modperl_config_req_t;
-typedef struct {
+struct modperl_config_con_t {
HV *pnotes;
-} modperl_config_con_t;
+#ifdef USE_ITHREADS
+ modperl_interp_t *interp;
+#endif
+};
typedef struct {
apr_pool_t *pool;
Modified: perl/modperl/branches/httpd24threading/xs/APR/Pool/APR__Pool.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/xs/APR/Pool/APR__Pool.h?rev=1537504&r1=1537503&r2=1537504&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/xs/APR/Pool/APR__Pool.h (original)
+++ perl/modperl/branches/httpd24threading/xs/APR/Pool/APR__Pool.h Thu Oct 31 14:26:09 2013
@@ -77,6 +77,8 @@ APR_OPTIONAL_FN_TYPE(modperl_thx_interp_
* there are no more references, in which case \
* the interpreter will be putback into the mip \
*/ \
+ MP_TRACE_i(MP_FUNC, "DO: calling interp_unselect(0x%lx)", \
+ acct->interp); \
(void)modperl_opt_interp_unselect(acct->interp); \
} \
} STMT_END
@@ -100,6 +102,8 @@ APR_OPTIONAL_FN_TYPE(modperl_thx_interp_
if (modperl_opt_thx_interp_get) { \
if ((acct->interp = modperl_opt_thx_interp_get(aTHX))) { \
acct->interp->refcnt++; \
+ MP_TRACE_i(MP_FUNC, "TO: (0x%lx)->refcnt incremented to %ld", \
+ acct->interp, acct->interp->refcnt); \
} \
} \
} STMT_END
@@ -313,6 +317,7 @@ static apr_status_t mpxs_cleanup_run(voi
* there are no more references, in which case
* the interpreter will be putback into the mip
*/
+ MP_TRACE_i(MP_FUNC, "calling interp_unselect(0x%lx)", cdata->interp);
(void)modperl_opt_interp_unselect(cdata->interp);
}
#endif
@@ -344,6 +349,8 @@ static MP_INLINE void mpxs_apr_pool_clea
if (modperl_opt_thx_interp_get) {
if ((data->interp = modperl_opt_thx_interp_get(data->perl))) {
data->interp->refcnt++;
+ MP_TRACE_i(MP_FUNC, "(0x%lx)->refcnt incremented to %ld",
+ data->interp, data->interp->refcnt);
}
}
#endif