Forgot to mention I want to test this patch and look thru it carefully before it goes in. Won't have time to get to it today, but I'll get around it tomorrow.
Joe Schaefer wrote:
? config.nice
? pool.patch
? t/core.21302
Index: xs/APR/Pool/APR__Pool.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
retrieving revision 1.17
diff -u -r1.17 APR__Pool.h
--- xs/APR/Pool/APR__Pool.h 14 Jul 2004 23:15:01 -0000 1.17
+++ xs/APR/Pool/APR__Pool.h 28 Sep 2004 21:32:32 -0000
@@ -17,6 +17,7 @@
typedef struct {
SV *sv;
+ PerlInterpreter *perl;
} mpxs_pool_account_t;
/* XXX: this implementation has a problem with perl ithreads. if a
@@ -50,26 +51,10 @@
static MP_INLINE apr_status_t
mpxs_apr_pool_cleanup(void *cleanup_data)
{
- mpxs_pool_account_t *data;
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW,
- (apr_pool_t *)cleanup_data);
- if (!(data && data->sv)) {
- /* if there is no data, there is nothing to unset */
- MP_POOL_TRACE(MP_FUNC, "this pool seems to be destroyed already");
- }
- else {
- MP_POOL_TRACE(MP_FUNC,
- "pool 0x%lx contains a valid sv 0x%lx, invalidating it",
- (unsigned long)data->sv, (unsigned long)cleanup_data);
-
- /* invalidate all Perl objects referencing this sv */
- SvIVX(data->sv) = 0;
-
- /* invalidate the reference stored in the pool */
- data->sv = NULL;
- /* data->sv will go away by itself when all objects will go away */
- }
-
+ mpxs_pool_account_t *acct = cleanup_data;
+ dTHXa(acct->perl);
+ mg_free(acct->sv);
+ SvIVX(acct->sv) = 0;
return APR_SUCCESS;
}
@@ -116,9 +101,6 @@
* mess, trying to destroy an already destroyed pool or even worse
* a pool allocate in the place of the old one.
*/
- apr_pool_cleanup_register(child_pool, (void *)child_pool,
- mpxs_apr_pool_cleanup,
- apr_pool_cleanup_null);
#if APR_POOL_DEBUG
/* child <-> parent <-> ... <-> top ancestry traversal */
{
@@ -139,17 +121,22 @@
#endif
{
- mpxs_pool_account_t *data =
- (mpxs_pool_account_t *)apr_pcalloc(child_pool, sizeof(*data));
-
SV *rv = sv_setref_pv(NEWSV(0, 0), "APR::Pool", (void*)child_pool);
+ SV *sv = SvRV(rv);
+ mpxs_pool_account_t *acct = apr_palloc(child_pool, sizeof *acct);
- data->sv = SvRV(rv);
+ acct->sv = sv;
+ acct->perl = aTHX;
+
+ sv_magic(sv, Nullsv, PERL_MAGIC_ext, "APR::Pool", sizeof("APR::Pool"));
- MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
- (unsigned long)child_pool, data->sv, rv);
- apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, child_pool);
+ apr_pool_cleanup_register(child_pool, (void *)acct,
+ mpxs_apr_pool_cleanup,
+ apr_pool_cleanup_null);
+
+ MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
+ (unsigned long)child_pool, sv, rv);
return rv;
}
@@ -158,10 +145,10 @@
static MP_INLINE void mpxs_APR__Pool_clear(pTHX_ SV *obj)
{
apr_pool_t *p = mp_xs_sv2_APR__Pool(obj);
- mpxs_pool_account_t *data;
+ SV *sv = SvRV(obj);
+ mpxs_pool_account_t *acct;
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
- if (!(data && data->sv)) {
+ if (mg_find(sv, PERL_MAGIC_ext) == NULL) {
MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
(unsigned long)p);
apr_pool_clear(p);
@@ -171,20 +158,24 @@
MP_POOL_TRACE(MP_FUNC,
"parent pool (0x%lx) is a custom pool, sv 0x%lx",
(unsigned long)p,
- (unsigned long)data->sv);
+ (unsigned long)sv);
apr_pool_clear(p);
- /* apr_pool_clear removes all the user data, so we need to restore
+ /* apr_pool_clear removes all the cleanup, so we need to restore
* it. Since clear triggers mpxs_apr_pool_cleanup call, our
* object's guts get nuked too, so we need to restore them too */
/* this is sv_setref_pv, but for an existing object */
- sv_setiv(newSVrv(obj, "APR::Pool"), PTR2IV((void*)p));
- data->sv = SvRV(obj);
+ sv_magic(sv, Nullsv, PERL_MAGIC_ext, "APR::Pool", sizeof("APR::Pool"));
+ SvIVX(sv) = (IV)p;
+ acct = apr_palloc(p, sizeof *acct);
+ acct->sv = sv;
+ acct->perl = aTHX;
- /* reinstall the user data */
- apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
+ apr_pool_cleanup_register(p, (void *)acct,
+ mpxs_apr_pool_cleanup,
+ apr_pool_cleanup_null);
}
@@ -294,30 +285,7 @@
apr_pool_t *parent_pool = apr_pool_parent_get(child_pool);
if (parent_pool) {
- /* ideally this should be done by mp_xs_APR__Pool_2obj. Though
- * since most of the time we don't use custom pools, we don't
- * want the overhead of reading and writing pool's userdata in
- * the general case. therefore we do it here and in
- * mpxs_apr_pool_create. Though if there are any other
- * functions, that return perl objects whose guts include a
- * reference to a custom pool, they must do the ref-counting
- * as well.
- */
- mpxs_pool_account_t *data;
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, parent_pool);
- if (data && data->sv) {
- MP_POOL_TRACE(MP_FUNC,
- "parent pool (0x%lx) is a custom pool, sv 0x%lx",
- (unsigned long)parent_pool,
- (unsigned long)data->sv);
-
- return newRV_inc(data->sv);
- }
- else {
- MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
- (unsigned long)parent_pool);
- return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
- }
+ return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
}
else {
MP_POOL_TRACE(MP_FUNC, "pool (0x%lx) has no parents",
@@ -335,11 +303,18 @@
apr_pool_t *p;
SV *sv = SvRV(obj);
+ p = mpxs_sv_object_deref(obj, apr_pool_t);
+
+ if (mg_find(sv, PERL_MAGIC_ext))
+ apr_pool_destroy(p);
+
+#if 0
+
/* MP_POOL_TRACE(MP_FUNC, "DESTROY 0x%lx-0x%lx", */
/* (unsigned long)obj,(unsigned long)sv); */
/* do_sv_dump(0, Perl_debug_log, obj, 0, 4, FALSE, 0); */
- p = mpxs_sv_object_deref(obj, apr_pool_t);
+
if (!p) {
/* non-custom pool */
MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: not a custom pool");
@@ -367,5 +342,7 @@
SvREFCNT(sv));
}
}
+
+#endif
}
------------------------------------------------------------------------
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
-- -------------------------------------------------------------------------------- Philippe M. Chiasson m/gozer\@(apache|cpan|ectoplasm)\.org/ GPG KeyID : 88C3A5A5 http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3A5A5
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
