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/23 22:54:47 UTC
cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h modperl_config.c modperl_config.h modperl_interp.c modperl_types.h
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