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 st...@apache.org on 2013/11/01 01:21:04 UTC
svn commit: r1537775 - in /perl/modperl/branches/httpd24threading: ./
src/modules/perl/modperl_debug.h src/modules/perl/modperl_filter.c
src/modules/perl/modperl_interp.c src/modules/perl/modperl_interp.h
src/modules/perl/modperl_module.c
Author: stevehay
Date: Fri Nov 1 00:21:04 2013
New Revision: 1537775
URL: http://svn.apache.org/r1537775
Log:
Merged revision(s) 1242858 from perl/modperl/branches/threading:
- 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/httpd24threading/ (props changed)
perl/modperl/branches/httpd24threading/src/modules/perl/modperl_debug.h
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
Propchange: perl/modperl/branches/httpd24threading/
------------------------------------------------------------------------------
Merged /perl/modperl/branches/threading:r1242858
Modified: perl/modperl/branches/httpd24threading/src/modules/perl/modperl_debug.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_debug.h?rev=1537775&r1=1537774&r2=1537775&view=diff
==============================================================================
--- perl/modperl/branches/httpd24threading/src/modules/perl/modperl_debug.h (original)
+++ perl/modperl/branches/httpd24threading/src/modules/perl/modperl_debug.h Fri Nov 1 00:21:04 2013
@@ -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/httpd24threading/src/modules/perl/modperl_filter.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_filter.c?rev=1537775&r1=1537774&r2=1537775&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:21:04 2013
@@ -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/httpd24threading/src/modules/perl/modperl_interp.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.c?rev=1537775&r1=1537774&r2=1537775&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:21:04 2013
@@ -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);
@@ -412,8 +402,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);
@@ -585,20 +575,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/httpd24threading/src/modules/perl/modperl_interp.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_interp.h?rev=1537775&r1=1537774&r2=1537775&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:21:04 2013
@@ -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/httpd24threading/src/modules/perl/modperl_module.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/httpd24threading/src/modules/perl/modperl_module.c?rev=1537775&r1=1537774&r2=1537775&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:21:04 2013
@@ -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 = (SV *)NULL, *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;
}