dougm 00/05/23 13:54:47 Modified: lib/ModPerl Code.pm src/modules/perl mod_perl.c mod_perl.h modperl_config.c modperl_config.h modperl_interp.c modperl_types.h Log: integrate with tipool implement PerlInterpMaxRequests Revision Changes Path 1.25 +1 -1 modperl-2.0/lib/ModPerl/Code.pm Index: Code.pm =================================================================== RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v retrieving revision 1.24 retrieving revision 1.25 diff -u -r1.24 -r1.25 --- Code.pm 2000/04/30 18:36:51 1.24 +++ Code.pm 2000/05/23 20:54:42 1.25 @@ -377,7 +377,7 @@ generate_trace => {h => 'modperl_trace.h'}, ); -my @c_src_names = qw(interp log config callback gtop); +my @c_src_names = qw(interp tipool log config callback gtop); my @g_c_names = map { "modperl_$_" } qw(hooks directives xsinit); my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names)); sub c_files { [map { "$_.c" } @c_names, @g_c_names] } 1.14 +2 -0 modperl-2.0/src/modules/perl/mod_perl.c Index: mod_perl.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v retrieving revision 1.13 retrieving revision 1.14 diff -u -r1.13 -r1.14 --- mod_perl.c 2000/04/29 02:37:36 1.13 +++ mod_perl.c 2000/05/23 20:54:44 1.14 @@ -79,6 +79,8 @@ "Max number of spare Perl interpreters"), MP_SRV_CMD_TAKE1("PerlInterpMinSpare", interp_min_spare, "Min number of spare Perl interpreters"), + MP_SRV_CMD_TAKE1("PerlInterpMaxRequests", interp_max_requests, + "Max number of requests per Perl interpreters"), #endif MP_CMD_ENTRIES, { NULL }, 1.14 +1 -0 modperl-2.0/src/modules/perl/mod_perl.h Index: mod_perl.h =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v retrieving revision 1.13 retrieving revision 1.14 diff -u -r1.13 -r1.14 --- mod_perl.h 2000/04/28 20:07:34 1.13 +++ mod_perl.h 2000/05/23 20:54:44 1.14 @@ -34,6 +34,7 @@ #include "modperl_types.h" #include "modperl_config.h" #include "modperl_callback.h" +#include "modperl_tipool.h" #include "modperl_interp.h" #include "modperl_log.h" 1.10 +3 -2 modperl-2.0/src/modules/perl/modperl_config.c Index: modperl_config.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v retrieving revision 1.9 retrieving revision 1.10 diff -u -r1.9 -r1.10 --- modperl_config.c 2000/04/27 21:42:25 1.9 +++ modperl_config.c 2000/05/23 20:54:44 1.10 @@ -119,7 +119,7 @@ #ifdef USE_ITHREADS scfg->interp_pool_cfg = - (modperl_interp_pool_config_t *) + (modperl_tipool_config_t *) ap_pcalloc(p, sizeof(*scfg->interp_pool_cfg)); /* XXX: determine reasonable defaults */ @@ -127,7 +127,7 @@ scfg->interp_pool_cfg->max_spare = 3; scfg->interp_pool_cfg->min_spare = 3; scfg->interp_pool_cfg->max = 5; - + scfg->interp_pool_cfg->max_requests = 2000; #endif /* USE_ITHREADS */ return scfg; @@ -198,5 +198,6 @@ MP_IMP_INTERP_POOL_CFG(max); MP_IMP_INTERP_POOL_CFG(max_spare); MP_IMP_INTERP_POOL_CFG(min_spare); +MP_IMP_INTERP_POOL_CFG(max_requests); #endif /* USE_ITHREADS */ 1.10 +1 -0 modperl-2.0/src/modules/perl/modperl_config.h Index: modperl_config.h =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v retrieving revision 1.9 retrieving revision 1.10 diff -u -r1.9 -r1.10 --- modperl_config.h 2000/04/27 21:42:25 1.9 +++ modperl_config.h 2000/05/23 20:54:44 1.10 @@ -30,6 +30,7 @@ MP_DECLARE_SRV_CMD(interp_max); MP_DECLARE_SRV_CMD(interp_max_spare); MP_DECLARE_SRV_CMD(interp_min_spare); +MP_DECLARE_SRV_CMD(interp_max_requests); #endif #define MP_SRV_CMD_TAKE1(name, item, desc) \ 1.12 +38 -231 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.11 retrieving revision 1.12 diff -u -r1.11 -r1.12 --- modperl_interp.c 2000/05/01 23:29:04 1.11 +++ modperl_interp.c 2000/05/23 20:54:44 1.12 @@ -7,120 +7,6 @@ #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) @@ -139,6 +25,7 @@ #endif interp->perl = perl_clone(perl, FALSE); + { /* XXX: hack for bug fixed in 5.6.1 */ dTHXa(interp->perl); @@ -191,27 +78,8 @@ modperl_interp_t *interp = NULL; modperl_interp_pool_t *mip = scfg->mip; modperl_list_t *head; - - MUTEX_LOCK(&mip->mip_lock); - if (mip->size == mip->in_use) { - if (mip->size < mip->cfg->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"); - } - 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 = modperl_tipool_pop(mip->tipool); interp = (modperl_interp_t *)head->data; MP_TRACE_i(MP_FUNC, "head == 0x%lx, parent == 0x%lx\n", @@ -226,34 +94,16 @@ #endif 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", - mip->in_use, mip->size); - abort(); - } - MUTEX_UNLOCK(&mip->mip_lock); - return interp; } ap_status_t modperl_interp_pool_destroy(void *data) { modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data; - - 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); - } + modperl_tipool_destroy(mip->tipool); + mip->tipool = NULL; MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n", (unsigned long)mip->parent); @@ -261,75 +111,62 @@ modperl_interp_destroy(mip->parent); mip->parent->perl = NULL; - MUTEX_DESTROY(&mip->mip_lock); - - COND_DESTROY(&mip->available); - return APR_SUCCESS; } -void modperl_interp_pool_add(modperl_interp_pool_t *mip, - modperl_interp_t *interp) +static void *interp_pool_grow(modperl_tipool_t *tipool, void *data) { - modperl_list_t *new_list = modperl_list_new(mip->ap_pool); - - MUTEX_LOCK(&mip->mip_lock); - - 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", - (unsigned long)interp, mip->size); - - MUTEX_UNLOCK(&mip->mip_lock); + modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data; + return (void *)modperl_interp_new(mip->ap_pool, mip, mip->parent->perl); } -void modperl_interp_pool_remove(modperl_interp_pool_t *mip, - modperl_interp_t *interp) +static void interp_pool_shrink(modperl_tipool_t *tipool, void *data, + void *item) { - MUTEX_LOCK(&mip->mip_lock); - - mip->idle = modperl_list_remove(mip->idle, interp->listp); - - mip->size--; - MP_TRACE_i(MP_FUNC, "removed 0x%lx (size=%d)\n", - (unsigned long)interp, mip->size); + modperl_interp_destroy((modperl_interp_t *)item); +} - MUTEX_UNLOCK(&mip->mip_lock); +static void interp_pool_dump(modperl_tipool_t *tipool, void *data, + modperl_list_t *listp) +{ + while (listp) { + 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; + } } +static modperl_tipool_vtbl_t interp_pool_func = { + interp_pool_grow, + interp_pool_grow, + interp_pool_shrink, + interp_pool_shrink, + interp_pool_dump, +}; + void modperl_interp_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)); - int i; + modperl_tipool_t *tipool = + modperl_tipool_new(p, scfg->interp_pool_cfg, + &interp_pool_func, mip); + + mip->tipool = tipool; mip->ap_pool = p; mip->server = s; - mip->cfg = scfg->interp_pool_cfg; mip->parent = modperl_interp_new(p, mip, NULL); aTHX = mip->parent->perl = perl; - MUTEX_INIT(&mip->mip_lock); - COND_INIT(&mip->available); + modperl_tipool_init(tipool); - for (i=0; i<mip->cfg->start; i++) { - modperl_interp_t *interp = modperl_interp_new(p, mip, perl); - - modperl_interp_pool_add(mip, interp); - } - - MP_TRACE_i(MP_FUNC, "parent == 0x%lx " - "start=%d, max=%d, min_spare=%d, max_spare=%d\n", - (unsigned long)mip->parent, - mip->cfg->start, mip->cfg->max, - mip->cfg->min_spare, mip->cfg->max_spare); - ap_register_cleanup(p, (void*)mip, modperl_interp_pool_destroy, ap_null_cleanup); @@ -341,46 +178,16 @@ modperl_interp_t *interp = (modperl_interp_t *)data; modperl_interp_pool_t *mip = interp->mip; - 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--; - - 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->cfg->max - 1)) { - MP_TRACE_i(MP_FUNC, "broadcast available\n"); - COND_SIGNAL(&mip->available); - } - else if (mip->size > mip->cfg->max_spare) { - MP_TRACE_i(MP_FUNC, "throttle down (max_spare=%d, %d running)\n", - mip->cfg->max_spare, mip->size); - MUTEX_UNLOCK(&mip->mip_lock); - modperl_interp_pool_remove(mip, interp); - modperl_interp_destroy(interp); - return APR_SUCCESS; - } - MUTEX_UNLOCK(&mip->mip_lock); + modperl_tipool_putback_data(mip->tipool, data, interp->num_requests); return APR_SUCCESS; } /* XXX: * interp is marked as in_use for the lifetime of the pool it is - * stashed in. this is done to avoid the mip->mip_lock whenever + * stashed in. this is done to avoid the tipool->tlock whenever * possible. neither approach is ideal. */ #define MP_INTERP_KEY "MODPERL_INTERP" 1.12 +39 -16 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.11 retrieving revision 1.12 diff -u -r1.11 -r1.12 --- modperl_types.h 2000/05/01 23:29:04 1.11 +++ modperl_types.h 2000/05/23 20:54:46 1.12 @@ -34,32 +34,55 @@ typedef struct modperl_interp_t modperl_interp_t; typedef struct modperl_interp_pool_t modperl_interp_pool_t; +typedef struct modperl_tipool_t modperl_tipool_t; -typedef struct { - 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 max; /* maximum number of Perl interpreters */ -} modperl_interp_pool_config_t; - struct modperl_interp_t { modperl_interp_pool_t *mip; PerlInterpreter *perl; - modperl_list_t *listp; int num_requests; int flags; }; +typedef struct { + /* s == startup grow + * r == runtime grow + */ + void * (*tipool_sgrow)(modperl_tipool_t *tipool, void *data); + void * (*tipool_rgrow)(modperl_tipool_t *tipool, void *data); + void (*tipool_shrink)(modperl_tipool_t *tipool, void *data, + void *item); + void (*tipool_destroy)(modperl_tipool_t *tipool, void *data, + void *item); + void (*tipool_dump)(modperl_tipool_t *tipool, void *data, + modperl_list_t *listp); +} modperl_tipool_vtbl_t; + +typedef struct { + int start; /* number of items to create at startup */ + int min_spare; /* minimum number of spare items */ + int max_spare; /* maximum number of spare items */ + int max; /* maximum number of items */ + int max_requests; /* maximum number of requests per item */ +} modperl_tipool_config_t; + +struct modperl_tipool_t { + perl_mutex tiplock; + perl_cond available; + ap_pool_t *ap_pool; + modperl_list_t *idle, *busy; + int in_use; /* number of items currrently in use */ + int size; /* current number of items */ + void *data; /* user data */ + modperl_tipool_config_t *cfg; + modperl_tipool_vtbl_t *func; +}; + struct modperl_interp_pool_t { ap_pool_t *ap_pool; server_rec *server; - perl_mutex mip_lock; - perl_cond available; - modperl_interp_pool_config_t *cfg; - int in_use; /* number of Perl interpreters currrently in use */ - int size; /* current number of Perl interpreters */ + modperl_tipool_t *tipool; + modperl_tipool_config_t *tipool_cfg; modperl_interp_t *parent; /* from which to perl_clone() */ - modperl_list_t *idle, *busy; }; #endif /* USE_ITHREADS */ @@ -86,7 +109,7 @@ modperl_connection_config_t *connection_cfg; #ifdef USE_ITHREADS modperl_interp_pool_t *mip; - modperl_interp_pool_config_t *interp_pool_cfg; + modperl_tipool_config_t *interp_pool_cfg; #else PerlInterpreter *perl; #endif @@ -117,7 +140,7 @@ int cvgen; /* XXX: for caching */ AV *args; /* XXX: switch to something lighter */ int flags; - PerlInterpreter *perl; /* yuk: for cleanups */ + PerlInterpreter *perl; } modperl_handler_t; #define MP_HANDLER_TYPE_CHAR 1