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 do...@locus.apache.org on 2000/05/02 01:29:08 UTC

cvs commit: modperl-2.0/src/modules/perl modperl_interp.c modperl_types.h

dougm       00/05/01 16:29:06

  Modified:    src/modules/perl modperl_interp.c modperl_types.h
  Log:
  split interpreter list into two lists, busy and idle
  this cuts out search time for selecting/unselecting
  and keeps used idle interpreters at the head of the list so Perl memory
  allocations are re-used as much as possible
  add interp->num_requests field
  
  Revision  Changes    Path
  1.11      +155 -75   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.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- modperl_interp.c	2000/04/29 02:28:35	1.10
  +++ modperl_interp.c	2000/05/01 23:29:04	1.11
  @@ -7,6 +7,120 @@
   
   #ifdef USE_ITHREADS
   
  +modperl_list_t *modperl_list_new(ap_pool_t *p)
  +{
  +    modperl_list_t *listp = 
  +        (modperl_list_t *)ap_pcalloc(p, sizeof(*listp));
  +    return listp;
  +}
  +
  +void modperl_list_dump(modperl_list_t *listp)
  +{
  +    while (listp->next) {
  +        modperl_interp_t *interp = (modperl_interp_t *)listp->data;
  +        MP_TRACE_i(MP_FUNC, "listp==0x%lx, interp==0x%lx, requests=%d\n",
  +                 (unsigned long)listp, (unsigned long)interp,
  +                 interp->num_requests);
  +        listp = listp->next;
  +    }
  +}
  +
  +modperl_list_t *modperl_list_last(modperl_list_t *list)
  +{
  +    while (list->next) {
  +        list = list->next;
  +    }
  +
  +    return list;
  +}
  +
  +modperl_list_t *modperl_list_first(modperl_list_t *list)
  +{
  +    while (list->prev) {
  +        list = list->prev;
  +    }
  +
  +    return list;
  +}
  +
  +modperl_list_t *
  +modperl_list_append(modperl_list_t *list,
  +                    modperl_list_t *new_list)
  +{
  +    modperl_list_t *last;
  +
  +    new_list->prev = new_list->next = NULL;
  +
  +    if (!list) {
  +        return new_list;
  +    }
  +
  +    last = modperl_list_last(list);
  +
  +    last->next = new_list;
  +    new_list->prev = last;
  +
  +    return list;
  +}
  +
  +modperl_list_t *
  +modperl_list_prepend(modperl_list_t *list,
  +                     modperl_list_t *new_list)
  +{
  +    new_list->prev = new_list->next = NULL;
  +
  +    if (!list) {
  +        return new_list;
  +    }
  +
  +    if (list->prev) {
  +        list->prev->next = new_list;
  +        new_list->prev = list->prev;
  +    }
  +
  +    list->prev = new_list;
  +    new_list->next = list;
  +
  +    return new_list;
  +}
  +
  +modperl_list_t *
  +modperl_list_remove(modperl_list_t *list,
  +                    modperl_list_t *rlist)
  +{
  +    modperl_list_t *tmp = list;
  +  
  +    while (tmp) {
  +        if (tmp != rlist) {
  +            tmp = tmp->next;
  +        }
  +        else {
  +            if (tmp->prev) {
  +                tmp->prev->next = tmp->next;
  +            }
  +            if (tmp->next) {
  +                tmp->next->prev = tmp->prev;
  +            }
  +            if (list == tmp) {
  +                list = list->next;
  +            }
  +
  +            break;
  +	}
  +    }
  +
  +#ifdef MP_TRACE
  +    if (!tmp) {
  +        /* should never happen */
  +        MP_TRACE_i(MP_FUNC, "failed to find 0x%lx in list 0x%lx\n",
  +                   (unsigned long)rlist, (unsigned long)list);
  +        modperl_list_dump(list);
  +    }
  +#endif
  +
  +    return list;
  +}
  +
   modperl_interp_t *modperl_interp_new(ap_pool_t *p,
                                        modperl_interp_pool_t *mip,
                                        PerlInterpreter *perl)
  @@ -74,19 +188,10 @@
   modperl_interp_t *modperl_interp_get(server_rec *s)
   {
       MP_dSCFG(s);
  -    modperl_interp_t *head, *interp = NULL;
  +    modperl_interp_t *interp = NULL;
       modperl_interp_pool_t *mip = scfg->mip;
  +    modperl_list_t *head;
   
  -    if (!mip->head) {
  -        /*
  -         * XXX: no interp pool
  -         * need to lock the interpreter during callbacks
  -         * unless mpm is prefork
  -         */
  -        MP_TRACE_i(MP_FUNC, "no pool, returning parent\n");
  -        return mip->parent;
  -    }
  -
       MUTEX_LOCK(&mip->mip_lock);
   
       if (mip->size == mip->in_use) {
  @@ -96,40 +201,33 @@
               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->idle;
  +    mip->idle = modperl_list_remove(mip->idle, head);
  +    mip->busy = modperl_list_append(mip->busy, head);
   
  -    head = mip->head;
  +    interp = (modperl_interp_t *)head->data;
   
       MP_TRACE_i(MP_FUNC, "head == 0x%lx, parent == 0x%lx\n",
                  (unsigned long)head, (unsigned long)mip->parent);
   
  -    while (head) {
  -        if (!MpInterpIN_USE(head)) {
  -            interp = head;
  -            MP_TRACE_i(MP_FUNC, "selected 0x%lx (perl==0x%lx)\n",
  -                       (unsigned long)interp,
  -                       (unsigned long)interp->perl);
  +    MP_TRACE_i(MP_FUNC, "selected 0x%lx (perl==0x%lx)\n",
  +               (unsigned long)interp,
  +               (unsigned long)interp->perl);
   #ifdef _PTHREAD_H
  -            MP_TRACE_i(MP_FUNC, "pthread_self == 0x%lx\n",
  -                       (unsigned long)pthread_self());
  +    MP_TRACE_i(MP_FUNC, "pthread_self == 0x%lx\n",
  +               (unsigned long)pthread_self());
   #endif
  -            MpInterpIN_USE_On(interp);
  -            mip->in_use++;
  -            break;
  -        }
  -        else {
  -            MP_TRACE_i(MP_FUNC, "0x%lx in use\n",
  -                       (unsigned long)head);
  -            head = head->next;
  -        }
  -    }
   
  +    MpInterpIN_USE_On(interp);
  +    mip->in_use++;
  +
       /* XXX: this should never happen */
       if (!interp) {
           MP_TRACE_i(MP_FUNC, "PANIC: no interpreter found, %d of %d in use\n", 
  @@ -145,13 +243,18 @@
   ap_status_t modperl_interp_pool_destroy(void *data)
   {
       modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data;
  -    modperl_interp_t *interp;
   
  -    while ((interp = mip->head)) {
  -        modperl_interp_pool_remove(mip, interp);
  -        modperl_interp_destroy(interp);
  +    while (mip->idle) {
  +        modperl_interp_destroy((modperl_interp_t *)mip->idle->data);
  +        mip->size--;
  +        mip->idle = mip->idle->next;
       }
   
  +    if (mip->busy) {
  +        MP_TRACE_i(MP_FUNC, "ERROR: %d interpreters still in use\n",
  +                   mip->in_use);
  +    }
  +
       MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
                  (unsigned long)mip->parent);
   
  @@ -168,15 +271,13 @@
   void modperl_interp_pool_add(modperl_interp_pool_t *mip,
                                modperl_interp_t *interp)
   {
  +    modperl_list_t *new_list = modperl_list_new(mip->ap_pool);
  +
       MUTEX_LOCK(&mip->mip_lock);
   
  -    if (mip->size == 0) {
  -        mip->head = mip->tail = interp;
  -    }
  -    else {
  -        mip->tail->next = interp;
  -        mip->tail = interp;
  -    }
  +    interp->listp = new_list;
  +    new_list->data = (void *)interp;
  +    mip->idle = modperl_list_append(mip->idle, new_list);
   
       mip->size++;
       MP_TRACE_i(MP_FUNC, "added 0x%lx (size=%d)\n",
  @@ -189,40 +290,8 @@
                                   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->idle = modperl_list_remove(mip->idle, interp->listp);
   
       mip->size--;
       MP_TRACE_i(MP_FUNC, "removed 0x%lx (size=%d)\n",
  @@ -274,6 +343,16 @@
   
       MUTEX_LOCK(&mip->mip_lock);
   
  +    /* remove from busy list, add back to idle */
  +    /* XXX: sort list on interp->num_requests */
  +    mip->busy = modperl_list_remove(mip->busy, interp->listp);
  +    mip->idle = modperl_list_prepend(mip->idle, interp->listp);
  +
  +    if (!mip->busy) {
  +        MP_TRACE_i(MP_FUNC, "all interpreters idle:\n");
  +        MP_TRACE_i_do(modperl_list_dump(mip->idle));
  +    }
  +
       MpInterpIN_USE_Off(interp);
   
       mip->in_use--;
  @@ -359,6 +438,7 @@
       }
   
       interp = modperl_interp_get(s ? s : r->server);
  +    ++interp->num_requests; /* should only get here once per request */
   
       (void)ap_set_userdata((void *)interp, MP_INTERP_KEY,
                             modperl_interp_unselect,
  
  
  
  1.11      +10 -2     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.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- modperl_types.h	2000/04/27 21:42:25	1.10
  +++ modperl_types.h	2000/05/01 23:29:04	1.11
  @@ -25,6 +25,13 @@
   
   #ifdef USE_ITHREADS
   
  +typedef struct modperl_list_t modperl_list_t;
  +
  +struct modperl_list_t {
  +    modperl_list_t *prev, *next;
  +    void *data;
  +};
  +
   typedef struct modperl_interp_t modperl_interp_t;
   typedef struct modperl_interp_pool_t modperl_interp_pool_t;
   
  @@ -38,7 +45,8 @@
   struct modperl_interp_t {
       modperl_interp_pool_t *mip;
       PerlInterpreter *perl;
  -    modperl_interp_t *next;
  +    modperl_list_t *listp;
  +    int num_requests;
       int flags;
   };
   
  @@ -51,7 +59,7 @@
       int in_use; /* number of Perl interpreters currrently in use */
       int size; /* current number of Perl interpreters */
       modperl_interp_t *parent; /* from which to perl_clone() */
  -    modperl_interp_t *head, *tail;
  +    modperl_list_t *idle, *busy;
   };
   
   #endif /* USE_ITHREADS */