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];
