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
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)
#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
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
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
#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
#include "scope.h"
#include "warnings.h"
#include "utf8.h"
+#include "sharedsv.h"
/* Current curly descriptor */
typedef struct curcur CURCUR;
#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
=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
=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
=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
=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
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);
--- /dev/null
+/* 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
--- /dev/null
+
+#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 */
+
https://perl5.git.perl.org / perl5.git / commitdiff