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 go...@apache.org on 2007/11/13 19:08:37 UTC
svn commit: r594601 - in /perl/modperl/branches/threading: ./ lib/ModPerl/
src/modules/perl/ xs/APR/Pool/
Author: gozer
Date: Tue Nov 13 10:08:34 2007
New Revision: 594601
URL: http://svn.apache.org/viewvc?rev=594601&view=rev
Log:
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/threading/Changes
perl/modperl/branches/threading/lib/ModPerl/Code.pm
perl/modperl/branches/threading/src/modules/perl/mod_perl.c
perl/modperl/branches/threading/src/modules/perl/modperl_callback.c
perl/modperl/branches/threading/src/modules/perl/modperl_cmd.c
perl/modperl/branches/threading/src/modules/perl/modperl_config.c
perl/modperl/branches/threading/src/modules/perl/modperl_interp.c
perl/modperl/branches/threading/src/modules/perl/modperl_interp.h
perl/modperl/branches/threading/src/modules/perl/modperl_module.c
perl/modperl/branches/threading/src/modules/perl/modperl_types.h
perl/modperl/branches/threading/xs/APR/Pool/APR__Pool.h
Modified: perl/modperl/branches/threading/Changes
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/Changes?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/Changes (original)
+++ perl/modperl/branches/threading/Changes Tue Nov 13 10:08:34 2007
@@ -12,6 +12,9 @@
=item 2.0.4-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/threading/lib/ModPerl/Code.pm
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/lib/ModPerl/Code.pm?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/lib/ModPerl/Code.pm (original)
+++ perl/modperl/branches/threading/lib/ModPerl/Code.pm Tue Nov 13 10:08:34 2007
@@ -142,7 +142,7 @@
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/threading/src/modules/perl/mod_perl.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/mod_perl.c?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/mod_perl.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/mod_perl.c Tue Nov 13 10:08:34 2007
@@ -392,6 +392,7 @@
}
PERL_SET_CONTEXT(perl);
+ MP_THX_INTERP_SET(perl, base_scfg->mip->parent);
#endif /* USE_ITHREADS */
@@ -467,6 +468,7 @@
/* 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 @@
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 +737,14 @@
{
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
@@ -751,6 +759,12 @@
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);
@@ -1015,7 +1029,6 @@
int modperl_response_handler(request_rec *r)
{
MP_dDCFG;
- MP_dRCFG;
apr_status_t retval;
#ifdef USE_ITHREADS
@@ -1029,10 +1042,9 @@
#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 */
@@ -1043,11 +1055,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",
+ interp, interp->refcnt);
+ modperl_interp_unselect(interp);
#endif
return retval;
@@ -1070,10 +1080,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 +1116,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 */
Modified: perl/modperl/branches/threading/src/modules/perl/modperl_callback.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_callback.c?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_callback.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_callback.c Tue Nov 13 10:08:34 2007
@@ -184,17 +184,20 @@
}
#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 @@
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/threading/src/modules/perl/modperl_cmd.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_cmd.c?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_cmd.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_cmd.c Tue Nov 13 10:08:34 2007
@@ -556,6 +556,9 @@
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/threading/src/modules/perl/modperl_config.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_config.c?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_config.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_config.c Tue Nov 13 10:08:34 2007
@@ -374,9 +374,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",
+ 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/threading/src/modules/perl/modperl_interp.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_interp.c?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_interp.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_interp.c Tue Nov 13 10:08:34 2007
@@ -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,70 @@
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 (!scfg->mip) {
- /* we get here if directive handlers are invoked
- * before server merge.
- */
- modperl_init_vhost(s, p, NULL);
- }
+ 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);
+ }
+
+ 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);
+ }
+ }
+
+ /* 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\n");
+
+ /* 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\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 +420,47 @@
(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
@@ -419,95 +474,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 (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 (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;
- }
+ 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;
-
- 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\n");
- return NULL;
- }
+#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
- set_interp(p);
+ /* add a reference for the registered cleanup */
+ interp->refcnt++;
- 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));
+ MP_TRACE_i(MP_FUNC,
+ "registered unselect cleanup for interp 0x%lx in %s\n",
+ (unsigned long)interp, desc);
}
- /* set context (THX) for this thread */
- PERL_SET_CONTEXT(interp->perl);
-
- MP_THX_INTERP_SET(interp->perl, interp);
-
return interp;
}
@@ -590,3 +600,9 @@
}
#endif /* USE_ITHREADS */
+
+/*
+ * Local Variables:
+ * c-basic-offset: 4
+ * End:
+ */
Modified: perl/modperl/branches/threading/src/modules/perl/modperl_interp.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_interp.h?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_interp.h (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_interp.h Tue Nov 13 10:08:34 2007
@@ -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); \
}
Modified: perl/modperl/branches/threading/src/modules/perl/modperl_module.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_module.c?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_module.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_module.c Tue Nov 13 10:08:34 2007
@@ -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:
+ */
Modified: perl/modperl/branches/threading/src/modules/perl/modperl_types.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_types.h?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_types.h (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_types.h Tue Nov 13 10:08:34 2007
@@ -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;
@@ -257,9 +258,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;
Modified: perl/modperl/branches/threading/xs/APR/Pool/APR__Pool.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/xs/APR/Pool/APR__Pool.h?rev=594601&r1=594600&r2=594601&view=diff
==============================================================================
--- perl/modperl/branches/threading/xs/APR/Pool/APR__Pool.h (original)
+++ perl/modperl/branches/threading/xs/APR/Pool/APR__Pool.h Tue Nov 13 10:08:34 2007
@@ -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)", \
+ 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", \
+ acct->interp, acct->interp->refcnt); \
} \
} STMT_END
@@ -152,7 +156,7 @@
apr_pool_t *parent_pool = mpxs_sv_object_deref(parent_pool_obj, apr_pool_t);
apr_pool_t *child_pool = NULL;
- MP_POOL_TRACE(MP_FUNC, "parent pool 0x%lx\n", (unsigned long)parent_pool);
+ MP_POOL_TRACE(MP_FUNC, "parent pool 0x%lx", (unsigned long)parent_pool);
(void)apr_pool_create(&child_pool, parent_pool);
#if APR_POOL_DEBUG
@@ -176,11 +180,11 @@
apr_pool_t *pp;
while ((pp = apr_pool_parent_get(p))) {
- MP_POOL_TRACE(MP_FUNC, "parent 0x%lx, child 0x%lx\n",
+ MP_POOL_TRACE(MP_FUNC, "parent 0x%lx, child 0x%lx",
(unsigned long)pp, (unsigned long)p);
if (apr_pool_is_ancestor(pp, p)) {
- MP_POOL_TRACE(MP_FUNC, "0x%lx is a subpool of 0x%lx\n",
+ MP_POOL_TRACE(MP_FUNC, "0x%lx is a subpool of 0x%lx",
(unsigned long)p, (unsigned long)pp);
}
p = pp;
@@ -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)", 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",
+ data->interp, data->interp->refcnt);
}
#endif