perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From tors...@apache.org
Subject svn commit: r1243509 - in /perl/modperl/branches/threading: src/modules/perl/ xs/Apache2/Filter/
Date Mon, 13 Feb 2012 13:53:51 GMT
Author: torsten
Date: Mon Feb 13 13:53:50 2012
New Revision: 1243509

URL: http://svn.apache.org/viewvc?rev=1243509&view=rev
Log:
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/threading/src/modules/perl/mod_perl.c
    perl/modperl/branches/threading/src/modules/perl/modperl_callback.c
    perl/modperl/branches/threading/src/modules/perl/modperl_config.c
    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
    perl/modperl/branches/threading/src/modules/perl/modperl_types.h
    perl/modperl/branches/threading/src/modules/perl/modperl_util.c
    perl/modperl/branches/threading/xs/Apache2/Filter/Apache2__Filter.h

Modified: perl/modperl/branches/threading/src/modules/perl/mod_perl.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/mod_perl.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/mod_perl.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/mod_perl.c Mon Feb 13 13:53:50 2012
@@ -1033,22 +1033,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)) {
@@ -1061,11 +1052,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;
 }
@@ -1076,21 +1063,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);
 
@@ -1122,11 +1101,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/threading/src/modules/perl/modperl_callback.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_callback.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_callback.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_callback.c Mon Feb 13 13:53:50
2012
@@ -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);
-        modperl_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/threading/src/modules/perl/modperl_config.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_config.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_config.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_config.c Mon Feb 13 13:53:50
2012
@@ -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/threading/src/modules/perl/modperl_filter.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_filter.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_filter.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_filter.c Mon Feb 13 13:53:50
2012
@@ -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/threading/src/modules/perl/modperl_interp.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_interp.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_interp.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_interp.c Mon Feb 13 13:53:50
2012
@@ -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;
 }
@@ -356,15 +362,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 */
@@ -385,7 +393,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;
@@ -393,16 +401,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 */
-        modperl_thx_interp_set(scfg->mip->parent->perl, scfg->mip->parent);
-        return scfg->mip->parent;
+        modperl_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;
@@ -423,9 +442,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;
 
@@ -440,8 +459,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/threading/src/modules/perl/modperl_interp.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_interp.h?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_interp.h (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_interp.h Mon Feb 13 13:53:50
2012
@@ -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/threading/src/modules/perl/modperl_module.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_module.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_module.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_module.c Mon Feb 13 13:53:50
2012
@@ -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 = Nullsv, *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/threading/src/modules/perl/modperl_types.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_types.h?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_types.h (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_types.h Mon Feb 13 13:53:50 2012
@@ -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/threading/src/modules/perl/modperl_util.c
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_util.c?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/src/modules/perl/modperl_util.c (original)
+++ perl/modperl/branches/threading/src/modules/perl/modperl_util.c Mon Feb 13 13:53:50 2012
@@ -833,18 +833,14 @@ static MP_INLINE
 apr_status_t modperl_cleanup_pnotes(void *data) {
     modperl_pnotes_t *pnotes = data;
 
-#ifdef USE_ITHREADS
-        dTHXa(pnotes->interp->perl);
-#endif
-        SvREFCNT_dec(pnotes->pnotes);
-        pnotes->pnotes = NULL;
-        pnotes->pool = NULL;
-#ifdef USE_ITHREADS
-        MP_TRACE_i(MP_FUNC, "DO: calling interp_unselect(0x%lx)",
-               pnotes->interp);
-    modperl_interp_unselect(pnotes->interp);
-    pnotes->interp = NULL;
-#endif
+    dTHXa(pnotes->interp->perl);
+    MP_ASSERT_CONTEXT(aTHX);
+
+    SvREFCNT_dec(pnotes->pnotes);
+    pnotes->pnotes = NULL;
+    pnotes->pool = NULL;
+
+    MP_INTERP_PUTBACK(pnotes->interp, aTHX);
     return APR_SUCCESS;
 }
 

Modified: perl/modperl/branches/threading/xs/Apache2/Filter/Apache2__Filter.h
URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/xs/Apache2/Filter/Apache2__Filter.h?rev=1243509&r1=1243508&r2=1243509&view=diff
==============================================================================
--- perl/modperl/branches/threading/xs/Apache2/Filter/Apache2__Filter.h (original)
+++ perl/modperl/branches/threading/xs/Apache2/Filter/Apache2__Filter.h Mon Feb 13 13:53:50
2012
@@ -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);



Mime
View raw message