perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@locus.apache.org
Subject cvs commit: modperl-2.0/src/modules/perl modperl_interp.c modperl_interp.h modperl_types.h
Date Sat, 15 Apr 2000 22:43:11 GMT
dougm       00/04/15 15:43:11

  Modified:    src/modules/perl modperl_interp.c modperl_interp.h
                        modperl_types.h
  Log:
  interpreter pool throttling
  
  Revision  Changes    Path
  1.4       +134 -49   modperl-2.0/src/modules/perl/modperl_interp.c
  
  Index: modperl_interp.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- modperl_interp.c	2000/04/15 17:51:44	1.3
  +++ modperl_interp.c	2000/04/15 22:43:10	1.4
  @@ -6,15 +6,21 @@
    */
   
   modperl_interp_t *modperl_interp_new(ap_pool_t *p,
  -                                     modperl_interp_t *parent)
  +                                     modperl_interp_pool_t *mip,
  +                                     PerlInterpreter *perl)
   {
       modperl_interp_t *interp = 
           (modperl_interp_t *)ap_pcalloc(p, sizeof(*interp));
       
  -    if (parent) {
  -        interp->mip_lock = parent->mip_lock;
  +    if (mip) {
  +        interp->mip = mip;
       }
   
  +    if (perl) {
  +        interp->perl = perl_clone(perl, TRUE);
  +        MpInterpCLONED_On(interp);
  +    }
  +
       MP_TRACE_i(MP_FUNC, "0x%lx\n", (unsigned long)interp);
   
       return interp;
  @@ -31,7 +37,6 @@
           MP_TRACE_i(MP_FUNC, "*error - still in use!*\n");
       }
   
  -
       PL_perl_destruct_level = 2;
       perl_destruct(interp->perl);
       perl_free(interp->perl);
  @@ -58,8 +63,23 @@
           MP_TRACE_i(MP_FUNC, "no pool, returning parent\n");
           return mip->parent;
       }
  +
  +    MUTEX_LOCK(&mip->mip_lock);
   
  -    ap_lock(mip->mip_lock);
  +    if (mip->size == mip->in_use) {
  +        if (mip->size < mip->max) {
  +            interp = modperl_interp_new(mip->ap_pool, mip, 
  +                                        mip->parent->perl);
  +            MUTEX_UNLOCK(&mip->mip_lock);
  +            modperl_interp_pool_add(mip, interp);
  +            MP_TRACE_i(MP_FUNC, "cloned new interp\n");
  +            return interp;
  +        }
  +        while (mip->size == mip->in_use) {
  +            MP_TRACE_i(MP_FUNC, "waiting for available interpreter\n");
  +            COND_WAIT(&mip->available, &mip->mip_lock);
  +        }
  +    }
   
       head = mip->head;
   
  @@ -77,6 +97,7 @@
   #endif
               MpInterpIN_USE_On(interp);
               MpInterpPUTBACK_On(interp);
  +            mip->in_use++;
               break;
           }
           else {
  @@ -86,28 +107,19 @@
           }
       }
   
  -    ap_unlock(mip->mip_lock);
  +    MUTEX_UNLOCK(&mip->mip_lock);
   
  -    if (!interp) {
  -        /*
  -         * XXX: options
  -         * -block until one is available
  -         * -clone a new Perl
  -         * - ...
  -         */
  -    }
  -
       return interp;
   }
   
   ap_status_t modperl_interp_pool_destroy(void *data)
   {
       modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data;
  +    modperl_interp_t *interp;
   
  -    while (mip->head) {
  -        modperl_interp_destroy(mip->head);
  -        mip->head->perl = NULL;
  -        mip->head = mip->head->next;
  +    while ((interp = mip->head)) {
  +        modperl_interp_pool_remove(mip, interp);
  +        modperl_interp_destroy(interp);
       }
   
       MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
  @@ -115,54 +127,112 @@
   
       modperl_interp_destroy(mip->parent);
       mip->parent->perl = NULL;
  +
  +    MUTEX_DESTROY(&mip->mip_lock);
   
  -    ap_destroy_lock(mip->mip_lock);
  +    COND_DESTROY(&mip->available);
   
       return APR_SUCCESS;
   }
   
  +void modperl_interp_pool_add(modperl_interp_pool_t *mip,
  +                             modperl_interp_t *interp)
  +{
  +    MUTEX_LOCK(&mip->mip_lock);
  +
  +    if (mip->size == 0) {
  +        mip->head = mip->tail = interp;
  +    }
  +    else {
  +        mip->tail->next = interp;
  +        mip->tail = interp;
  +    }
  +
  +    mip->size++;
  +    MP_TRACE_i(MP_FUNC, "added 0x%lx (size=%d)\n",
  +               (unsigned long)interp, mip->size);
  +
  +    MUTEX_UNLOCK(&mip->mip_lock);
  +}
  +
  +void modperl_interp_pool_remove(modperl_interp_pool_t *mip,
  +                                modperl_interp_t *interp)
  +{
  +    MUTEX_LOCK(&mip->mip_lock);
  +
  +    if (mip->head == interp) {
  +        mip->head = interp->next;
  +        interp->next = NULL;
  +        MP_TRACE_i(MP_FUNC, "shifting head from 0x%lx to 0x%lx\n",
  +                   (unsigned long)interp, (unsigned long)mip->head);
  +    }
  +    else if (mip->tail == interp) {
  +        modperl_interp_t *tmp = mip->head;
  +        /* XXX: implement a prev pointer */
  +        while (tmp->next && tmp->next->next) {
  +            tmp = tmp->next;
  +        }
  +
  +        tmp->next = NULL;
  +        mip->tail = tmp;
  +        MP_TRACE_i(MP_FUNC, "popping tail 0x%lx, now 0x%lx\n",
  +                   (unsigned long)interp, (unsigned long)mip->tail);
  +    }
  +    else {
  +        modperl_interp_t *tmp = mip->head;
  +
  +        while (tmp && tmp->next != interp) {
  +            tmp = tmp->next;
  +        }
  +
  +        if (!tmp) {
  +            MP_TRACE_i(MP_FUNC, "0x%lx not found\n",
  +                       (unsigned long)interp);
  +            MUTEX_UNLOCK(&mip->mip_lock);
  +            return;
  +        }
  +        tmp->next = tmp->next->next;
  +    }
  +
  +    mip->size--;
  +    MP_TRACE_i(MP_FUNC, "removed 0x%lx (size=%d)\n",
  +               (unsigned long)interp, mip->size);
  +
  +    MUTEX_UNLOCK(&mip->mip_lock);
  +}
  +
   void modperl_interp_pool_init(server_rec *s, ap_pool_t *p,
                                 PerlInterpreter *perl)
   {
  +    pTHX;
       MP_dSCFG(s);
       modperl_interp_pool_t *mip = 
           (modperl_interp_pool_t *)ap_pcalloc(p, sizeof(*mip));
  -    modperl_interp_t *cur_interp = NULL;
  -    ap_status_t rc;
       int i;
  -
  -    rc = ap_create_lock(&mip->mip_lock, APR_MUTEX, APR_LOCKALL, "mip", p);
   
  -    if (rc != APR_SUCCESS) {
  -        exit(1); /*XXX*/
  -    }
  -
  -    mip->parent = modperl_interp_new(p, NULL);
  -    mip->parent->perl = perl;
  -    mip->parent->mip_lock = mip->mip_lock;
  +    mip->ap_pool = p;
  +    mip->parent = modperl_interp_new(p, mip, NULL);
  +    aTHX = mip->parent->perl = perl;
  +    
  +    MUTEX_INIT(&mip->mip_lock);
  +    COND_INIT(&mip->available);
   
   #ifdef USE_ITHREADS
       mip->start = 3; /*XXX*/
  -    
  +    mip->max = 4;
  +    mip->max_spare = 3;
  +
       for (i=0; i<mip->start; i++) {
  -        modperl_interp_t *interp = modperl_interp_new(p, mip->parent);
  -        interp->perl = perl_clone(perl, TRUE);
  -        MpInterpCLONED_On(interp);
  +        modperl_interp_t *interp = modperl_interp_new(p, mip, perl);
   
  -        if (cur_interp) {
  -            cur_interp->next = interp;
  -            cur_interp = cur_interp->next;
  -        }
  -        else {
  -            mip->head = cur_interp = interp;
  -        }
  +        modperl_interp_pool_add(mip, interp);
       }
   #endif
   
       MP_TRACE_i(MP_FUNC, "parent == 0x%lx "
  -               "start=%d, min_spare=%d, max_spare=%d\n",
  +               "start=%d, max=%d, min_spare=%d, max_spare=%d\n",
                  (unsigned long)mip->parent, 
  -               mip->start, mip->min_spare, mip->max_spare);
  +               mip->max, mip->start, mip->min_spare, mip->max_spare);
   
       ap_register_cleanup(p, (void*)mip,
                           modperl_interp_pool_destroy, ap_null_cleanup);
  @@ -170,19 +240,34 @@
       scfg->mip = mip;
   }
   
  -
   ap_status_t modperl_interp_unselect(void *data)
   {
       modperl_interp_t *interp = (modperl_interp_t *)data;
  +    modperl_interp_pool_t *mip = interp->mip;
   
  -    ap_lock(interp->mip_lock);
  +    MUTEX_LOCK(&mip->mip_lock);
   
       MpInterpIN_USE_Off(interp);
   
  -    MP_TRACE_i(MP_FUNC, "0x%lx now available\n",
  -               (unsigned long)interp);
  +    mip->in_use--;
  +
  +    MP_TRACE_i(MP_FUNC, "0x%lx now available (%d in use, %d running)\n",
  +               (unsigned long)interp, mip->in_use, mip->size);
  +
  +    if (mip->in_use == (mip->max - 1)) {
  +        MP_TRACE_i(MP_FUNC, "broadcast available\n");
  +        COND_SIGNAL(&mip->available);
  +    }
  +    else if (mip->size > mip->max_spare) {
  +        MP_TRACE_i(MP_FUNC, "throttle down (max_spare=%d, %d running)\n",
  +                   mip->max_spare, mip->size);
  +        MUTEX_UNLOCK(&mip->mip_lock);
  +        modperl_interp_pool_remove(mip, interp);
  +        modperl_interp_destroy(interp);
  +        return APR_SUCCESS;
  +    }
   
  -    ap_unlock(interp->mip_lock);
  +    MUTEX_UNLOCK(&mip->mip_lock);
   
       return APR_SUCCESS;
   }
  
  
  
  1.3       +13 -3     modperl-2.0/src/modules/perl/modperl_interp.h
  
  Index: modperl_interp.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.h,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- modperl_interp.h	2000/04/15 17:51:44	1.2
  +++ modperl_interp.h	2000/04/15 22:43:10	1.3
  @@ -2,7 +2,8 @@
   #define MODPERL_INTERP_H
   
   modperl_interp_t *modperl_interp_new(ap_pool_t *p,
  -                                     modperl_interp_t *parent);
  +                                     modperl_interp_pool_t *mip,
  +                                     PerlInterpreter *perl);
   
   void modperl_interp_destroy(modperl_interp_t *interp);
   
  @@ -10,11 +11,20 @@
   
   modperl_interp_t *modperl_interp_get(server_rec *s);
   
  +ap_status_t modperl_interp_unselect(void *data);
  +
  +int modperl_interp_select(request_rec *r);
  +
  +
   void modperl_interp_pool_init(server_rec *s, ap_pool_t *p,
                                 PerlInterpreter *perl);
   
  -ap_status_t modperl_interp_unselect(void *data);
  +ap_status_t modperl_interp_pool_destroy(void *data);
   
  -int modperl_interp_select(request_rec *r);
  +void modperl_interp_pool_add(modperl_interp_pool_t *mip,
  +                             modperl_interp_t *interp);
  +
  +void modperl_interp_pool_remove(modperl_interp_pool_t *mip,
  +                                modperl_interp_t *interp);
   
   #endif /* MODPERL_INTERP_H */
  
  
  
  1.3       +10 -5     modperl-2.0/src/modules/perl/modperl_types.h
  
  Index: modperl_types.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- modperl_types.h	2000/04/14 23:52:55	1.2
  +++ modperl_types.h	2000/04/15 22:43:10	1.3
  @@ -24,23 +24,28 @@
   /* mod_perl structures */
   
   typedef struct modperl_interp_t modperl_interp_t;
  +typedef struct modperl_interp_pool_t modperl_interp_pool_t;
   
   struct modperl_interp_t {
  -    ap_lock_t *mip_lock;
  +    modperl_interp_pool_t *mip;
       PerlInterpreter *perl;
       modperl_interp_t *next;
       int flags;
   };
   
  -typedef struct {
  -    ap_lock_t *mip_lock;
  +struct modperl_interp_pool_t {
  +    ap_pool_t *ap_pool;
  +    perl_mutex mip_lock;
  +    perl_cond available;
       int start; /* number of Perl intepreters to start (clone) */
       int min_spare; /* minimum number of spare Perl interpreters */
       int max_spare; /* maximum number of spare Perl interpreters */
       int size; /* current number of Perl interpreters */
  +    int max; /* maximum number of Perl interpreters */
  +    int in_use; /* number of Perl interpreters currrently in use */
       modperl_interp_t *parent; /* from which to perl_clone() */
  -    modperl_interp_t *head;
  -} modperl_interp_pool_t;
  +    modperl_interp_t *head, *tail;
  +};
   
   typedef struct {
       MpAV *handlers[MP_PROCESS_NUM_HANDLERS];
  
  
  

Mime
View raw message