Author: torsten Date: Fri Feb 10 17:03:58 2012 New Revision: 1242858 URL: http://svn.apache.org/viewvc?rev=1242858&view=rev Log: - introduce a few preprocessor macros aiming at a more robust interpreter handling (not finished yet). - deleting some cruft from ancient perl versions.
Modified: perl/modperl/branches/threading/src/modules/perl/modperl_debug.h perl/modperl/branches/threading/src/modules/perl/modperl_filter.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 Modified: perl/modperl/branches/threading/src/modules/perl/modperl_debug.h URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_debug.h?rev=1242858&r1=1242857&r2=1242858&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_debug.h (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_debug.h Fri Feb 10 17:03:58 2012 @@ -20,9 +20,15 @@ #include "mod_perl.h" #ifdef MP_DEBUG -#define MP_ASSERT(exp) ap_assert(exp) +# define MP_ASSERT(exp) ap_assert(exp) #else -#define MP_ASSERT(exp) ((void)0) +# define MP_ASSERT(exp) ((void)0) +#endif + +#ifdef USE_ITHREADS +# define MP_ASSERT_CONTEXT(perl) MP_ASSERT((perl) == PERL_GET_CONTEXT) +#else +# define MP_ASSERT_CONTEXT(perl) ((void)0) #endif char *modperl_server_desc(server_rec *s, apr_pool_t *p); Modified: perl/modperl/branches/threading/src/modules/perl/modperl_filter.c URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_filter.c?rev=1242858&r1=1242857&r2=1242858&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_filter.c (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_filter.c Fri Feb 10 17:03:58 2012 @@ -439,8 +439,9 @@ 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_SELECT(r, c, s); + MP_dINTERP(r, c, s); MP_TRACE_h(MP_FUNC, "running filter init handler %s", modperl_handler_name(handler)); @@ -484,8 +485,9 @@ 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_SELECT(r, c, s); + MP_dINTERP(r, c, s); MP_FILTER_SAVE_ERRSV(errsv); 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=1242858&r1=1242857&r2=1242858&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_interp.c (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_interp.c Fri Feb 10 17:03:58 2012 @@ -38,12 +38,7 @@ void modperl_interp_clone_init(modperl_i MpInterpCLONED_On(interp); - PERL_SET_CONTEXT(aTHX); - - /* XXX: hack for bug fixed in 5.6.1 */ - if (PL_scopestack_ix == 0) { - ENTER; - } + MP_ASSERT_CONTEXT(aTHX); /* clear @DynaLoader::dl_librefs so we only dlclose() those * which are opened by the clone @@ -79,14 +74,7 @@ modperl_interp_t *modperl_interp_new(mod interp->perl = perl_clone(perl, clone_flags); -#if MP_PERL_VERSION(5, 8, 0) && \ - defined(USE_REENTRANT_API) && defined(HAS_CRYPT_R) && defined(__GLIBC__) - { - dTHXa(interp->perl); - /* workaround 5.8.0 bug */ - PL_reentrant_buffer->_crypt_struct.current_saltbits = 0; - } -#endif + MP_ASSERT_CONTEXT(interp->perl); { PTR_TBL_t *source = modperl_module_config_table_get(perl, FALSE); @@ -101,7 +89,9 @@ modperl_interp_t *modperl_interp_new(mod /* * we keep the PL_ptr_table past perl_clone so it can be used - * within modperl_svptr_table_clone. + * within modperl_svptr_table_clone. Perl_sv_dup() uses it. + * Don't confuse our svptr_table with Perl's ptr_table. They + * are different things, although they use the same type. */ if ((clone_flags & CLONEf_KEEP_PTR_TABLE)) { dTHXa(interp->perl); @@ -405,8 +395,8 @@ modperl_interp_t *modperl_interp_select( if (!modperl_threaded_mpm()) { MP_TRACE_i(MP_FUNC, - "using parent 0x%lx for non-threaded mpm (%s:%d)", - (unsigned long)scfg->mip->parent, + "using parent 0x%pp (perl=0x%pp) non-threaded mpm (%s:%d)", + scfg->mip->parent, scfg->mip->parent->perl, s->server_hostname, s->port); /* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */ PERL_SET_CONTEXT(scfg->mip->parent->perl); @@ -578,20 +568,20 @@ void modperl_interp_mip_walk_servers(Per } #define MP_THX_INTERP_KEY "modperl2::thx_interp_key" -modperl_interp_t *modperl_thx_interp_get(PerlInterpreter *thx) +modperl_interp_t *modperl_thx_interp_get(pTHX) { modperl_interp_t *interp; - dTHXa(thx); - SV **svp = hv_fetch(PL_modglobal, MP_THX_INTERP_KEY, strlen(MP_THX_INTERP_KEY), 0); + SV **svp = hv_fetch(PL_modglobal, MP_THX_INTERP_KEY, + strlen(MP_THX_INTERP_KEY), 0); if (!svp) return NULL; interp = INT2PTR(modperl_interp_t *, SvIV(*svp)); return interp; } -void modperl_thx_interp_set(PerlInterpreter *thx, modperl_interp_t *interp) +void modperl_thx_interp_set(pTHX_ modperl_interp_t *interp) { - dTHXa(thx); - (void)hv_store(PL_modglobal, MP_THX_INTERP_KEY, strlen(MP_THX_INTERP_KEY), newSViv(PTR2IV(interp)), 0); + (void)hv_store(PL_modglobal, MP_THX_INTERP_KEY, strlen(MP_THX_INTERP_KEY), + newSViv(PTR2IV(interp)), 0); return; } 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=1242858&r1=1242857&r2=1242858&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_interp.h (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_interp.h Fri Feb 10 17:03:58 2012 @@ -51,16 +51,51 @@ modperl_interp_t *modperl_interp_pool_se modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec *s); -#define MP_dINTERP_SELECT(r, c, s) \ - pTHX; \ - modperl_interp_t *interp = NULL; \ - interp = modperl_interp_select(r, c, s); \ +#define MP_pINTERP pTHX; modperl_interp_t *interp = NULL + +#define MP_dINTERP(r, c, s) \ + interp = modperl_interp_select(r, c, s); \ + aTHX = interp->perl + +#ifdef MP_DEBUG +#define MP_dINTERP_POOL(p, s) \ + MP_TRACE_i(MP_FUNC, "selecting interp: p=%pp, s=%pp", (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 + +#ifdef MP_DEBUG +#define MP_INTERP_PUTBACK(interp) \ + 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) +#else /* MP_DEBUG */ +#define MP_INTERP_PUTBACK(interp) \ + 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_PUTBACK(interp) \ - if (interp) { \ - modperl_interp_unselect(interp); \ - } +#define MP_INTERP_REFCNT_inc(interp) (interp)->refcnt++ + +#define MP_INTERP_REFCNT_dec(interp) MP_INTERP_PUTBACK(interp) #define MP_aTHX aTHX @@ -82,10 +117,18 @@ void modperl_interp_mip_walk_servers(Per void *data); #else -#define MP_dINTERP_SELECT(r, c, s) dNOOP +#define MP_pINTERP dNOOP + +#define MP_dINTERP(r, c, s) NOOP + +#define MP_dINTERP_POOL(p, s) NOOP #define MP_INTERP_PUTBACK(interp) NOOP +#define MP_INTERP_REFCNT_inc(interp) NOOP + +#define MP_INTERP_REFCNT_dec(interp) NOOP + #define MP_aTHX 0 #endif /* USE_ITHREADS */ 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=1242858&r1=1242857&r2=1242858&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_module.c (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_module.c Fri Feb 10 17:03:58 2012 @@ -118,6 +118,8 @@ static apr_status_t modperl_module_confi (config_obj_cleanup_t *)data; dTHXa(cleanup->perl); + MP_ASSERT_CONTEXT(aTHX); + modperl_svptr_table_delete(aTHX_ cleanup->table, cleanup->ptr); MP_TRACE_c(MP_FUNC, "deleting ptr 0x%lx from table 0x%lx", @@ -166,10 +168,7 @@ static void *modperl_module_config_merge int is_startup; PTR_TBL_t *table; SV *mrg_obj = Nullsv, *base_obj, *add_obj; -#ifdef USE_ITHREADS - modperl_interp_t *interp; - pTHX; -#endif + MP_pINTERP; /* if the module is loaded in vhost, base==NULL */ tmp = (base && base->server) ? base : add; @@ -182,21 +181,14 @@ static void *modperl_module_config_merge s = tmp->server; is_startup = (p == s->process->pconf); -#ifdef USE_ITHREADS - interp = modperl_interp_pool_select(p, s); - aTHX = interp->perl; -#endif + MP_dINTERP_POOL(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)) { -#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); return addv; } @@ -243,13 +235,10 @@ static void *modperl_module_config_merge if (!is_startup) { modperl_module_config_obj_cleanup_register(aTHX_ p, table, mrg); + /* MP_INTERP_REFCNT_inc(interp); */ } -#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); return (void *)mrg; }