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 <[EMAIL PROTECTED]> Message-Id: <[EMAIL PROTECTED]> 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