develooper Front page | perl.perl5.porters | Postings from August 2001

[PATHC] sharedsv.[c|h]

From:
Artur Bergman
Date:
August 13, 2001 05:33
Subject:
[PATHC] sharedsv.[c|h]
Message ID:
005401c123f4$e1f53360$21000a0a@vogw2kdev
This adds the backend for shared svs. The interface will live in threads::shared.

We still need an interpreter that sticks around where we can keep the shared SVs.
I suggest we wait with greating interpreter free arenas until after 5.8.

There probably  should be some of magic which lets the shared_sv->sv actually get to the
shared_sv, then the shared_svs could reside in optrees and so and we can remove the char*s

Then we could explicitly used SvSHAREREFCNT_inc macros when we know the SV is shared.

Arthur

--- /dev/null Wed Jul  5 19:49:51 2000
+++ perl-current/sharedsv.h Mon Aug 13 14:08:52 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
+
--- /dev/null Wed Jul  5 19:49:51 2000
+++ perl-current/sharedsv.c Mon Aug 13 14:18:27 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 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 Perl_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 Perl_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 Perl_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 Perl_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 Perl_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 Perl_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 Perl_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
--- perl-current-clone/perl.h Mon Aug 13 11:23:57 2001
+++ perl-current/perl.h Mon Aug 13 12:28:49 2001
@@ -2195,6 +2195,7 @@
 #include "scope.h"
 #include "warnings.h"
 #include "utf8.h"
+#include "sharedsv.h"

 /* Current curly descriptor */
 typedef struct curcur CURCUR;
--- perl-current-clone/Makefile.SH Mon Aug 13 11:23:56 2001
+++ perl-current/Makefile.SH Mon Aug 13 13:08:56 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)






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