Change 11659 by jhi@alpha on 2001/08/13 12:45:21
Subject: [PATHC] sharedsv.[c|h]
From: "Artur Bergman" <[EMAIL PROTECTED]>
Date: Mon, 13 Aug 2001 14:38:41 +0200
Message-ID: <005401c123f4$e1f53360$21000a0a@vogw2kdev>
Subject: [PATCH] embed.pl
From: Arthur Bergman <[EMAIL PROTECTED]>
Date: Mon, 13 Aug 2001 14:38:14 +0200
Message-ID: <[EMAIL PROTECTED]>
Subject: [PATCH] sharedsv cleanups
From: "Arthur Bergman" <[EMAIL PROTECTED]>
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.
Affected files ...
... //depot/perl/MANIFEST#520 edit
... //depot/perl/Makefile.SH#210 edit
... //depot/perl/embed.h#278 edit
... //depot/perl/embed.pl#263 edit
... //depot/perl/global.sym#174 edit
... //depot/perl/objXSUB.h#177 edit
... //depot/perl/perl.h#379 edit
... //depot/perl/perlapi.c#119 edit
... //depot/perl/pod/perlapi.pod#90 edit
... //depot/perl/proto.h#322 edit
... //depot/perl/sharedsv.c#1 add
... //depot/perl/sharedsv.h#1 add
Differences ...
==== //depot/perl/MANIFEST#520 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Mon Aug 13 07:00:05 2001
+++ perl/MANIFEST Mon Aug 13 07:00:05 2001
@@ -1849,6 +1849,8 @@
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
==== //depot/perl/Makefile.SH#210 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH.~1~ Mon Aug 13 07:00:05 2001
+++ perl/Makefile.SH Mon Aug 13 07:00:05 2001
@@ -266,19 +266,19 @@
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)
==== //depot/perl/embed.h#278 (text+w) ====
Index: perl/embed.h
--- perl/embed.h.~1~ Mon Aug 13 07:00:05 2001
+++ perl/embed.h Mon Aug 13 07:00:05 2001
@@ -1066,6 +1066,16 @@
#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
@@ -2570,6 +2580,16 @@
#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)
@@ -5010,6 +5030,24 @@
#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
==== //depot/perl/embed.pl#263 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Mon Aug 13 07:00:05 2001
+++ perl/embed.pl Mon Aug 13 07:00:05 2001
@@ -2469,6 +2469,17 @@
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
==== //depot/perl/global.sym#174 (text+w) ====
Index: perl/global.sym
--- perl/global.sym.~1~ Mon Aug 13 07:00:05 2001
+++ perl/global.sym Mon Aug 13 07:00:05 2001
@@ -578,6 +578,13 @@
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
==== //depot/perl/objXSUB.h#177 (text+w) ====
Index: perl/objXSUB.h
--- perl/objXSUB.h.~1~ Mon Aug 13 07:00:05 2001
+++ perl/objXSUB.h Mon Aug 13 07:00:05 2001
@@ -2392,6 +2392,36 @@
#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
==== //depot/perl/perl.h#379 (text) ====
Index: perl/perl.h
--- perl/perl.h.~1~ Mon Aug 13 07:00:05 2001
+++ perl/perl.h Mon Aug 13 07:00:05 2001
@@ -2195,6 +2195,7 @@
#include "scope.h"
#include "warnings.h"
#include "utf8.h"
+#include "sharedsv.h"
/* Current curly descriptor */
typedef struct curcur CURCUR;
==== //depot/perl/perlapi.c#119 (text+w) ====
Index: perl/perlapi.c
--- perl/perlapi.c.~1~ Mon Aug 13 07:00:05 2001
+++ perl/perlapi.c Mon Aug 13 07:00:05 2001
@@ -4266,6 +4266,57 @@
#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
==== //depot/perl/pod/perlapi.pod#90 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Mon Aug 13 07:00:05 2001
+++ perl/pod/perlapi.pod Mon Aug 13 07:00:05 2001
@@ -1344,6 +1344,17 @@
=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 @@
=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 @@
=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 @@
=for hackers
Found in file sv.h
-=item SvTYPE
+=item svtype
-Returns the type of the SV. See C<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.
- svtype SvTYPE(SV* sv)
-
=for hackers
Found in file sv.h
-=item svtype
+=item SvTYPE
+
+Returns the type of the SV. See C<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.
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
==== //depot/perl/proto.h#322 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Mon Aug 13 07:00:05 2001
+++ perl/proto.h Mon Aug 13 07:00:05 2001
@@ -1197,6 +1197,17 @@
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);
==== //depot/perl/sharedsv.c#1 (text) ====
Index: perl/sharedsv.c
--- perl/sharedsv.c.~1~ Mon Aug 13 07:00:05 2001
+++ perl/sharedsv.c Mon Aug 13 07:00:05 2001
@@ -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 [EMAIL PROTECTED]
+*
+* "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
==== //depot/perl/sharedsv.h#1 (text) ====
Index: perl/sharedsv.h
--- perl/sharedsv.h.~1~ Mon Aug 13 07:00:05 2001
+++ perl/sharedsv.h Mon Aug 13 07:00:05 2001
@@ -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 */
+
End of Patch.
