Author: stevehay Date: Fri Nov 1 00:31:21 2013 New Revision: 1537777 URL: http://svn.apache.org/r1537777 Log: Merged revision(s) 1243509 from perl/modperl/branches/threading: Improve interpreter management
The goal of this change is to detect earlier cases when a perl interpreter may be used by multiple threads simultaneously. This is done partly by wrapping the interpreter allocation functions into preprocessor macros to provide consistent trace messages and more important to reset aTHX to NULL when the interpreter is put back. Currently interpreter are pulled from the pool and set as context via PERL_SET_CONTEXT. But when an interpreter is put back to the pool the context is not reset to NULL. In an ideal world this should not be necessary because the interpreter will not be used again. But for debugging it's quite useful to put NULL in the perl context upon putting back the interpreter. Thus, the program will segfault if the thread wants to use an interpreter that already has been declared as free. That way a few errors where found and hopefully fixed: * modperl_filter_f_cleanup() frees the perl-level filter context but was called after the interpreter has already been put back. * similar situation in request time config MERGE operations. They also register a cleanup handler that uses the perl interpreter. But they do not make sure that the interpreter is bound to the request at least up to the time the cleanup is invoked. Currently available macros include: * MP_dINTERP declares the variables aTHX (my_perl) and interp * MP_INTERPa(r, c, s) selects an interpreter via modperl_interp_select and assigns aTHX and interp * MP_dINTERPa(r, c, s) combination of MP_dINTERP and MP_INTERPa * MP_INTERP_POOLa(p, s) like MP_INTERPa but calls modperl_interp_pool_select * MP_dINTERP_POOLa(p, s) combination of MP_dINTERP and MP_INTERP_POOLa * MP_INTERP_PUTBACK(interp, thx) puts the interpreter back via modperl_interp_unselect and assigns NULL to aTHX * MP_INTERP_REFCNT_inc(interp) increments interp->refcnt * MP_INTERP_REFCNT_dec(interp) alias for MP_INTERP_PUTBACK(interp, NULL) * MP_ASSERT_CONTEXT(thx) checks for PERL_GET_CONTEXT==thx The same set of macros/functions is now also used for pre-runtime stuff. However, this part is not yet finished. ........ Modified: perl/modperl/branches/httpd24threading/ (props changed) 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_config.c perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.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/src/modules/perl/modperl_util.c perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h Propchange: perl/modperl/branches/httpd24threading/ ------------------------------------------------------------------------------ Merged /perl/modperl/branches/threading:r1243509 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/mod_perl.c Fri Nov 1 00:31:21 2013 @@ -1040,22 +1040,13 @@ int modperl_response_handler(request_rec { MP_dDCFG; apr_status_t retval, rc; - -#ifdef USE_ITHREADS - pTHX; - modperl_interp_t *interp; -#endif + MP_dINTERP; if (!strEQ(r->handler, "modperl")) { return DECLINED; } -#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; -#endif + MP_INTERPa(r, r->connection, r->server); /* default is -SetupEnv, add if PerlOption +SetupEnv */ if (MpDirSETUP_ENV(dcfg)) { @@ -1068,11 +1059,7 @@ int modperl_response_handler(request_rec retval = rc; } -#ifdef USE_ITHREADS - MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld", - interp, interp->refcnt); - modperl_interp_unselect(interp); -#endif + MP_INTERP_PUTBACK(interp, aTHX); return retval; } @@ -1083,21 +1070,13 @@ int modperl_response_handler_cgi(request GV *h_stdin, *h_stdout; apr_status_t retval, rc; MP_dRCFG; -#ifdef USE_ITHREADS - pTHX; - modperl_interp_t *interp; -#endif + MP_dINTERP; if (!strEQ(r->handler, "perl-script")) { return DECLINED; } -#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; -#endif + MP_INTERPa(r, r->connection, r->server); modperl_perl_global_request_save(aTHX_ r); @@ -1129,11 +1108,7 @@ int modperl_response_handler_cgi(request modperl_io_restore_stdout(aTHX_ h_stdout); FREETMPS;LEAVE; -#ifdef USE_ITHREADS - MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld", - interp, interp->refcnt); - modperl_interp_unselect(interp); -#endif + MP_INTERP_PUTBACK(interp, aTHX); /* flush output buffer after interpreter is putback */ rc = modperl_response_finish(r); 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_callback.c Fri Nov 1 00:31:21 2013 @@ -147,10 +147,7 @@ int modperl_callback_run_handlers(int id apr_pool_t *ptemp, modperl_hook_run_mode_e run_mode) { -#ifdef USE_ITHREADS - pTHX; - modperl_interp_t *interp = NULL; -#endif + MP_dINTERP; MP_dSCFG(s); MP_dDCFG; MP_dRCFG; @@ -183,23 +180,7 @@ int modperl_callback_run_handlers(int id return DECLINED; } -#ifdef USE_ITHREADS - if (r || c) { - interp = modperl_interp_select(r, c, s); - MP_TRACE_i(MP_FUNC, "just selected: (0x%lx)->refcnt=%ld", - 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 + MP_INTERPa(r, c, s); switch (type) { case MP_HANDLER_TYPE_PER_SRV: @@ -350,13 +331,7 @@ int modperl_callback_run_handlers(int id SvREFCNT_dec((SV*)av_args); -#ifdef USE_ITHREADS - if (r || c) { - MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld", - interp, interp->refcnt); - modperl_interp_unselect(interp); - } -#endif + MP_INTERP_PUTBACK(interp, aTHX); return status; } 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_config.c Fri Nov 1 00:31:21 2013 @@ -375,23 +375,11 @@ apr_status_t modperl_config_req_cleanup( { request_rec *r = (request_rec *)data; apr_status_t rc; - -#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 + MP_dINTERPa(r, NULL, NULL); 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 + MP_INTERP_PUTBACK(interp, aTHX); return rc; } Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c?rev=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c Fri Nov 1 00:31:21 2013 @@ -282,13 +282,14 @@ static apr_status_t modperl_filter_f_cle /* mod_perl filter ctx cleanup */ if (ctx->data){ #ifdef USE_ITHREADS - dTHXa(ctx->perl); + dTHXa(ctx->interp->perl); + MP_ASSERT_CONTEXT(aTHX); #endif if (SvOK(ctx->data) && SvREFCNT(ctx->data)) { SvREFCNT_dec(ctx->data); ctx->data = NULL; } - ctx->perl = NULL; + MP_INTERP_PUTBACK(ctx->interp, aTHX); } return APR_SUCCESS; @@ -439,9 +440,8 @@ static int modperl_run_filter_init(ap_fi server_rec *s = r ? r->server : c->base_server; apr_pool_t *p = r ? r->pool : c->pool; modperl_filter_t *filter = modperl_filter_new(f, NULL, mode, 0, 0, 0); - MP_pINTERP; - MP_dINTERP(r, c, s); + MP_dINTERPa(r, c, s); MP_TRACE_h(MP_FUNC, "running filter init handler %s", modperl_handler_name(handler)); @@ -465,7 +465,7 @@ static int modperl_run_filter_init(ap_fi FILTER_FREE(filter); SvREFCNT_dec((SV*)args); - MP_INTERP_PUTBACK(interp); + MP_INTERP_PUTBACK(interp, aTHX); MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT "return: %d", modperl_handler_name(handler), status); @@ -485,9 +485,8 @@ int modperl_run_filter(modperl_filter_t conn_rec *c = filter->f->c; server_rec *s = r ? r->server : c->base_server; apr_pool_t *p = r ? r->pool : c->pool; - MP_pINTERP; - MP_dINTERP(r, c, s); + MP_dINTERPa(r, c, s); MP_FILTER_SAVE_ERRSV(errsv); @@ -557,7 +556,7 @@ int modperl_run_filter(modperl_filter_t MP_FILTER_RESTORE_ERRSV(errsv); - MP_INTERP_PUTBACK(interp); + MP_INTERP_PUTBACK(interp, aTHX); MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT "return: %d", modperl_handler_name(handler), status); 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c Fri Nov 1 00:31:21 2013 @@ -273,11 +273,10 @@ apr_status_t modperl_interp_unselect(voi modperl_interp_t *interp = (modperl_interp_t *)data; modperl_interp_pool_t *mip = interp->mip; - if (interp == mip->parent) return APR_SUCCESS; - MP_ASSERT(interp && MpInterpIN_USE(interp)); - MP_TRACE_i(MP_FUNC, "unselect(interp=0x%lx): refcnt=%d", - (unsigned long)interp, interp->refcnt); + MP_TRACE_i(MP_FUNC, "unselect(interp=%pp): refcnt=%d", + interp, interp->refcnt); + if (interp->refcnt != 0) { --interp->refcnt; MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d -- interp still in use", @@ -285,15 +284,22 @@ apr_status_t modperl_interp_unselect(voi return APR_SUCCESS; } - interp->ccfg->interp = NULL; MpInterpIN_USE_Off(interp); modperl_thx_interp_set(interp->perl, NULL); +#ifdef MP_DEBUG + PERL_SET_CONTEXT(NULL); +#endif - 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)", - (unsigned long)interp, mip->tipool->size, mip->tipool->in_use); + if (interp == mip->parent) { + MP_TRACE_i(MP_FUNC, "parent interp=%pp freed", interp); + } + else { + interp->ccfg->interp = NULL; + modperl_tipool_putback_data(mip->tipool, data, interp->num_requests); + MP_TRACE_i(MP_FUNC, "interp=%pp freed, tipool(size=%ld, in_use=%ld)", + interp, mip->tipool->size, mip->tipool->in_use); + } return APR_SUCCESS; } @@ -363,15 +369,17 @@ modperl_interp_t *modperl_interp_pool_se 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); + MP_TRACE_i(MP_FUNC, "set interp %pp in pconf pool %pp", + interp, p); } else { - MP_TRACE_i(MP_FUNC, "found interp 0x%lx in pconf pool 0x%lx", - (unsigned long)interp, (unsigned long)p); + MP_TRACE_i(MP_FUNC, "found interp %pp in pconf pool %pp", + interp, p); } } + MpInterpIN_USE_On(interp); + interp->refcnt++; /* set context (THX) for this thread */ PERL_SET_CONTEXT(interp->perl); /* let the perl interpreter point back to its interp */ @@ -392,7 +400,7 @@ modperl_interp_t *modperl_interp_pool_se modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec *s) { - MP_dSCFG((r ? s=r->server : s ? s : NULL)); + MP_dSCFG((r ? s=r->server : c ? s=c->base_server : s)); MP_dDCFG; modperl_config_con_t *ccfg; const char *desc = NULL; @@ -400,16 +408,27 @@ modperl_interp_t *modperl_interp_select( apr_pool_t *p = NULL; modperl_interp_scope_e scope; - if (!modperl_threaded_mpm()) { - MP_TRACE_i(MP_FUNC, - "using parent 0x%pp (perl=0x%pp) non-threaded mpm (%s:%d)", - scfg->mip->parent, scfg->mip->parent->perl, - s->server_hostname, s->port); + /* What does the following condition mean? + * (r || c): if true we are at runtime. There is some kind of request + * being processed. + * threaded_mpm: self-explanatory + * + * Thus, it is true if we are either at initialization time or at runtime + * but with prefork-MPM. */ + if (!((r || c) && modperl_threaded_mpm())) { + interp = scfg->mip->parent; + MpInterpIN_USE_On(interp); + interp->refcnt++; /* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */ - PERL_SET_CONTEXT(scfg->mip->parent->perl); + PERL_SET_CONTEXT(interp->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; + MP_THX_INTERP_SET(interp->perl, interp); + + MP_TRACE_i(MP_FUNC, + "using parent 0x%pp (perl=0x%pp) for %s:%d refcnt set to %d", + interp, interp->perl, s->server_hostname, s->port, + interp->refcnt); + return interp; } if(!c) c = r->connection; @@ -430,9 +449,9 @@ modperl_interp_t *modperl_interp_select( } MP_TRACE_i(MP_FUNC, - "fetching interp for (%s:%d)", s->server_hostname, s->port); + "fetching interp for %s:%d", s->server_hostname, s->port); interp = modperl_interp_get(s); - MP_TRACE_i(MP_FUNC, " --> got %pp", interp); + MP_TRACE_i(MP_FUNC, " --> got %pp (perl=%pp)", interp, interp->perl); ++interp->num_requests; /* should only get here once per request */ interp->refcnt = 0; @@ -447,8 +466,8 @@ modperl_interp_t *modperl_interp_select( interp->ccfg = ccfg; MP_TRACE_i(MP_FUNC, - "pulled interp 0x%lx from mip, num_requests is %d", - (unsigned long)interp, interp->num_requests); + "pulled interp %pp (perl=%pp) from mip, num_requests is %d", + interp, interp->perl, interp->num_requests); /* * if a per-dir PerlInterpScope is specified, use it. 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h Fri Nov 1 00:31:21 2013 @@ -51,51 +51,46 @@ modperl_interp_t *modperl_interp_pool_se modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec *s); -#define MP_pINTERP pTHX; modperl_interp_t *interp = NULL +#define MP_dINTERP pTHX; modperl_interp_t *interp = NULL -#define MP_dINTERP(r, c, s) \ - interp = modperl_interp_select(r, c, s); \ +#define MP_INTERPa(r, c, s) \ + MP_TRACE_i(MP_FUNC, "selecting interp: r=%pp, c=%pp, s=%pp", \ + (r), (c), (s)); \ + interp = modperl_interp_select((r), (c), (s)); \ + MP_TRACE_i(MP_FUNC, " --> got (0x%pp)->refcnt=%d, perl=%pp", \ + interp, interp->refcnt, interp->perl); \ aTHX = interp->perl -#ifdef MP_DEBUG -#define MP_dINTERP_POOL(p, s) \ +#define MP_dINTERPa(r, c, s) \ + MP_dINTERP; \ + MP_INTERPa((r), (c), (s)) + +#define MP_INTERP_POOLa(p, s) \ MP_TRACE_i(MP_FUNC, "selecting interp: p=%pp, s=%pp", (p), (s)); \ - interp = modperl_interp_pool_select(p, s); \ + interp = modperl_interp_pool_select((p), (s)); \ MP_TRACE_i(MP_FUNC, " --> got (0x%pp)->refcnt=%d", \ interp, interp->refcnt); \ aTHX = interp->perl -#else /* MP_DEBUG */ -#define MP_dINTERP_POOL(p, s) \ - interp = modperl_interp_pool_select(p, s); \ - aTHX = interp->perl -#endif + +#define MP_dINTERP_POOLa(p, s) \ + MP_dINTERP; \ + MP_INTERP_POOLa((p), (s)) #ifdef MP_DEBUG -#define MP_INTERP_PUTBACK(interp) \ +#define MP_INTERP_PUTBACK(interp, thx) \ MP_TRACE_i(MP_FUNC, "unselecting interp: (0x%pp)->refcnt=%ld", \ (interp), (interp)->refcnt); \ modperl_interp_unselect(interp); \ interp = NULL; \ - aTHX = NULL; \ - PERL_SET_CONTEXT(NULL) + if( thx ) thx = NULL #else /* MP_DEBUG */ -#define MP_INTERP_PUTBACK(interp) \ +#define MP_INTERP_PUTBACK(interp, thx) \ modperl_interp_unselect(interp) #endif -# if 1 -/* ideally we should be able to reset interp and aTHX to NULL after - * unselecting the interpreter. Unfortunately that does not work, yet */ -#undef MP_INTERP_PUTBACK -#define MP_INTERP_PUTBACK(interp) \ - MP_TRACE_i(MP_FUNC, "unselecting interp: (0x%pp)->refcnt=%ld", \ - (interp), (interp)->refcnt); \ - modperl_interp_unselect(interp) -# endif /* 0 */ - #define MP_INTERP_REFCNT_inc(interp) (interp)->refcnt++ -#define MP_INTERP_REFCNT_dec(interp) MP_INTERP_PUTBACK(interp) +#define MP_INTERP_REFCNT_dec(interp) MP_INTERP_PUTBACK(interp, NULL) #define MP_aTHX aTHX @@ -117,13 +112,17 @@ void modperl_interp_mip_walk_servers(Per void *data); #else -#define MP_pINTERP dNOOP +#define MP_dINTERP dNOOP + +#define MP_INTERPa(r, c, s) NOOP + +#define MP_dINTERPa(r, c, s) NOOP -#define MP_dINTERP(r, c, s) NOOP +#define MP_INTERP_POOLa(p, s) NOOP -#define MP_dINTERP_POOL(p, s) NOOP +#define MP_dINTERP_POOLa(p, s) NOOP -#define MP_INTERP_PUTBACK(interp) NOOP +#define MP_INTERP_PUTBACK(interp, thx) NOOP #define MP_INTERP_REFCNT_inc(interp) NOOP 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c Fri Nov 1 00:31:21 2013 @@ -103,7 +103,9 @@ PTR_TBL_t *modperl_module_config_table_g } typedef struct { - PerlInterpreter *perl; +#ifdef USE_ITHREADS + modperl_interp_t *interp; +#endif PTR_TBL_t *table; void *ptr; } config_obj_cleanup_t; @@ -116,15 +118,17 @@ static apr_status_t modperl_module_confi { config_obj_cleanup_t *cleanup = (config_obj_cleanup_t *)data; - dTHXa(cleanup->perl); - +#ifdef USE_ITHREADS + dTHXa(cleanup->interp->perl); MP_ASSERT_CONTEXT(aTHX); +#endif modperl_svptr_table_delete(aTHX_ cleanup->table, cleanup->ptr); - MP_TRACE_c(MP_FUNC, "deleting ptr 0x%lx from table 0x%lx", - (unsigned long)cleanup->ptr, - (unsigned long)cleanup->table); + MP_TRACE_c(MP_FUNC, "deleting ptr %pp from table %pp", + cleanup->ptr, cleanup->table); + + MP_INTERP_PUTBACK(cleanup->interp, aTHX); return APR_SUCCESS; } @@ -140,7 +144,8 @@ static void modperl_module_config_obj_cl cleanup->table = table; cleanup->ptr = ptr; #ifdef USE_ITHREADS - cleanup->perl = aTHX; + cleanup->interp = modperl_thx_interp_get(aTHX); + MP_INTERP_REFCNT_inc(cleanup->interp); #endif apr_pool_cleanup_register(p, cleanup, @@ -168,7 +173,7 @@ static void *modperl_module_config_merge int is_startup; PTR_TBL_t *table; SV *mrg_obj = (SV *)NULL, *base_obj, *add_obj; - MP_pINTERP; + MP_dINTERP; /* if the module is loaded in vhost, base==NULL */ tmp = (base && base->server) ? base : add; @@ -181,14 +186,14 @@ static void *modperl_module_config_merge s = tmp->server; is_startup = (p == s->process->pconf); - MP_dINTERP_POOL(p, s); + MP_INTERP_POOLa(p, s); table = modperl_module_config_table_get(aTHX_ TRUE); base_obj = modperl_svptr_table_fetch(aTHX_ table, base); add_obj = modperl_svptr_table_fetch(aTHX_ table, add); if (!base_obj || (base_obj == add_obj)) { - MP_INTERP_PUTBACK(interp); + MP_INTERP_PUTBACK(interp, aTHX); return addv; } @@ -235,10 +240,9 @@ static void *modperl_module_config_merge if (!is_startup) { modperl_module_config_obj_cleanup_register(aTHX_ p, table, mrg); - /* MP_INTERP_REFCNT_inc(interp); */ } - MP_INTERP_PUTBACK(interp); + MP_INTERP_PUTBACK(interp, aTHX); return (void *)mrg; } @@ -353,10 +357,7 @@ static const char *modperl_module_cmd_ta modperl_module_cfg_t *srv_cfg; int modules_alias = 0; -#ifdef USE_ITHREADS - modperl_interp_t *interp = modperl_interp_pool_select(p, s); - dTHXa(interp->perl); -#endif + MP_dINTERP_POOLa(p, s); int count; PTR_TBL_t *table = modperl_module_config_table_get(aTHX_ TRUE); @@ -405,11 +406,7 @@ static const char *modperl_module_cmd_ta parms, &obj); if (errmsg) { -#ifdef USE_ITHREADS - MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld", - interp, interp->refcnt); - modperl_interp_unselect(interp); -#endif + MP_INTERP_PUTBACK(interp, aTHX); return errmsg; } @@ -430,11 +427,7 @@ 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", - interp, interp->refcnt); - modperl_interp_unselect(interp); -#endif + MP_INTERP_PUTBACK(interp, aTHX); return errmsg; } @@ -476,11 +469,7 @@ static const char *modperl_module_cmd_ta retval = SvPVX(ERRSV); } -#ifdef USE_ITHREADS - MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld", - interp, interp->refcnt); - modperl_interp_unselect(interp); -#endif + MP_INTERP_PUTBACK(interp, aTHX); if (modules_alias) { MP_dSCFG(s); @@ -649,10 +638,7 @@ static const char *modperl_module_add_cm command_rec *cmd; AV *module_cmds; I32 i, fill; -#ifdef USE_ITHREADS - MP_dSCFG(s); - dTHXa(scfg->mip->parent->perl); -#endif + MP_dINTERPa(NULL, NULL, s); module_cmds = (AV*)SvRV(mod_cmds); fill = AvFILL(module_cmds); @@ -669,6 +655,7 @@ static const char *modperl_module_add_cm cmd = apr_array_push(cmds); if ((errmsg = modperl_module_cmd_fetch(aTHX_ obj, "name", &val))) { + MP_INTERP_PUTBACK(interp, aTHX); return errmsg; } @@ -689,6 +676,7 @@ static const char *modperl_module_add_cm } if (!modperl_module_cmd_lookup(cmd)) { + MP_INTERP_PUTBACK(interp, aTHX); return apr_psprintf(p, "no command function defined for args_how=%d", cmd->args_how); @@ -741,6 +729,7 @@ static const char *modperl_module_add_cm modp->cmds = (command_rec *)cmds->elts; + MP_INTERP_PUTBACK(interp, aTHX); return NULL; } @@ -788,9 +777,7 @@ const char *modperl_module_add(apr_pool_ const char *name, SV *mod_cmds) { MP_dSCFG(s); -#ifdef USE_ITHREADS - dTHXa(scfg->mip->parent->perl); -#endif + MP_dINTERPa(NULL, NULL, s); const char *errmsg; module *modp = (module *)apr_pcalloc(p, sizeof(*modp)); modperl_module_info_t *minfo = @@ -832,6 +819,7 @@ const char *modperl_module_add(apr_pool_ modp->cmds = NULL; if ((errmsg = modperl_module_add_cmds(p, s, modp, mod_cmds))) { + MP_INTERP_PUTBACK(interp, aTHX); return errmsg; } @@ -866,6 +854,7 @@ const char *modperl_module_add(apr_pool_ } #endif + MP_INTERP_PUTBACK(interp, aTHX); return NULL; } 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=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_types.h Fri Nov 1 00:31:21 2013 @@ -243,7 +243,9 @@ typedef struct { int sent_eos; SV *data; modperl_handler_t *handler; - PerlInterpreter *perl; +#ifdef USE_ITHREADS + modperl_interp_t *interp; +#endif } modperl_filter_ctx_t; typedef struct { Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c?rev=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c (original) +++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_util.c Fri Nov 1 00:31:21 2013 @@ -836,6 +836,9 @@ typedef struct { } modperl_cleanup_pnotes_data_t; #endif +/* XXX: This function was highly conflicted in threading vs. httpd24, + * so this manually merged version may not be correct. + */ static MP_INLINE apr_status_t modperl_cleanup_pnotes(void *data) { HV **pnotes = data; @@ -844,6 +847,7 @@ apr_status_t modperl_cleanup_pnotes(void #ifdef USE_ITHREADS modperl_cleanup_pnotes_data_t *cleanup_data = data; dTHXa(cleanup_data->perl); + MP_ASSERT_CONTEXT(aTHX); pnotes = cleanup_data->pnotes; #else pnotes = data; @@ -852,6 +856,9 @@ apr_status_t modperl_cleanup_pnotes(void *pnotes = (HV *)NULL; } +#ifdef USE_ITHREADS + MP_INTERP_PUTBACK(cleanup_data, aTHX); +#endif return APR_SUCCESS; } Modified: perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h?rev=1537777&r1=1537776&r2=1537777&view=diff ============================================================================== --- perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h (original) +++ perl/modperl/branches/httpd24threading/xs/Apache2/Filter/Apache2__Filter.h Fri Nov 1 00:31:21 2013 @@ -196,8 +196,9 @@ static MP_INLINE SV *mpxs_Apache2__Filte } #ifdef USE_ITHREADS - if (!ctx->perl) { - ctx->perl = aTHX; + if (!ctx->interp) { + ctx->interp = modperl_thx_interp_get(aTHX); + MP_INTERP_REFCNT_inc(ctx->interp); } #endif ctx->data = SvREFCNT_inc(data);