[PATHC] sharedsv.[c|h]
Jarkko Hietaniemi [Mon, 13 Aug 2001 12:45:21 +0000 (12:45 +0000)]
From: "Artur Bergman" <artur@contiller.se>
Date: Mon, 13 Aug 2001 14:38:41 +0200
Message-ID: <005401c123f4$e1f53360$21000a0a@vogw2kdev>

Subject: [PATCH] embed.pl
From: Arthur Bergman <arthur@contiller.se>
Date: Mon, 13 Aug 2001 14:38:14 +0200
Message-ID: <B79D96D6.3088%arthur@contiller.se>

Subject: [PATCH] sharedsv cleanups
From: "Arthur Bergman" <arthur@contiller.se>
Date: Mon, 13 Aug 2001 15:14:25 +0200
Message-ID: <005a01c123f9$dfe525d0$21000a0a@vogw2kdev>

Plus few tweaks: _init needs to be Adp, the prototypes
should not be revealed unless using ithreads, #endif FOO
must be #endif /* FOO */, adding (parentheses) around
do { } while doesn't work too well.

p4raw-id: //depot/perl@11659

12 files changed:
MANIFEST
Makefile.SH
embed.h
embed.pl
global.sym
objXSUB.h
perl.h
perlapi.c
pod/perlapi.pod
proto.h
sharedsv.c [new file with mode: 0644]
sharedsv.h [new file with mode: 0644]

index 991999b..9b9b265 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1849,6 +1849,8 @@ regnodes.h                        Description of nodes of RE engine
 run.c                          The interpreter loop
 scope.c                                Scope entry and exit code
 scope.h                                Scope entry and exit header
+sharedsv.c                     ithreads-shared scalar values code
+sharedsv.h                     ithreads-shared scalar values header
 sv.c                           Scalar value code
 sv.h                           Scalar value header
 t/base/cond.t                  See if conditionals work
index c44837d..64081d7 100644 (file)
@@ -266,19 +266,19 @@ h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
 h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
 h3 = opcode.h patchlevel.h perl.h perlapi.h perly.h pp.h proto.h regcomp.h
 h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
-h5 = utf8.h warnings.h
+h5 = utf8.h warnings.h sharedsv.h
 h = $(h1) $(h2) $(h3) $(h4) $(h5)
 
 c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c
 c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c
 c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c xsutils.c
-c4 = globals.c perlio.c perlapi.c numeric.c locale.c pp_pack.c
+c4 = globals.c perlio.c perlapi.c numeric.c locale.c pp_pack.c sharedsv.c
 
 c = $(c1) $(c2) $(c3) $(c4) miniperlmain.c perlmain.c
 
 obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT)
 obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
-obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) xsutils$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT)
+obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) xsutils$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) sharedsv$(OBJ_EXT)
 
 obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
 
diff --git a/embed.h b/embed.h
index 9093f9b..a83e0b8 100644 (file)
--- a/embed.h
+++ b/embed.h
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at         S_save_scalar_at
 #endif
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#define sharedsv_init          Perl_sharedsv_init
+#define sharedsv_new           Perl_sharedsv_new
+#define sharedsv_find          Perl_sharedsv_find
+#define sharedsv_lock          Perl_sharedsv_lock
+#define sharedsv_unlock                Perl_sharedsv_unlock
+#define sharedsv_unlock_scope  Perl_sharedsv_unlock_scope
+#define sharedsv_thrcnt_inc    Perl_sharedsv_thrcnt_inc
+#define sharedsv_thrcnt_dec    Perl_sharedsv_thrcnt_dec
+#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #define asIV                   S_asIV
 #define asUV                   S_asUV
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at(a)      S_save_scalar_at(aTHX_ a)
 #endif
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#define sharedsv_init()                Perl_sharedsv_init(aTHX)
+#define sharedsv_new()         Perl_sharedsv_new(aTHX)
+#define sharedsv_find(a)       Perl_sharedsv_find(aTHX_ a)
+#define sharedsv_lock(a)       Perl_sharedsv_lock(aTHX_ a)
+#define sharedsv_unlock(a)     Perl_sharedsv_unlock(aTHX_ a)
+#define sharedsv_unlock_scope(a)       Perl_sharedsv_unlock_scope(aTHX_ a)
+#define sharedsv_thrcnt_inc(a) Perl_sharedsv_thrcnt_inc(aTHX_ a)
+#define sharedsv_thrcnt_dec(a) Perl_sharedsv_thrcnt_dec(aTHX_ a)
+#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #define asIV(a)                        S_asIV(aTHX_ a)
 #define asUV(a)                        S_asUV(aTHX_ a)
 #define S_save_scalar_at       CPerlObj::S_save_scalar_at
 #define save_scalar_at         S_save_scalar_at
 #endif
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#define Perl_sharedsv_init     CPerlObj::Perl_sharedsv_init
+#define sharedsv_init          Perl_sharedsv_init
+#define Perl_sharedsv_new      CPerlObj::Perl_sharedsv_new
+#define sharedsv_new           Perl_sharedsv_new
+#define Perl_sharedsv_find     CPerlObj::Perl_sharedsv_find
+#define sharedsv_find          Perl_sharedsv_find
+#define Perl_sharedsv_lock     CPerlObj::Perl_sharedsv_lock
+#define sharedsv_lock          Perl_sharedsv_lock
+#define Perl_sharedsv_unlock   CPerlObj::Perl_sharedsv_unlock
+#define sharedsv_unlock                Perl_sharedsv_unlock
+#define Perl_sharedsv_unlock_scope     CPerlObj::Perl_sharedsv_unlock_scope
+#define sharedsv_unlock_scope  Perl_sharedsv_unlock_scope
+#define Perl_sharedsv_thrcnt_inc       CPerlObj::Perl_sharedsv_thrcnt_inc
+#define sharedsv_thrcnt_inc    Perl_sharedsv_thrcnt_inc
+#define Perl_sharedsv_thrcnt_dec       CPerlObj::Perl_sharedsv_thrcnt_dec
+#define sharedsv_thrcnt_dec    Perl_sharedsv_thrcnt_dec
+#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #define S_asIV                 CPerlObj::S_asIV
 #define asIV                   S_asIV
index 60d0046..71144cb 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2469,6 +2469,17 @@ s        |void   |debprof        |OP *o
 s      |SV*    |save_scalar_at |SV **sptr
 #endif
 
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+Adp    |void        |sharedsv_init
+Adp    |shared_sv*    |sharedsv_new
+Adp    |shared_sv*    |sharedsv_find        |SV* sv
+Adp    |void        |sharedsv_lock        |shared_sv* ssv
+Adp    |void        |sharedsv_unlock    |shared_sv* ssv
+p      |void        |sharedsv_unlock_scope    |shared_sv* ssv
+Adp    |void        |sharedsv_thrcnt_inc    |shared_sv* ssv
+Adp    |void        |sharedsv_thrcnt_dec    |shared_sv* ssv
+#endif
+
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 s      |IV     |asIV           |SV* sv
 s      |UV     |asUV           |SV* sv
index 73493c3..13c1968 100644 (file)
@@ -578,6 +578,13 @@ Perl_ptr_table_clear
 Perl_ptr_table_free
 Perl_sys_intern_clear
 Perl_sys_intern_init
+Perl_sharedsv_init
+Perl_sharedsv_new
+Perl_sharedsv_find
+Perl_sharedsv_lock
+Perl_sharedsv_unlock
+Perl_sharedsv_thrcnt_inc
+Perl_sharedsv_thrcnt_dec
 Perl_sv_setsv_flags
 Perl_sv_catpvn_flags
 Perl_sv_catsv_flags
index 564bd9c..f67daed 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #endif
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #endif
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#undef  Perl_sharedsv_init
+#define Perl_sharedsv_init     pPerl->Perl_sharedsv_init
+#undef  sharedsv_init
+#define sharedsv_init          Perl_sharedsv_init
+#undef  Perl_sharedsv_new
+#define Perl_sharedsv_new      pPerl->Perl_sharedsv_new
+#undef  sharedsv_new
+#define sharedsv_new           Perl_sharedsv_new
+#undef  Perl_sharedsv_find
+#define Perl_sharedsv_find     pPerl->Perl_sharedsv_find
+#undef  sharedsv_find
+#define sharedsv_find          Perl_sharedsv_find
+#undef  Perl_sharedsv_lock
+#define Perl_sharedsv_lock     pPerl->Perl_sharedsv_lock
+#undef  sharedsv_lock
+#define sharedsv_lock          Perl_sharedsv_lock
+#undef  Perl_sharedsv_unlock
+#define Perl_sharedsv_unlock   pPerl->Perl_sharedsv_unlock
+#undef  sharedsv_unlock
+#define sharedsv_unlock                Perl_sharedsv_unlock
+#undef  Perl_sharedsv_thrcnt_inc
+#define Perl_sharedsv_thrcnt_inc       pPerl->Perl_sharedsv_thrcnt_inc
+#undef  sharedsv_thrcnt_inc
+#define sharedsv_thrcnt_inc    Perl_sharedsv_thrcnt_inc
+#undef  Perl_sharedsv_thrcnt_dec
+#define Perl_sharedsv_thrcnt_dec       pPerl->Perl_sharedsv_thrcnt_dec
+#undef  sharedsv_thrcnt_dec
+#define sharedsv_thrcnt_dec    Perl_sharedsv_thrcnt_dec
+#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #  ifdef DEBUGGING
 #  endif
diff --git a/perl.h b/perl.h
index 8a61139..5cd8b7b 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2195,6 +2195,7 @@ typedef I32 (*filter_t) (pTHXo_ int, SV *, int);
 #include "scope.h"
 #include "warnings.h"
 #include "utf8.h"
+#include "sharedsv.h"
 
 /* Current curly descriptor */
 typedef struct curcur CURCUR;
index 9b90154..ec2ee38 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -4266,6 +4266,57 @@ Perl_sys_intern_init(pTHXo)
 #endif
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #endif
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+
+#undef  Perl_sharedsv_init
+void
+Perl_sharedsv_init(pTHXo)
+{
+    ((CPerlObj*)pPerl)->Perl_sharedsv_init();
+}
+
+#undef  Perl_sharedsv_new
+shared_sv*
+Perl_sharedsv_new(pTHXo)
+{
+    return ((CPerlObj*)pPerl)->Perl_sharedsv_new();
+}
+
+#undef  Perl_sharedsv_find
+shared_sv*
+Perl_sharedsv_find(pTHXo_ SV* sv)
+{
+    return ((CPerlObj*)pPerl)->Perl_sharedsv_find(sv);
+}
+
+#undef  Perl_sharedsv_lock
+void
+Perl_sharedsv_lock(pTHXo_ shared_sv* ssv)
+{
+    ((CPerlObj*)pPerl)->Perl_sharedsv_lock(ssv);
+}
+
+#undef  Perl_sharedsv_unlock
+void
+Perl_sharedsv_unlock(pTHXo_ shared_sv* ssv)
+{
+    ((CPerlObj*)pPerl)->Perl_sharedsv_unlock(ssv);
+}
+
+#undef  Perl_sharedsv_thrcnt_inc
+void
+Perl_sharedsv_thrcnt_inc(pTHXo_ shared_sv* ssv)
+{
+    ((CPerlObj*)pPerl)->Perl_sharedsv_thrcnt_inc(ssv);
+}
+
+#undef  Perl_sharedsv_thrcnt_dec
+void
+Perl_sharedsv_thrcnt_dec(pTHXo_ shared_sv* ssv)
+{
+    ((CPerlObj*)pPerl)->Perl_sharedsv_thrcnt_dec(ssv);
+}
+#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #  ifdef DEBUGGING
 #  endif
index e41cf8a..57e3f5c 100644 (file)
@@ -1344,6 +1344,17 @@ SV is B<not> incremented.
 =for hackers
 Found in file sv.c
 
+=item newSV
+
+Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
+with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
+macro.
+
+       SV*     newSV(STRLEN len)
+
+=for hackers
+Found in file sv.c
+
 =item NEWSV
 
 Creates a new SV.  A non-zero C<len> parameter indicates the number of
@@ -1357,17 +1368,6 @@ C<id> is an integer id between 0 and 1299 (used to identify leaks).
 =for hackers
 Found in file handy.h
 
-=item newSV
-
-Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
-with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
-macro.
-
-       SV*     newSV(STRLEN len)
-
-=for hackers
-Found in file sv.c
-
 =item newSViv
 
 Creates a new SV and copies an integer into it.  The reference count for the
@@ -1870,6 +1870,70 @@ L<perlcall>.
 =for hackers
 Found in file scope.h
 
+=item sharedsv_find
+
+Tries to find if a given SV has a shared backend, either by
+looking at magic, or by checking if it is tied again threads::shared.
+
+       shared_sv*      sharedsv_find(SV* sv)
+
+=for hackers
+Found in file sharedsv.c
+
+=item sharedsv_init
+
+Saves a space for keeping SVs wider than an interpreter,
+currently only stores a pointer to the first interpreter.
+
+       void    sharedsv_init()
+
+=for hackers
+Found in file sharedsv.c
+
+=item sharedsv_lock
+
+Recursive locks on a sharedsv.
+Locks are dynamicly scoped at the level of the first lock.
+       void    sharedsv_lock(shared_sv* ssv)
+
+=for hackers
+Found in file sharedsv.c
+
+=item sharedsv_new
+
+Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
+       shared_sv*      sharedsv_new()
+
+=for hackers
+Found in file sharedsv.c
+
+=item sharedsv_thrcnt_dec
+
+Decrements the threadcount of a shared sv. When a threads frontend is freed
+this function should be called.
+
+       void    sharedsv_thrcnt_dec(shared_sv* ssv)
+
+=for hackers
+Found in file sharedsv.c
+
+=item sharedsv_thrcnt_inc
+
+Increments the threadcount of a sharedsv.
+       void    sharedsv_thrcnt_inc(shared_sv* ssv)
+
+=for hackers
+Found in file sharedsv.c
+
+=item sharedsv_unlock
+
+Recursively unlocks a shared sv.
+
+       void    sharedsv_unlock(shared_sv* ssv)
+
+=for hackers
+Found in file sharedsv.c
+
 =item SP
 
 Stack pointer.  This is usually handled by C<xsubpp>.  See C<dSP> and
@@ -2664,19 +2728,19 @@ false, defined or undefined.  Does not handle 'get' magic.
 =for hackers
 Found in file sv.h
 
-=item SvTYPE
-
-Returns the type of the SV.  See C<svtype>.
+=item svtype
 
-       svtype  SvTYPE(SV* sv)
+An enum of flags for Perl types.  These are found in the file B<sv.h> 
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
 =for hackers
 Found in file sv.h
 
-=item svtype
+=item SvTYPE
 
-An enum of flags for Perl types.  These are found in the file B<sv.h> 
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV.  See C<svtype>.
+
+       svtype  SvTYPE(SV* sv)
 
 =for hackers
 Found in file sv.h
diff --git a/proto.h b/proto.h
index def3db1..06ce95a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1197,6 +1197,17 @@ STATIC void      S_debprof(pTHX_ OP *o);
 STATIC SV*     S_save_scalar_at(pTHX_ SV **sptr);
 #endif
 
+#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+PERL_CALLCONV void     Perl_sharedsv_init(pTHX);
+PERL_CALLCONV shared_sv*       Perl_sharedsv_new(pTHX);
+PERL_CALLCONV shared_sv*       Perl_sharedsv_find(pTHX_ SV* sv);
+PERL_CALLCONV void     Perl_sharedsv_lock(pTHX_ shared_sv* ssv);
+PERL_CALLCONV void     Perl_sharedsv_unlock(pTHX_ shared_sv* ssv);
+PERL_CALLCONV void     Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv);
+PERL_CALLCONV void     Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv);
+PERL_CALLCONV void     Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv);
+#endif
+
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 STATIC IV      S_asIV(pTHX_ SV* sv);
 STATIC UV      S_asUV(pTHX_ SV* sv);
diff --git a/sharedsv.c b/sharedsv.c
new file mode 100644 (file)
index 0000000..4359694
--- /dev/null
@@ -0,0 +1,201 @@
+/*    sharedsv.c
+ *
+ *    Copyright (c) 2001, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+* Contributed by Arthur Bergman arthur@contiller.se
+*
+* "Hand any two wizards a piece of rope and they would instinctively pull in
+* opposite directions."
+*                         --Sourcery
+*
+*/
+
+#include "EXTERN.h"
+#define PERL_IN_SHAREDSV_C
+#include "perl.h"
+
+PerlInterpreter* sharedsv_space;
+
+#ifdef USE_ITHREADS
+
+/*
+  Shared SV
+
+  Shared SV is a structure for keeping the backend storage
+  of shared svs.
+
+ */
+
+/*
+=for apidoc sharedsv_init
+
+Saves a space for keeping SVs wider than an interpreter,
+currently only stores a pointer to the first interpreter.
+
+=cut
+*/
+
+void
+Perl_sharedsv_init(pTHX)
+{
+    sharedsv_space = PERL_GET_CONTEXT;
+}
+
+/*
+=for apidoc sharedsv_new
+
+Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
+=cut
+*/
+
+shared_sv *
+Perl_sharedsv_new(pTHX)
+{
+    shared_sv* ssv;
+    New(2555,ssv,1,shared_sv);
+    MUTEX_INIT(&ssv->mutex);
+    COND_INIT(&ssv->cond);
+    ssv->locks = 0;
+    return ssv;
+}
+
+
+/*
+=for apidoc sharedsv_find
+
+Tries to find if a given SV has a shared backend, either by
+looking at magic, or by checking if it is tied again threads::shared.
+
+=cut
+*/
+
+shared_sv *
+Perl_sharedsv_find(pTHX_ SV* sv)
+{
+    /* does all it can to find a shared_sv struct, returns NULL otherwise */
+    shared_sv* ssv = NULL;
+    return ssv;
+}
+
+/*
+=for apidoc sharedsv_lock
+
+Recursive locks on a sharedsv.
+Locks are dynamicly scoped at the level of the first lock.
+=cut
+*/
+void
+Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
+{
+    if(!ssv)
+        return;
+    if(ssv->owner && ssv->owner == my_perl) {
+        ssv->locks++;
+        return;
+    }
+    MUTEX_LOCK(&ssv->mutex);
+    ssv->locks++;
+    ssv->owner = my_perl;
+    if(ssv->locks == 1)
+        SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
+}
+
+/*
+=for apidoc sharedsv_unlock
+
+Recursively unlocks a shared sv.
+
+=cut
+*/
+
+void
+Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
+{
+    if(ssv->owner != my_perl)
+        return;
+
+    if(--ssv->locks == 0) {
+        ssv->owner = NULL;
+        MUTEX_UNLOCK(&ssv->mutex);
+    }
+ }
+
+void
+Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
+{
+    if(ssv->owner != my_perl)
+        return;
+    ssv->locks = 0;
+    ssv->owner = NULL;
+    MUTEX_UNLOCK(&ssv->mutex);
+}
+
+/*
+=for apidoc sharedsv_thrcnt_inc
+
+Increments the threadcount of a sharedsv.
+=cut
+*/
+void
+Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
+{
+  SHAREDSvLOCK(ssv);
+  SvREFCNT_inc(ssv->sv);
+  SHAREDSvUNLOCK(ssv);
+}
+
+/*
+=for apidoc sharedsv_thrcnt_dec
+
+Decrements the threadcount of a shared sv. When a threads frontend is freed
+this function should be called.
+
+=cut
+*/
+
+void
+Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
+{
+    SV* sv;
+    SHAREDSvLOCK(ssv);
+    SHAREDSvEDIT(ssv);
+    sv = SHAREDSvGET(ssv);
+    if (SvREFCNT(sv) == 1) {
+        switch (SvTYPE(sv)) {
+        case SVt_RV:
+            if (SvROK(sv))
+            Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv *)SvIV(SvRV(sv)));
+            break;
+        case SVt_PVAV: {
+            SV **src_ary  = AvARRAY((AV *)sv);
+            SSize_t items = AvFILLp((AV *)sv) + 1;
+
+            while (items-- > 0) {
+            if(SvTYPE(*src_ary))
+                Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv *)SvIV(*src_ary++));
+            }
+            break;
+        }
+        case SVt_PVHV: {
+            HE *entry;
+            (void)hv_iterinit((HV *)sv);
+            while ((entry = hv_iternext((HV *)sv)))
+                Perl_sharedsv_thrcnt_dec(
+                    aTHX_ (shared_sv *)SvIV(hv_iterval((HV *)sv, entry))
+                );
+            break;
+        }
+        }
+    }
+    SvREFCNT_dec(sv);
+    SHAREDSvRELEASE(ssv);
+    SHAREDSvUNLOCK(ssv);
+}
+
+#endif
diff --git a/sharedsv.h b/sharedsv.h
new file mode 100644 (file)
index 0000000..16bba11
--- /dev/null
@@ -0,0 +1,31 @@
+
+#ifdef USE_ITHREADS
+
+typedef struct {
+    SV*              sv;    /* The actual data */
+    perl_mutex       mutex; /* Our mutex */
+    perl_cond        cond;  /* Our condition variable */
+    IV               locks; /* Number of locks held */
+    PerlInterpreter* owner; /* who owns the lock */
+} shared_sv;
+
+extern PerlInterpreter* sharedsv_space;
+
+void Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv);
+void Perl_sharedsv_unlock(pTHX_ shared_sv* ssv);
+void Perl_sharedsv_lock(pTHX_ shared_sv* ssv);
+void Perl_sharedsv_init(pTHX);
+shared_sv* Perl_sharedsv_new(pTHX);
+shared_sv* Perl_sharedsv_find(pTHX_ SV* sv);
+void Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv);
+void Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv);
+
+
+#define SHAREDSvGET(a)     (a->sv)
+#define SHAREDSvEDIT(a)    PERL_SET_CONTEXT(sharedsv_space)
+#define SHAREDSvRELEASE(a) PERL_SET_CONTEXT(my_perl)
+#define SHAREDSvLOCK(a)    Perl_sharedsv_lock(aTHX_ a)
+#define SHAREDSvUNLOCK(a)  Perl_sharedsv_unlock(aTHX_ a)
+
+#endif /* USE_ITHREADS */
+