develooper Front page | perl.perl5.porters | Postings from May 2002

[PATCH] Storable (Re: perl@16433)

From:
Radu Greab
Date:
May 7, 2002 01:37
Subject:
[PATCH] Storable (Re: perl@16433)
Message ID:
15575.37423.446700.9930@ix.netsoft.ro
On Mon, 6 May 2002 17:22 -0700, Gurusamy Sarathy wrote:
 > On Mon, 06 May 2002 23:21:47 BST, Nicholas Clark wrote:
 > >As Storable already passes a context object around to make itself thread
 > >safe,
 > 
 > This "non-standard" context object (really just an old iteration of
 > the MY_CXT stuff) should be reworked to use the standard MY_CXT macros
 > that use an SV to allocate their space.

Teaching Storable the standard MY_CXT macros may be too much work
because Storable uses contexts not only for thread-safeness, but also
for recursive invocations. So, Storable needs to manage more contexts
per interpreter and the MY_CXT macros may not be powerfull enough to
support this situation.

With the patch below all tests pass and the leaks are gone. Following
the MY_CXT macros example all contexts use now a blessed SV and the
root context is cleaned automatically.


Thanks,
Radu Greab


--- perl/ext/Storable/Storable.xs.orig	Tue May  7 02:41:38 2002
+++ perl/ext/Storable/Storable.xs	Tue May  7 10:37:36 2002
@@ -349,9 +349,19 @@
 	int ver_major;		/* major of version for retrieved object */
 	int ver_minor;		/* minor of version for retrieved object */
 	SV *(**retrieve_vtbl)();	/* retrieve dispatch table */
-	struct stcxt *prev;	/* contexts chained backwards in real recursion */
+	SV *prev;		/* contexts chained backwards in real recursion */
+	SV *my_sv;		/* the blessed scalar who's SvPVX() I am */
 } stcxt_t;
 
+#define NEW_STORABLE_CXT_OBJ(cxt) do {				\
+	SV *self = newSV(sizeof(stcxt_t) - 1);			\
+	SV *my_sv = newRV_noinc(self);				\
+	sv_bless(my_sv, gv_stashpv("Storable::Cxt", TRUE));	\
+	cxt = (stcxt_t *)SvPVX(self);				\
+	Zero(cxt, 1, stcxt_t);					\
+	cxt->my_sv = my_sv;					\
+} while(0)
+
 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
 
 #if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
@@ -364,20 +374,20 @@
 #endif	/* < perl5.004_68 */
 
 #define dSTCXT_PTR(T,name)							\
-	T name = ((perinterp_sv && SvIOK(perinterp_sv)	\
-				? INT2PTR(T, SvIVX(perinterp_sv)) : (T) 0))
+	T name = ((perinterp_sv && SvIOK(perinterp_sv) && SvIVX(perinterp_sv)	\
+				? (T)SvPVX(SvRV((SV*)SvIVX(perinterp_sv))) : (T) 0))
 #define dSTCXT										\
 	dSTCXT_SV;										\
 	dSTCXT_PTR(stcxt_t *, cxt)
 
-#define INIT_STCXT									\
-      dSTCXT;										\
-      Newz(0, cxt, 1, stcxt_t);						\
-      sv_setiv(perinterp_sv, PTR2IV(cxt))
+#define INIT_STCXT							\
+	dSTCXT;								\
+	NEW_STORABLE_CXT_OBJ(cxt);					\
+	sv_setiv(perinterp_sv, PTR2IV(cxt->my_sv))
 
 #define SET_STCXT(x) do {							\
 	dSTCXT_SV;										\
-	sv_setiv(perinterp_sv, PTR2IV(x));				\
+	sv_setiv(perinterp_sv, PTR2IV(x->my_sv));				\
 } while (0)
 
 #else /* !MULTIPLICITY && !PERL_OBJECT && !PERL_CAPI */
@@ -385,8 +395,11 @@
 static stcxt_t Context;
 static stcxt_t *Context_ptr = &Context;
 #define dSTCXT			stcxt_t *cxt = Context_ptr
-#define INIT_STCXT		dSTCXT
-#define SET_STCXT(x)	Context_ptr = x
+#define INIT_STCXT							\
+	dSTCXT;								\
+	NEW_STORABLE_CXT_OBJ(cxt)
+
+#define SET_STCXT(x)		Context_ptr = x
 
 #endif /* MULTIPLICITY || PERL_OBJECT || PERL_CAPI */
 
@@ -1348,8 +1361,8 @@
 
 	ASSERT(!parent_cxt->s_dirty, ("parent context clean"));
 
-	Newz(0, cxt, 1, stcxt_t);
-	cxt->prev = parent_cxt;
+	NEW_STORABLE_CXT_OBJ(cxt);
+	cxt->prev = parent_cxt->my_sv;
 	SET_STCXT(cxt);
 
 	ASSERT(!cxt->s_dirty, ("clean context"));
@@ -1366,19 +1379,14 @@
 static void free_context(cxt)
 stcxt_t *cxt;
 {
-	stcxt_t *prev = cxt->prev;
+	stcxt_t *prev = (stcxt_t *)(cxt->prev ? SvPVX(SvRV(cxt->prev)) : 0);
 
 	TRACEME(("free_context"));
 
 	ASSERT(!cxt->s_dirty, ("clean context"));
 	ASSERT(prev, ("not freeing root context"));
 
-	if (kbuf)
-		Safefree(kbuf);
-	if (mbase)
-		Safefree(mbase);
-
-	Safefree(cxt);
+	SvREFCNT_dec(cxt->my_sv);
 	SET_STCXT(prev);
 
 	ASSERT(cxt, ("context not void"));
@@ -5419,6 +5427,22 @@
 #define InputStream		PerlIO *
 #endif	/* !OutputStream */
 
+MODULE = Storable	PACKAGE = Storable::Cxt
+
+void
+DESTROY(self)
+    SV *self
+PREINIT:
+	stcxt_t *cxt = (stcxt_t *)SvPVX(SvRV(self));
+PPCODE:
+	if (kbuf)
+		Safefree(kbuf);
+	if (!cxt->membuf_ro && mbase)
+		Safefree(mbase);
+	if (cxt->membuf_ro && (cxt->msaved).arena)
+		Safefree((cxt->msaved).arena);
+
+
 MODULE = Storable	PACKAGE = Storable
 
 PROTOTYPES: ENABLE



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About