Joe Schaefer wrote:
"Philippe M. Chiasson" <[EMAIL PROTECTED]> writes:
I've tested it hapilly and it is both a simpler implementation and gets away with quite an annoying bug, so I'd like to see it integrated with a few tweaks.
OK, I've cleaned it up with a few macros as you suggested. Patch below...
- At least one test case for this (check my post http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=109596770111457&w=2
Looks good. It tests fine, so I tried to include it in the patch, but alas:
$ cvs add pool_lifetime.t cvs [server aborted]: "add" requires write access to the repository
Looks good, I am going to give it a spin shortly. Only one note after looking over this patch. I'd keep the definition of mpxs_pool_account_t at the top
typedef struct {
SV *sv;
#ifdef USE_ITHREADS
PerlInterpreter *perl;
modperl_interp_t *interp;
#endif
} mpxs_pool_account_t;instead of having to completely different and separated definitions. It's a small change, but I think it clarify things a little bit. Apart from that, patch does look quite good.
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 30 Sep 2004 01:14:04 -0000
@@ -15,10 +15,6 @@
#define MP_APR_POOL_NEW "APR::Pool::new"
-typedef struct {
- SV *sv;
-} mpxs_pool_account_t;
-
/* XXX: this implementation has a problem with perl ithreads. if a
* custom pool is allocated, and then a thread is spawned we now have
* two copies of the pool object, each living in a different perl
@@ -33,6 +29,82 @@
* that?) may be we can skip those?
*/
+#ifndef MP_SOURCE_SCAN
+#include "apr_optional.h"
+static
+APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
+#endif
+
+
+#define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) (mg_find(sv, PERL_MAGIC_ext) != NULL)
+
+#define MP_APR_POOL_SV_DROPS_OWNERSHIP(acct) do { \
+ dTHXa(acct->perl); \
+ mg_free(acct->sv); \
+ SvIVX(acct->sv) = 0; \
+ if (modperl_opt_interp_unselect && acct->interp) { \
+ /* this will decrement the interp refcnt until \
+ * there are no more references, in which case \
+ * the interpreter will be putback into the mip \
+ */ \
+ (void)modperl_opt_interp_unselect(acct->interp); \
+ } \
+} while (0)
+
+
+#ifdef USE_ITHREADS
+
+typedef struct {
+ SV *sv;
+ PerlInterpreter *perl;
+ modperl_interp_t *interp;
+} mpxs_pool_account_t;
+
+
+#define MP_APR_POOL_SV_TAKES_OWNERSHIP(SV, P) do { \
+ mpxs_pool_account_t *acct = apr_palloc(P, sizeof *acct); \
+ acct->sv = SV; \
+ acct->perl = aTHX; \
+ SvIVX(SV) = PTR2IV(P); \
+ \
+ sv_magic(SV, Nullsv, PERL_MAGIC_ext, \
+ MP_APR_POOL_NEW, sizeof(MP_APR_POOL_NEW)); \
+ \
+ apr_pool_cleanup_register(P, (void *)acct, \
+ mpxs_apr_pool_cleanup, \
+ apr_pool_cleanup_null); \
+ \
+ /* make sure interpreter is not putback into the mip \
+ * until this cleanup has run. \
+ */ \
+ if ((acct->interp = MP_THX_INTERP_GET(aTHX))) { \
+ acct->interp->refcnt++; \
+ } \
+} while (0)
+
+#else
+
+typedef struct {
+ SV *sv;
+} mpxs_pool_account_t;
+
+
+#define MP_APR_POOL_SV_TAKES_OWNERSHIP(SV, P) do { \
+ mpxs_pool_account_t *acct = apr_palloc(P, sizeof *acct); \
+ acct->sv = SV; \
+ SvIVX(SV) = PTR2IV(P); \
+ \
+ sv_magic(SV, Nullsv, PERL_MAGIC_ext, \
+ MP_APR_POOL_NEW, sizeof(MP_APR_POOL_NEW)); \
+ \
+ apr_pool_cleanup_register(P, (void *)acct, \
+ mpxs_apr_pool_cleanup, \
+ apr_pool_cleanup_null); \
+} while (0)
+
+#endif
+
+
/* XXX: should we make it a new global tracing category
* MOD_PERL_TRACE=p for tracing pool management? */
#define MP_POOL_TRACE_DO 0
@@ -50,26 +122,8 @@
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;
+ MP_APR_POOL_SV_DROPS_OWNERSHIP(acct);
MP_APR_POOL_SV_DROPS_OWNERSHIP((mpxs_pool_account_t *)cleanup_data)
return APR_SUCCESS;
}
@@ -116,9 +170,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 +190,13 @@
#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);
- data->sv = SvRV(rv);
+ MP_APR_POOL_SV_TAKES_OWNERSHIP(sv, child_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);
+ (unsigned long)child_pool, sv, rv);
return rv;
}
@@ -158,10 +205,9 @@
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);
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
- if (!(data && data->sv)) {
+ if (!MP_APR_POOL_SV_HAS_OWNERSHIP(sv)) {
MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
(unsigned long)p);
apr_pool_clear(p);
@@ -171,20 +217,15 @@
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 cleanups, 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);
-
- /* reinstall the user data */
- apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
+ MP_APR_POOL_SV_TAKES_OWNERSHIP(sv, p);
}
@@ -203,11 +244,6 @@
* @param data internal storage
*/
-#ifndef MP_SOURCE_SCAN
-#include "apr_optional.h"
-static
-APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
-#endif
static apr_status_t mpxs_cleanup_run(void *data)
{
@@ -294,30 +330,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",
@@ -330,42 +343,14 @@
* destroy a pool
* @param obj an APR::Pool object
*/
+
static MP_INLINE void mpxs_apr_pool_DESTROY(pTHX_ SV *obj)
{
- apr_pool_t *p;
SV *sv = SvRV(obj);
- /* 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");
- return;
- }
-
- if (sv && SvOK(sv)) {
- mpxs_pool_account_t *data;
-
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
- if (!(data && data->sv)) {
- MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: no sv found");
- return;
- }
-
- if (SvREFCNT(sv) == 1) {
- MP_POOL_TRACE(MP_FUNC, "call apr_pool_destroy: last reference");
- apr_pool_destroy(p);
- }
- else {
- /* when the pool object dies, sv's ref count decrements
- * itself automatically */
- MP_POOL_TRACE(MP_FUNC,
- "skip apr_pool_destroy: refcount > 1 (%d)",
- SvREFCNT(sv));
- }
+ if (MP_APR_POOL_SV_HAS_OWNERSHIP(sv)) {
+ apr_pool_t *p = mpxs_sv_object_deref(obj, apr_pool_t);
+ apr_pool_destroy(p);
}
}
-- -------------------------------------------------------------------------------- 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]
