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