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 <torsten.foert...@gmx.net> Message-Id: <200710232035.27943.torsten.foert...@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