perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From steve...@apache.org
Subject 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
Date Fri, 01 Nov 2013 00:21:04 GMT
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;
 }



Mime
View raw message