Hi Gozer, this patch is a complete rework of the interpreter allocation. I have tested it with apache 2.2.6 with prefork and worker MPM but only with a perl 5.8.8 that has defined USE_ITHREADS. The rest of this text concerns only the worker MPM.
The main idea behind the patch is to eliminate hash lookups as much as
possible while selecting an interpreter.
In previous versions of mod_perl the interpreter currently in use was saved as
userdata in a request or connection pool according to PerlInterpScope or in
the rcfg structure if scope==handler. This means each phase does a hash
lookup in the pool's userdata to get the interpreter.
This is now eliminated. The current interpreter is saved in the ccfg
structure. modperl_interp_select has only to there once to discover whether a
new interpreter needs to be allocated or there is one that can be used.
However, there is one case where I could not eliminate the hash lookup.
modperl_module_cmd_take123 and modperl_module_config_merge don't work on a
request_rec or conn_rec but only on a pool. While at startup time this pool
is pconf at request time it is allways the request pool. So in
modperl_hook_create_request I put a pointer to the request_rec as userdata in
the request pool just in case a custom configuration directive is used
somewhere in the request cycle. This is certainly not an ideal solution. So,
if someone know of a way to convert a request pool into the corresponding
request_rec please let me know. So modperl_interp_pool_select called at
request time does a hash lookup to fetch the request_rec pointer and then
calls modperl_interp_select.
The lifetime of an interpreter is now completely controlled by its refcnt. If
it is unselected with a refcnt==0 it is put back into the pool. Otherwise the
refcnt is simply decremented. The selection process is also quite simple. If
ccfg->interp is not NULL it means there is already an interpreter assigned to
this connection. If it is NULL a new interpreter is pulled from the pool and
put in ccfg->interp. At this stage its refcnt is 0. Now PerlInterpScope is
consulted to decide what to do. For scope==handler nothing is done. For
scope==request a pool cleanup that calls modperl_interp_unselect is
registered with the main request pool and the refcnt is incremented. For
scope==subrequest or scope==connection a the cleanup function is registered
with the appropriate pool.
This has a few consequences. Mainly, the first time an interpreter is needed
decides about its scope. If a URI translation handler needs an interpreter
and the server wide scope is request the interpreter is locked for the whole
request time even if a subsequent <Location> says otherwise. Further, once an
interpreter is allocated for a request, subrequest or connection it is used
in all cases that need one. That means a <Location> that sets scope==handler
will not acquire a new one but use the one already assigned to the request.
A word about cleanup functions. In previous versions in case of scope==handler
a PerlCleanupHandler was called every time the interpreter was unselected.
But it has never really worked and it somehow contradicts with the docs that
say "It is used to execute some code immediately after the request has been
served (the client went away) and before the request object is destroyed."
The patched modperl behaves according to the docs in that a PerlCleanupHandler
is called at the end of a request even with scope==handler. That means also
that as with each other phase with scope==handler a PerlCleanupHandler is not
guaranteed to be called with a specific (previously used) interpreter.
However, there are ways to extend the lifetime of an interpreter from perl
level. A new pool adds a reference to the current interpreter. So even with
scope==handler one can say:
sub fixup {
$_[0]->pnotes->{lock_interpreter}=APR::Pool->new;
$_[0]->push_handlers(PerlCleanupHandler=>sub {
delete $_[0]->pnotes->{lock_interpreter};
return Apache2::Const::DECLINED;
});
return Apache2::Const::DECLINED;
}
This guarantees the same interpreter from fixup to cleanup. Do not use
$r->pool->new in this case. It creates a sub-pool of the request pool which
is destroyed before the PerlCleanupHandler is called.
Also, a pool cleanup function locks the interpreter until the pool is
destroyed. So avoid $r->pool->cleanup_register if scope==handler is what you
want.
I think the patch is fairly complete regarding interpreter
allocation/deallocation. It may have flaws with other resources. For example
I think pnotes need to be dropped whenever an interpreter is freed. I still
have to check that.
Also, there are calls to PERL_SET_CONTEXT(aTHX) throughout the code. Since I
do not really know what they are for I cannot say if there are some missing.
Please review the patch.
Thanks,
Torsten
Index: src/modules/perl/modperl_module.c
===================================================================
--- src/modules/perl/modperl_module.c (revision 578102)
+++ src/modules/perl/modperl_module.c (working copy)
@@ -193,8 +193,9 @@
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 @@
}
#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 @@
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 @@
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 @@
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 */
@@ -863,7 +881,9 @@
*/
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
@@ -911,3 +931,9 @@
return obj;
}
+
+/*
+ * Local Variables:
+ * c-basic-offset: 4
+ * End:
+ */
Index: src/modules/perl/modperl_common_log.c
===================================================================
--- src/modules/perl/modperl_common_log.c (revision 578102)
+++ src/modules/perl/modperl_common_log.c (working copy)
@@ -49,7 +49,7 @@
}
if (func) {
- apr_file_printf(logfile, "%s: ", func);
+ apr_file_printf(logfile, "%d: %s: ", getpid(), func);
}
va_start(args, fmt);
Index: src/modules/perl/mod_perl.c
===================================================================
--- src/modules/perl/mod_perl.c (revision 578102)
+++ src/modules/perl/mod_perl.c (working copy)
@@ -612,8 +612,6 @@
return OK;
}
- MP_TRACE_i(MP_FUNC, "mod_perl hook init\n");
-
MP_init_status = 1; /* now starting */
modperl_restart_count_inc(s);
@@ -737,6 +735,14 @@
{
MP_dRCFG;
+#ifdef USE_ITHREADS
+ if (modperl_threaded_mpm()) {
+ MP_TRACE_i(MP_FUNC, "setting userdata MODPERL_R in pool %#lx to %lx\n",
+ (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
@@ -751,6 +757,12 @@
static int modperl_hook_post_read_request(request_rec *r)
{
+#ifdef USE_ITHREADS
+ MP_TRACE_i(MP_FUNC, "%s %s:%d%s\n",
+ 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);
@@ -1015,7 +1027,6 @@
int modperl_response_handler(request_rec *r)
{
MP_dDCFG;
- MP_dRCFG;
apr_status_t retval;
#ifdef USE_ITHREADS
@@ -1029,10 +1040,9 @@
#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
/* default is -SetupEnv, add if PerlOption +SetupEnv */
@@ -1043,11 +1053,9 @@
retval = modperl_response_handler_run(r, TRUE);
#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\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
#endif
return retval;
@@ -1070,10 +1078,9 @@
#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);
@@ -1107,11 +1114,9 @@
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 */
Index: src/modules/perl/modperl_callback.c
===================================================================
--- src/modules/perl/modperl_callback.c (revision 578102)
+++ src/modules/perl/modperl_callback.c (working copy)
@@ -185,11 +185,10 @@
}
#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;
}
else {
@@ -357,8 +356,13 @@
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;
}
Index: src/modules/perl/modperl_interp.c
===================================================================
--- src/modules/perl/modperl_interp.c (revision 578102)
+++ src/modules/perl/modperl_interp.c (working copy)
@@ -61,7 +61,7 @@
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 @@
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\n",
+ MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d -- interp still in use\n",
(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);
MP_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 @@
}
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,46 +348,58 @@
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\n",
- is_startup ? "startup" : "request time (non-threaded MPM)");
+ if (is_startup) {
+ if (scfg) {
+ MP_TRACE_i(MP_FUNC, "using parent interpreter at startup\n");
- if (!scfg->mip) {
- /* we get here if directive handlers are invoked
- * before server merge.
- */
- modperl_init_vhost(s, p, NULL);
- }
+ if (!scfg->mip) {
+ /* we get here if directive handlers are invoked
+ * before server merge.
+ */
+ modperl_init_vhost(s, p, NULL);
+ }
- interp = scfg->mip->parent;
+ 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\n",
+ (unsigned long)interp, (unsigned long)p);
+ }
+ else {
+ MP_TRACE_i(MP_FUNC, "found interp 0x%lx in pconf pool 0x%lx\n",
+ (unsigned long)interp, (unsigned long)p);
+ }
+ }
+
+ return interp;
}
+ else if (!modperl_threaded_mpm()) {
+ MP_TRACE_i(MP_FUNC, "using parent interpreter in non-threaded mode\n");
+ 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\n",
- (unsigned long)p);
- }
- else {
- MP_TRACE_i(MP_FUNC, "found interp in request time pool 0x%lx\n",
- (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\n",
+ (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()) {
@@ -390,22 +408,35 @@
(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);
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);
+ return ccfg->interp;
}
+ interp = modperl_interp_get(s ? s : r->server);
+ ++interp->num_requests; /* should only get here once per request */
+ interp->refcnt = 0;
+
+ /* 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
@@ -419,90 +450,50 @@
MP_TRACE_i(MP_FUNC, "scope is per-%s\n",
modperl_interp_scope_desc(scope));
- /*
- * XXX: goto modperl_interp_get() if scope == handler ?
- */
+ 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 (c && (scope == MP_INTERP_SCOPE_CONNECTION)) {
- desc = "conn_rec pool";
- get_interp(c->pool);
+ 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";
+ }
+ }
- 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;
- }
+ ap_assert(p);
- 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;
+#ifdef MP_TRACE
+ apr_pool_cleanup_register(p, (void *)interp,
+ modperl_interp_pool_cleanup,
+ modperl_interp_pool_cleanup);
+#else
+ apr_pool_cleanup_register(p, (void *)interp,
+ modperl_interp_unselect,
+ modperl_interp_unselect);
+#endif
- 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);
- }
+ /* add a reference for the registered cleanup */
+ interp->refcnt++;
- 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;
- }
+ MP_TRACE_i(MP_FUNC,
+ "registered unselect cleanup for interp 0x%lx in %s\n",
+ (unsigned long)interp, desc);
}
- 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\n");
- return NULL;
- }
-
- set_interp(p);
-
- 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));
- }
-
/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp->perl);
@@ -590,3 +581,9 @@
}
#endif /* USE_ITHREADS */
+
+/*
+ * Local Variables:
+ * c-basic-offset: 4
+ * End:
+ */
Index: src/modules/perl/modperl_config.c
===================================================================
--- src/modules/perl/modperl_config.c (revision 578102)
+++ src/modules/perl/modperl_config.c (working copy)
@@ -379,9 +379,26 @@
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\n",
+ 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\n",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
+#endif
+
+ return rc;
}
void *modperl_get_perl_module_config(ap_conf_vector_t *cv)
Index: src/modules/perl/modperl_interp.h
===================================================================
--- src/modules/perl/modperl_interp.h (revision 578102)
+++ src/modules/perl/modperl_interp.h (working copy)
@@ -77,8 +77,7 @@
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);
@@ -93,7 +92,7 @@
aTHX = interp->perl
#define MP_INTERP_PUTBACK(interp) \
- if (interp && MpInterpPUTBACK(interp)) { \
+ if (interp) { \
modperl_interp_unselect(interp); \
}
Index: src/modules/perl/modperl_types.h
===================================================================
--- src/modules/perl/modperl_types.h (revision 578102)
+++ src/modules/perl/modperl_types.h (working copy)
@@ -52,13 +52,14 @@
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;
@@ -258,9 +259,12 @@
#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;
Index: src/modules/perl/modperl_cmd.c
===================================================================
--- src/modules/perl/modperl_cmd.c (revision 578102)
+++ src/modules/perl/modperl_cmd.c (working copy)
@@ -558,6 +558,9 @@
arg, NULL);
}
+ MP_TRACE_i(MP_FUNC, "using interp %lx to execute perl section:\n%s\n",
+ scfg->mip->parent, arg);
+
{
SV *server = MP_PERLSECTIONS_SERVER_SV;
SV *code = newSVpv(arg, 0);
Index: xs/APR/Pool/APR__Pool.h
===================================================================
--- xs/APR/Pool/APR__Pool.h (revision 578102)
+++ xs/APR/Pool/APR__Pool.h (working copy)
@@ -75,6 +75,8 @@
* 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)\n", \
+ acct->interp); \
(void)modperl_opt_interp_unselect(acct->interp); \
} \
} STMT_END
@@ -97,6 +99,8 @@
*/ \
if ((acct->interp = MP_THX_INTERP_GET(aTHX))) { \
acct->interp->refcnt++; \
+ MP_TRACE_i(MP_FUNC, "TO: (0x%lx)->refcnt incremented to %ld\n", \
+ acct->interp, acct->interp->refcnt); \
} \
} STMT_END
@@ -303,6 +307,7 @@
* 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)\n", cdata->interp);
(void)modperl_opt_interp_unselect(cdata->interp);
}
#endif
@@ -337,6 +342,8 @@
*/
if ((data->interp = MP_THX_INTERP_GET(data->perl))) {
data->interp->refcnt++;
+ MP_TRACE_i(MP_FUNC, "(0x%lx)->refcnt incremented to %ld\n",
+ data->interp, data->interp->refcnt);
}
#endif
pgp1EHPG2EqQ5.pgp
Description: PGP signature
