interpreter-locks

Author: joesuf4

src/modules/perl/modperl_interp.c

@@ -48,6 +48,7 @@ modperl_interp_t *modperl_interp_new(modperl_interp_pool_t *mip,
 
     interp->mip = mip;
     interp->refcnt = 0;
+    MUTEX_INIT(&interp->lock);
 
     if (perl) {
 #ifdef MP_USE_GTOP
@@ -112,7 +113,7 @@ void modperl_interp_destroy(modperl_interp_t *interp)
     void **handles;
     dTHXa(interp->perl);
 
-    PERL_SET_CONTEXT(interp->perl);
+    PERL_SET_CONTEXT(aTHX);
 
     MP_TRACE_i(MP_FUNC, "interp == 0x%lx / perl: 0x%lx",
                (unsigned long)interp, (unsigned long)interp->perl);
@@ -124,11 +125,13 @@ void modperl_interp_destroy(modperl_interp_t *interp)
 
     handles = modperl_xs_dl_handles_get(aTHX);
 
-    modperl_perl_destruct(interp->perl);
+    modperl_perl_destruct(aTHX);
 
     modperl_xs_dl_handles_close(handles);
 
+    MUTEX_DESTROY(&interp->lock);
     free(interp);
+
 }
 
 apr_status_t modperl_interp_cleanup(void *data)
@@ -257,6 +260,7 @@ static apr_status_t modperl_interp_pool_unselect(void *data)
                interp, interp->refcnt);
         interp->refcnt = 1;
     }
+    interp->pool = NULL;
     return modperl_interp_unselect(data);
 }
 
@@ -265,20 +269,22 @@ apr_status_t modperl_interp_unselect(void *data)
     modperl_interp_t *interp = (modperl_interp_t *)data;
     modperl_interp_pool_t *mip = interp->mip;
     modperl_tipool_t *tipool = mip->tipool;
-
+    MUTEX_LOCK(&interp->lock);
     MP_ASSERT(interp && MpInterpIN_USE(interp) && interp->refcnt > 0);
     MP_TRACE_i(MP_FUNC, "unselect(interp=%pp): refcnt=%d",
                interp, interp->refcnt);
 
     if (--interp->refcnt > 0) {
         MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d -- interp still in use",
                    (unsigned long)interp, interp->refcnt);
+        MUTEX_UNLOCK(&interp->lock);
         return APR_SUCCESS;
     }
 
     if (!MpInterpIN_USE(interp)){
         MP_TRACE_i(MP_FUNC, "interp=0x%pp, refcnt=%d -- interp already not in use",
                    interp, interp->refcnt);
+        MUTEX_UNLOCK(&interp->lock);
         return APR_SUCCESS;
     }
 
@@ -301,6 +307,7 @@ apr_status_t modperl_interp_unselect(void *data)
         MP_TRACE_i(MP_FUNC, "interp=%pp freed, tipool(size=%ld, in_use=%ld)",
                    interp, tipool->size, tipool->in_use);
     }
+    MUTEX_UNLOCK(&interp->lock);
     return APR_SUCCESS;
 }
 
@@ -450,9 +457,14 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec
     if (c)
         ccfg = modperl_config_con_get(c);
 
+    static perl_mutex lock = PTHREAD_MUTEX_INITIALIZER;
+    MUTEX_LOCK(&lock);
     if (p && (interp = modperl_interp_pool_get(p)) && MpInterpIN_USE(interp)) {
+        MUTEX_LOCK(&interp->lock);
+        MUTEX_UNLOCK(&lock);
         interp->refcnt++;
         interp->num_requests++;
+        MUTEX_UNLOCK(&interp->lock);
         MP_TRACE_i(MP_FUNC,
                    "found interp 0x%lx (perl=0x%pp) in r->pool config, refcnt=%d",
                    (unsigned long)interp, interp->perl, interp->refcnt);
@@ -463,6 +475,8 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec
     MP_TRACE_i(MP_FUNC,
                "fetching interp for %s:%d", s->server_hostname, s->port);
     interp = modperl_interp_get(s);
+    MUTEX_LOCK(&interp->lock);
+    MUTEX_UNLOCK(&lock);
     MP_TRACE_i(MP_FUNC, "  --> got %pp (perl=%pp)", interp, interp->perl);
     ++interp->num_requests; /* should only get here once per request */
     interp->refcnt = 1;
@@ -499,6 +513,7 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec
         */
         interp->refcnt++, set_interp(p), interp->pool = p;
 
+    MUTEX_UNLOCK(&interp->lock);
     return interp;
 }
 

src/modules/perl/modperl_tipool.c

@@ -248,6 +248,7 @@ void modperl_tipool_remove(modperl_tipool_t *tipool, modperl_list_t *listp)
     MP_TRACE_i(MP_FUNC, "removed 0x%lx (size=%d)",
                (unsigned long)listp, tipool->size);
 
+    free(listp);
 }
 
 modperl_list_t *modperl_tipool_pop(modperl_tipool_t *tipool)
@@ -297,7 +298,6 @@ static void modperl_tipool_putback_base(modperl_tipool_t *tipool,
                                         int num_requests)
 {
     modperl_tipool_lock(tipool);
-
     /* remove from busy list, add back to idle */
     /* XXX: option to sort list, e.g. on num_requests */
 
@@ -335,18 +335,23 @@ static void modperl_tipool_putback_base(modperl_tipool_t *tipool,
      */
  MANAGE_TIPOOL:
     if (tipool->func->tipool_destroy) {
-        if (tipool->size - tipool->in_use > tipool->cfg->max_spare) {
+        while (tipool->size - tipool->in_use > tipool->cfg->max_spare) {
             if (tipool->idle && tipool->idle->next) {
-            MP_TRACE_i(MP_FUNC,
-                       "shrinking pool: max_spare=%d, %d of %d in use",
-                       tipool->cfg->max_spare, tipool->in_use,
-                       tipool->size);
                 listp = modperl_list_last(tipool->idle->next);
                 if (listp) {
+                    MP_TRACE_i(MP_FUNC,
+                       "shrinking pool: destroying 0x%lx, max_spare=%d, %d of %d in use",
+                               (unsigned long)listp->data, tipool->cfg->max_spare, tipool->in_use,
+                               tipool->size);
+                    void *data = listp->data;
                     modperl_tipool_remove(tipool, listp);
-                    (*tipool->func->tipool_destroy)(tipool, tipool->data, listp->data);
+                    (*tipool->func->tipool_destroy)(tipool, tipool->data, data);
                 }
+                else
+                    break;
             }
+            else
+                break;
         }
     }
     if (tipool->func->tipool_rgrow) {

src/modules/perl/modperl_types.h

@@ -62,11 +62,12 @@ struct modperl_interp_t {
     int num_requests;
     U8 flags;
     modperl_config_con_t *ccfg;
-    int refcnt;
+    volatile int refcnt;
     apr_pool_t *pool;
 #ifdef MP_TRACE
     unsigned long tid;
 #endif
+    perl_mutex lock;
 };
 
 typedef struct {

src/modules/perl/modperl_util.c

@@ -19,7 +19,7 @@
 int modperl_require_module(pTHX_ const char *pv, int logfailure)
 {
     SV *sv;
-
+    PERL_SET_CONTEXT(aTHX);
     dSP;
     PUSHSTACKi(PERLSI_REQUIRE);
     ENTER;SAVETMPS;
@@ -835,14 +835,9 @@ apr_status_t modperl_cleanup_pnotes(void *data) {
 
     dTHXa(pnotes->perl);
     MP_ASSERT_CONTEXT(aTHX);
-#ifdef USE_ITHREADS
-    modperl_interp_t *interp = modperl_thx_interp_get(aTHX);
-    interp->refcnt--;
-#endif
     SvREFCNT_dec(pnotes->pnotes);
     pnotes->pnotes = NULL;
     pnotes->pool = NULL;
-
     return APR_SUCCESS;
 }
 
@@ -867,8 +862,6 @@ SV *modperl_pnotes(pTHX_ modperl_pnotes_t *pnotes, SV *key, SV *val,
                                   apr_pool_cleanup_null);
 #ifdef USE_ITHREADS
         pnotes->perl = aTHX;
-        modperl_interp_t *interp = modperl_thx_interp_get(aTHX);
-        interp->refcnt++;
 #endif
     }